bb6b2dcd |
1 | /* @(#) pf_core.c 98/01/28 1.5 */\r |
2 | /***************************************************************\r |
3 | ** Forth based on 'C'\r |
4 | **\r |
5 | ** This file has the main entry points to the pForth library.\r |
6 | **\r |
7 | ** Author: Phil Burk\r |
8 | ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom\r |
9 | **\r |
10 | ** The pForth software code is dedicated to the public domain,\r |
11 | ** and any third party may reproduce, distribute and modify\r |
12 | ** the pForth software code or any derivative works thereof\r |
13 | ** without any compensation or license. The pForth software\r |
14 | ** code is provided on an "as is" basis without any warranty\r |
15 | ** of any kind, including, without limitation, the implied\r |
16 | ** warranties of merchantability and fitness for a particular\r |
17 | ** purpose and their equivalents under the laws of any jurisdiction.\r |
18 | **\r |
19 | ****************************************************************\r |
20 | ** 940502 PLB Creation.\r |
21 | ** 940505 PLB More macros.\r |
22 | ** 940509 PLB Moved all stack handling into inner interpreter.\r |
23 | ** Added Create, Colon, Semicolon, HNumberQ, etc.\r |
24 | ** 940510 PLB Got inner interpreter working with secondaries.\r |
25 | ** Added (LITERAL). Compiles colon definitions.\r |
26 | ** 940511 PLB Added conditionals, LITERAL, CREATE DOES>\r |
27 | ** 940512 PLB Added DO LOOP DEFER, fixed R>\r |
28 | ** 940520 PLB Added INCLUDE\r |
29 | ** 940521 PLB Added NUMBER?\r |
30 | ** 940930 PLB Outer Interpreter now uses deferred NUMBER?\r |
31 | ** 941005 PLB Added ANSI locals, LEAVE, modularised\r |
32 | ** 950320 RDG Added underflow checking for FP stack\r |
33 | ** 970702 PLB Added STACK_SAFETY to FP stack size.\r |
34 | ***************************************************************/\r |
35 | \r |
36 | #include "pf_all.h"\r |
37 | \r |
38 | /***************************************************************\r |
39 | ** Global Data\r |
40 | ***************************************************************/\r |
41 | \r |
42 | char gScratch[TIB_SIZE];\r |
43 | pfTaskData_t *gCurrentTask = NULL;\r |
44 | pfDictionary_t *gCurrentDictionary;\r |
1cb310e6 |
45 | cell_t gNumPrimitives;\r |
bb6b2dcd |
46 | \r |
47 | ExecToken gLocalCompiler_XT; /* custom compiler for local variables */\r |
48 | ExecToken gNumberQ_XT; /* XT of NUMBER? */\r |
49 | ExecToken gQuitP_XT; /* XT of (QUIT) */\r |
50 | ExecToken gAcceptP_XT; /* XT of ACCEPT */\r |
51 | \r |
52 | /* Depth of data stack when colon called. */\r |
1cb310e6 |
53 | cell_t gDepthAtColon;\r |
bb6b2dcd |
54 | \r |
55 | /* Global Forth variables. */\r |
56 | char *gVarContext; /* Points to last name field. */\r |
1cb310e6 |
57 | cell_t gVarState; /* 1 if compiling. */\r |
58 | cell_t gVarBase; /* Numeric Base. */\r |
59 | cell_t gVarEcho; /* Echo input. */\r |
60 | cell_t gVarTraceLevel; /* Trace Level for Inner Interpreter. */\r |
61 | cell_t gVarTraceStack; /* Dump Stack each time if true. */\r |
62 | cell_t gVarTraceFlags; /* Enable various internal debug messages. */\r |
63 | cell_t gVarQuiet; /* Suppress unnecessary messages, OK, etc. */\r |
64 | cell_t gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */\r |
bb6b2dcd |
65 | \r |
66 | /* data for INCLUDE that allows multiple nested files. */\r |
67 | IncludeFrame gIncludeStack[MAX_INCLUDE_DEPTH];\r |
1cb310e6 |
68 | cell_t gIncludeIndex;\r |
bb6b2dcd |
69 | \r |
70 | static void pfResetForthTask( void );\r |
71 | static void pfInit( void );\r |
72 | static void pfTerm( void );\r |
73 | \r |
74 | /* TODO move to pf_config.h header. */\r |
75 | #define DEFAULT_RETURN_DEPTH (512)\r |
76 | #define DEFAULT_USER_DEPTH (512)\r |
77 | #define DEFAULT_HEADER_SIZE (120000)\r |
78 | #define DEFAULT_CODE_SIZE (300000)\r |
79 | \r |
80 | /* Initialize globals in a function to simplify loading on\r |
81 | * embedded systems which may not support initialization of data section.\r |
82 | */\r |
83 | static void pfInit( void )\r |
84 | {\r |
85 | /* all zero */\r |
86 | gCurrentTask = NULL;\r |
87 | gCurrentDictionary = NULL;\r |
88 | gNumPrimitives = 0;\r |
89 | gLocalCompiler_XT = 0;\r |
90 | gVarContext = NULL; /* Points to last name field. */\r |
91 | gVarState = 0; /* 1 if compiling. */\r |
92 | gVarEcho = 0; /* Echo input. */\r |
93 | gVarTraceLevel = 0; /* Trace Level for Inner Interpreter. */\r |
94 | gVarTraceFlags = 0; /* Enable various internal debug messages. */\r |
95 | gVarQuiet = 0; /* Suppress unnecessary messages, OK, etc. */\r |
96 | gVarReturnCode = 0; /* Returned to caller of Forth, eg. UNIX shell. */\r |
97 | gIncludeIndex = 0;\r |
98 | \r |
99 | /* non-zero */\r |
100 | gVarBase = 10; /* Numeric Base. */\r |
101 | gDepthAtColon = DEPTH_AT_COLON_INVALID;\r |
102 | gVarTraceStack = 1; \r |
103 | \r |
104 | pfInitMemoryAllocator();\r |
105 | ioInit();\r |
106 | }\r |
107 | static void pfTerm( void )\r |
108 | {\r |
109 | ioTerm();\r |
110 | }\r |
111 | \r |
112 | /***************************************************************\r |
113 | ** Task Management\r |
114 | ***************************************************************/\r |
115 | \r |
116 | void pfDeleteTask( PForthTask task )\r |
117 | {\r |
118 | pfTaskData_t *cftd = (pfTaskData_t *)task;\r |
119 | FREE_VAR( cftd->td_ReturnLimit );\r |
120 | FREE_VAR( cftd->td_StackLimit );\r |
121 | pfFreeMem( cftd );\r |
122 | }\r |
123 | \r |
124 | /* Allocate some extra cells to protect against mild stack underflows. */\r |
125 | #define STACK_SAFETY (8)\r |
1cb310e6 |
126 | PForthTask pfCreateTask( cell_t UserStackDepth, cell_t ReturnStackDepth )\r |
bb6b2dcd |
127 | {\r |
128 | pfTaskData_t *cftd;\r |
129 | \r |
130 | cftd = ( pfTaskData_t * ) pfAllocMem( sizeof( pfTaskData_t ) );\r |
131 | if( !cftd ) goto nomem;\r |
132 | pfSetMemory( cftd, 0, sizeof( pfTaskData_t ));\r |
133 | \r |
134 | /* Allocate User Stack */\r |
1cb310e6 |
135 | cftd->td_StackLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) *\r |
bb6b2dcd |
136 | (UserStackDepth + STACK_SAFETY)));\r |
137 | if( !cftd->td_StackLimit ) goto nomem;\r |
138 | cftd->td_StackBase = cftd->td_StackLimit + UserStackDepth;\r |
139 | cftd->td_StackPtr = cftd->td_StackBase;\r |
140 | \r |
141 | /* Allocate Return Stack */\r |
1cb310e6 |
142 | cftd->td_ReturnLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) * ReturnStackDepth) );\r |
bb6b2dcd |
143 | if( !cftd->td_ReturnLimit ) goto nomem;\r |
144 | cftd->td_ReturnBase = cftd->td_ReturnLimit + ReturnStackDepth;\r |
145 | cftd->td_ReturnPtr = cftd->td_ReturnBase;\r |
146 | \r |
147 | /* Allocate Float Stack */\r |
148 | #ifdef PF_SUPPORT_FP\r |
149 | /* Allocate room for as many Floats as we do regular data. */\r |
1cb310e6 |
150 | cftd->td_FloatStackLimit = (PF_FLOAT *) pfAllocMem((ucell_t)(sizeof(PF_FLOAT) *\r |
bb6b2dcd |
151 | (UserStackDepth + STACK_SAFETY)));\r |
152 | if( !cftd->td_FloatStackLimit ) goto nomem;\r |
153 | cftd->td_FloatStackBase = cftd->td_FloatStackLimit + UserStackDepth;\r |
154 | cftd->td_FloatStackPtr = cftd->td_FloatStackBase;\r |
155 | #endif\r |
156 | \r |
157 | cftd->td_InputStream = PF_STDIN;\r |
158 | \r |
159 | cftd->td_SourcePtr = &cftd->td_TIB[0];\r |
160 | cftd->td_SourceNum = 0;\r |
161 | \r |
162 | return (PForthTask) cftd;\r |
163 | \r |
164 | nomem:\r |
165 | ERR("CreateTaskContext: insufficient memory.\n");\r |
166 | if( cftd ) pfDeleteTask( (PForthTask) cftd );\r |
167 | return NULL;\r |
168 | }\r |
169 | \r |
170 | /***************************************************************\r |
171 | ** Dictionary Management\r |
172 | ***************************************************************/\r |
173 | \r |
1cb310e6 |
174 | cell_t pfExecIfDefined( const char *CString )\r |
bb6b2dcd |
175 | {\r |
176 | int result = 0;\r |
177 | if( NAME_BASE != NULL)\r |
178 | {\r |
179 | ExecToken XT;\r |
180 | if( ffFindC( CString, &XT ) )\r |
181 | {\r |
182 | result = pfCatch( XT );\r |
183 | }\r |
184 | }\r |
185 | return result;\r |
186 | }\r |
187 | \r |
188 | /***************************************************************\r |
189 | ** Delete a dictionary created by pfCreateDictionary()\r |
190 | */\r |
191 | void pfDeleteDictionary( PForthDictionary dictionary )\r |
192 | {\r |
193 | pfDictionary_t *dic = (pfDictionary_t *) dictionary;\r |
194 | if( !dic ) return;\r |
195 | \r |
196 | if( dic->dic_Flags & PF_DICF_ALLOCATED_SEGMENTS )\r |
197 | {\r |
198 | FREE_VAR( dic->dic_HeaderBaseUnaligned );\r |
199 | FREE_VAR( dic->dic_CodeBaseUnaligned );\r |
200 | }\r |
201 | pfFreeMem( dic );\r |
202 | }\r |
203 | \r |
204 | /***************************************************************\r |
205 | ** Create a complete dictionary.\r |
206 | ** The dictionary consists of two parts, the header with the names,\r |
207 | ** and the code portion.\r |
208 | ** Delete using pfDeleteDictionary().\r |
209 | ** Return pointer to dictionary management structure.\r |
210 | */\r |
1cb310e6 |
211 | PForthDictionary pfCreateDictionary( cell_t HeaderSize, cell_t CodeSize )\r |
bb6b2dcd |
212 | {\r |
213 | /* Allocate memory for initial dictionary. */\r |
214 | pfDictionary_t *dic;\r |
215 | \r |
216 | dic = ( pfDictionary_t * ) pfAllocMem( sizeof( pfDictionary_t ) );\r |
217 | if( !dic ) goto nomem;\r |
218 | pfSetMemory( dic, 0, sizeof( pfDictionary_t ));\r |
219 | \r |
220 | dic->dic_Flags |= PF_DICF_ALLOCATED_SEGMENTS;\r |
221 | \r |
222 | /* Align dictionary segments to preserve alignment of floats across hosts.\r |
223 | * Thank you Helmut Proelss for pointing out that this needs to be cast\r |
1cb310e6 |
224 | * to (ucell_t) on 16 bit systems.\r |
bb6b2dcd |
225 | */\r |
1cb310e6 |
226 | #define DIC_ALIGNMENT_SIZE ((ucell_t)(0x10))\r |
227 | #define DIC_ALIGN(addr) ((uint8_t *)((((ucell_t)(addr)) + DIC_ALIGNMENT_SIZE - 1) & ~(DIC_ALIGNMENT_SIZE - 1)))\r |
bb6b2dcd |
228 | \r |
229 | /* Allocate memory for header. */\r |
230 | if( HeaderSize > 0 )\r |
231 | {\r |
1cb310e6 |
232 | dic->dic_HeaderBaseUnaligned = ( uint8_t * ) pfAllocMem( (ucell_t) HeaderSize + DIC_ALIGNMENT_SIZE );\r |
bb6b2dcd |
233 | if( !dic->dic_HeaderBaseUnaligned ) goto nomem;\r |
234 | /* Align header base. */\r |
235 | dic->dic_HeaderBase = DIC_ALIGN(dic->dic_HeaderBaseUnaligned);\r |
1cb310e6 |
236 | pfSetMemory( dic->dic_HeaderBase, 0xA5, (ucell_t) HeaderSize);\r |
bb6b2dcd |
237 | dic->dic_HeaderLimit = dic->dic_HeaderBase + HeaderSize;\r |
238 | dic->dic_HeaderPtr.Byte = dic->dic_HeaderBase;\r |
239 | }\r |
240 | else\r |
241 | {\r |
242 | dic->dic_HeaderBase = NULL;\r |
243 | }\r |
244 | \r |
245 | /* Allocate memory for code. */\r |
1cb310e6 |
246 | dic->dic_CodeBaseUnaligned = ( uint8_t * ) pfAllocMem( (ucell_t) CodeSize + DIC_ALIGNMENT_SIZE );\r |
bb6b2dcd |
247 | if( !dic->dic_CodeBaseUnaligned ) goto nomem;\r |
248 | dic->dic_CodeBase = DIC_ALIGN(dic->dic_CodeBaseUnaligned);\r |
1cb310e6 |
249 | pfSetMemory( dic->dic_CodeBase, 0x5A, (ucell_t) CodeSize);\r |
bb6b2dcd |
250 | \r |
251 | dic->dic_CodeLimit = dic->dic_CodeBase + CodeSize;\r |
252 | dic->dic_CodePtr.Byte = dic->dic_CodeBase + QUADUP(NUM_PRIMITIVES); \r |
253 | \r |
254 | return (PForthDictionary) dic;\r |
255 | nomem:\r |
256 | pfDeleteDictionary( dic );\r |
257 | return NULL;\r |
258 | }\r |
259 | \r |
260 | /***************************************************************\r |
261 | ** Used by Quit and other routines to restore system.\r |
262 | ***************************************************************/\r |
263 | \r |
264 | static void pfResetForthTask( void )\r |
265 | {\r |
266 | /* Go back to terminal input. */\r |
267 | gCurrentTask->td_InputStream = PF_STDIN;\r |
268 | \r |
269 | /* Reset stacks. */\r |
270 | gCurrentTask->td_StackPtr = gCurrentTask->td_StackBase;\r |
271 | gCurrentTask->td_ReturnPtr = gCurrentTask->td_ReturnBase;\r |
272 | #ifdef PF_SUPPORT_FP /* Reset Floating Point stack too! */\r |
273 | gCurrentTask->td_FloatStackPtr = gCurrentTask->td_FloatStackBase;\r |
274 | #endif\r |
275 | \r |
276 | /* Advance >IN to end of input. */\r |
277 | gCurrentTask->td_IN = gCurrentTask->td_SourceNum;\r |
278 | gVarState = 0;\r |
279 | }\r |
280 | \r |
281 | /***************************************************************\r |
282 | ** Set current task context.\r |
283 | ***************************************************************/\r |
284 | \r |
285 | void pfSetCurrentTask( PForthTask task )\r |
286 | { \r |
287 | gCurrentTask = (pfTaskData_t *) task;\r |
288 | }\r |
289 | \r |
290 | /***************************************************************\r |
291 | ** Set Quiet Flag.\r |
292 | ***************************************************************/\r |
293 | \r |
1cb310e6 |
294 | void pfSetQuiet( cell_t IfQuiet )\r |
bb6b2dcd |
295 | { \r |
1cb310e6 |
296 | gVarQuiet = (cell_t) IfQuiet;\r |
bb6b2dcd |
297 | }\r |
298 | \r |
299 | /***************************************************************\r |
300 | ** Query message status.\r |
301 | ***************************************************************/\r |
302 | \r |
1cb310e6 |
303 | cell_t pfQueryQuiet( void )\r |
bb6b2dcd |
304 | { \r |
305 | return gVarQuiet;\r |
306 | }\r |
307 | \r |
308 | /***************************************************************\r |
309 | ** Top level interpreter.\r |
310 | ***************************************************************/\r |
311 | ThrowCode pfQuit( void )\r |
312 | {\r |
313 | ThrowCode exception;\r |
314 | int go = 1;\r |
315 | \r |
316 | while(go)\r |
317 | {\r |
318 | exception = ffOuterInterpreterLoop();\r |
319 | if( exception == 0 )\r |
320 | {\r |
321 | exception = ffOK();\r |
322 | }\r |
323 | \r |
324 | switch( exception )\r |
325 | {\r |
326 | case 0:\r |
327 | break;\r |
328 | \r |
329 | case THROW_BYE:\r |
330 | go = 0;\r |
331 | break;\r |
332 | \r |
333 | case THROW_ABORT:\r |
334 | default:\r |
335 | ffDotS();\r |
336 | pfReportThrow( exception );\r |
337 | pfHandleIncludeError();\r |
338 | pfResetForthTask();\r |
339 | break;\r |
340 | }\r |
341 | }\r |
342 | \r |
343 | return gVarReturnCode;\r |
344 | }\r |
345 | \r |
346 | /***************************************************************\r |
347 | ** Include file based on 'C' name.\r |
348 | ***************************************************************/\r |
349 | \r |
1cb310e6 |
350 | cell_t pfIncludeFile( const char *FileName )\r |
bb6b2dcd |
351 | {\r |
352 | FileStream *fid;\r |
1cb310e6 |
353 | cell_t Result;\r |
bb6b2dcd |
354 | char buffer[32];\r |
1cb310e6 |
355 | cell_t numChars, len;\r |
bb6b2dcd |
356 | \r |
357 | /* Open file. */\r |
358 | fid = sdOpenFile( FileName, "r" );\r |
359 | if( fid == NULL )\r |
360 | {\r |
361 | ERR("pfIncludeFile could not open ");\r |
362 | ERR(FileName);\r |
363 | EMIT_CR;\r |
364 | return -1;\r |
365 | }\r |
366 | \r |
367 | /* Create a dictionary word named ::::FileName for FILE? */\r |
368 | pfCopyMemory( &buffer[0], "::::", 4);\r |
1cb310e6 |
369 | len = (cell_t) pfCStringLength(FileName);\r |
bb6b2dcd |
370 | numChars = ( len > (32-4-1) ) ? (32-4-1) : len;\r |
371 | pfCopyMemory( &buffer[4], &FileName[len-numChars], numChars+1 );\r |
372 | CreateDicEntryC( ID_NOOP, buffer, 0 );\r |
373 | \r |
374 | Result = ffIncludeFile( fid );\r |
375 | \r |
376 | /* Create a dictionary word named ;;;; for FILE? */\r |
377 | CreateDicEntryC( ID_NOOP, ";;;;", 0 );\r |
378 | \r |
379 | sdCloseFile(fid);\r |
380 | return Result;\r |
381 | }\r |
382 | \r |
383 | /***************************************************************\r |
384 | ** Output 'C' string message.\r |
385 | ** Use sdTerminalOut which works before initializing gCurrentTask.\r |
386 | ***************************************************************/\r |
387 | void pfDebugMessage( const char *CString )\r |
388 | {\r |
389 | #if 0\r |
390 | while( *CString )\r |
391 | {\r |
392 | char c = *CString++;\r |
393 | if( c == '\n' )\r |
394 | {\r |
395 | sdTerminalOut( 0x0D );\r |
396 | sdTerminalOut( 0x0A );\r |
397 | pfDebugMessage( "DBG: " );\r |
398 | }\r |
399 | else\r |
400 | {\r |
401 | sdTerminalOut( c );\r |
402 | }\r |
403 | }\r |
404 | #else\r |
405 | (void)CString;\r |
406 | #endif\r |
407 | }\r |
408 | \r |
409 | /***************************************************************\r |
410 | ** Print a decimal number to debug output.\r |
411 | */\r |
412 | void pfDebugPrintDecimalNumber( int n )\r |
413 | {\r |
414 | pfDebugMessage( ConvertNumberToText( n, 10, TRUE, 1 ) );\r |
415 | }\r |
416 | \r |
417 | \r |
418 | /***************************************************************\r |
419 | ** Output 'C' string message.\r |
420 | ** This is provided to help avoid the use of printf() and other I/O\r |
421 | ** which may not be present on a small embedded system.\r |
422 | ** Uses ioType & ioEmit so requires that gCurrentTask has been initialized.\r |
423 | ***************************************************************/\r |
424 | void pfMessage( const char *CString )\r |
425 | {\r |
1cb310e6 |
426 | ioType( CString, (cell_t) pfCStringLength(CString) );\r |
bb6b2dcd |
427 | }\r |
428 | \r |
429 | /**************************************************************************\r |
1cb310e6 |
430 | ** Main entry point for pForth.\r |
bb6b2dcd |
431 | */\r |
1cb310e6 |
432 | cell_t pfDoForth( const char *DicFileName, const char *SourceName, cell_t IfInit )\r |
bb6b2dcd |
433 | {\r |
434 | pfTaskData_t *cftd;\r |
435 | pfDictionary_t *dic = NULL;\r |
1cb310e6 |
436 | cell_t Result = 0;\r |
bb6b2dcd |
437 | ExecToken EntryPoint = 0;\r |
bb6b2dcd |
438 | \r |
439 | #ifdef PF_USER_INIT\r |
440 | Result = PF_USER_INIT;\r |
b3651f38 |
441 | if( Result < 0 ) goto error1;\r |
bb6b2dcd |
442 | #endif\r |
443 | \r |
444 | pfInit();\r |
445 | \r |
bb6b2dcd |
446 | /* Allocate Task structure. */\r |
447 | pfDebugMessage("pfDoForth: call pfCreateTask()\n");\r |
448 | cftd = pfCreateTask( DEFAULT_USER_DEPTH, DEFAULT_RETURN_DEPTH );\r |
449 | \r |
450 | if( cftd )\r |
451 | {\r |
452 | pfSetCurrentTask( cftd );\r |
453 | \r |
454 | if( !pfQueryQuiet() )\r |
455 | {\r |
456 | MSG( "PForth V"PFORTH_VERSION );\r |
6b91cb54 |
457 | if( IsHostLittleEndian() ) MSG("-LE");\r |
458 | else MSG("-BE");\r |
bb6b2dcd |
459 | #if PF_BIG_ENDIAN_DIC\r |
460 | MSG("/BE");\r |
461 | #elif PF_LITTLE_ENDIAN_DIC\r |
462 | MSG("/LE");\r |
463 | #endif\r |
1cb310e6 |
464 | if (sizeof(cell_t) == 8)\r |
465 | {\r |
466 | MSG("/64");\r |
467 | }\r |
468 | else if (sizeof(cell_t) == 4)\r |
469 | {\r |
470 | MSG("/32");\r |
471 | }\r |
472 | \r |
bb6b2dcd |
473 | MSG( ", built "__DATE__" "__TIME__ );\r |
474 | }\r |
475 | \r |
476 | /* Don't use MSG before task set. */\r |
477 | if( SourceName )\r |
478 | {\r |
479 | pfDebugMessage("SourceName = "); pfDebugMessage(SourceName); pfDebugMessage("\n");\r |
480 | }\r |
481 | \r |
482 | \r |
483 | #ifdef PF_NO_GLOBAL_INIT\r |
b3651f38 |
484 | if( LoadCustomFunctionTable() < 0 ) goto error2; /* Init custom 'C' call array. */\r |
bb6b2dcd |
485 | #endif\r |
486 | \r |
487 | #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))\r |
488 | if( IfInit )\r |
489 | {\r |
490 | pfDebugMessage("Build dictionary from scratch.\n");\r |
491 | dic = pfBuildDictionary( DEFAULT_HEADER_SIZE, DEFAULT_CODE_SIZE );\r |
492 | }\r |
493 | else\r |
494 | #else\r |
495 | TOUCH(IfInit);\r |
496 | #endif /* !PF_NO_INIT && !PF_NO_SHELL*/\r |
497 | {\r |
b3651f38 |
498 | if( DicFileName )\r |
bb6b2dcd |
499 | {\r |
b3651f38 |
500 | pfDebugMessage("DicFileName = "); pfDebugMessage(DicFileName); pfDebugMessage("\n");\r |
bb6b2dcd |
501 | EMIT_CR;\r |
b3651f38 |
502 | dic = pfLoadDictionary( DicFileName, &EntryPoint );\r |
bb6b2dcd |
503 | }\r |
504 | else\r |
505 | {\r |
506 | MSG(" (static)");\r |
507 | EMIT_CR;\r |
508 | dic = pfLoadStaticDictionary(); \r |
509 | }\r |
510 | }\r |
b3651f38 |
511 | if( dic == NULL ) goto error2;\r |
bb6b2dcd |
512 | EMIT_CR;\r |
513 | \r |
514 | pfDebugMessage("pfDoForth: try AUTO.INIT\n");\r |
515 | Result = pfExecIfDefined("AUTO.INIT");\r |
516 | if( Result != 0 )\r |
517 | {\r |
518 | MSG("Error in AUTO.INIT");\r |
b3651f38 |
519 | goto error2;\r |
bb6b2dcd |
520 | }\r |
b3651f38 |
521 | \r |
bb6b2dcd |
522 | if( EntryPoint != 0 )\r |
523 | {\r |
524 | Result = pfCatch( EntryPoint );\r |
525 | }\r |
526 | #ifndef PF_NO_SHELL\r |
527 | else\r |
528 | {\r |
529 | if( SourceName == NULL )\r |
530 | {\r |
531 | pfDebugMessage("pfDoForth: pfQuit\n");\r |
532 | Result = pfQuit();\r |
533 | }\r |
534 | else\r |
535 | {\r |
536 | if( !gVarQuiet )\r |
537 | {\r |
538 | MSG("Including: ");\r |
539 | MSG(SourceName);\r |
540 | MSG("\n");\r |
541 | }\r |
542 | Result = pfIncludeFile( SourceName );\r |
543 | }\r |
544 | }\r |
545 | #endif /* PF_NO_SHELL */\r |
546 | \r |
547 | /* Clean up after running Forth. */\r |
548 | pfExecIfDefined("AUTO.TERM");\r |
549 | pfDeleteDictionary( dic );\r |
550 | pfDeleteTask( cftd );\r |
551 | }\r |
552 | \r |
553 | pfTerm();\r |
554 | \r |
555 | #ifdef PF_USER_TERM\r |
556 | PF_USER_TERM;\r |
557 | #endif\r |
558 | \r |
559 | return Result;\r |
560 | \r |
b3651f38 |
561 | error2:\r |
bb6b2dcd |
562 | MSG("pfDoForth: Error occured.\n");\r |
563 | pfDeleteTask( cftd );\r |
b3651f38 |
564 | // Terminate so we restore normal shell tty mode.\r |
565 | pfTerm();\r |
566 | \r |
567 | #ifdef PF_USER_INIT\r |
568 | error1:\r |
569 | #endif\r |
570 | \r |
bb6b2dcd |
571 | return -1;\r |
572 | }\r |