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 |
b3ad2602 |
56 | cell_t 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 |
b3ad2602 |
90 | gVarContext = (cell_t)NULL; /* Points to last name field. */\r |
bb6b2dcd |
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 |
bb6b2dcd |
95 | gVarReturnCode = 0; /* Returned to caller of Forth, eg. UNIX shell. */\r |
96 | gIncludeIndex = 0;\r |
97 | \r |
98 | /* non-zero */\r |
99 | gVarBase = 10; /* Numeric Base. */\r |
100 | gDepthAtColon = DEPTH_AT_COLON_INVALID;\r |
a33d774e |
101 | gVarTraceStack = 1;\r |
bb6b2dcd |
102 | \r |
103 | pfInitMemoryAllocator();\r |
104 | ioInit();\r |
105 | }\r |
106 | static void pfTerm( void )\r |
107 | {\r |
108 | ioTerm();\r |
109 | }\r |
110 | \r |
111 | /***************************************************************\r |
112 | ** Task Management\r |
113 | ***************************************************************/\r |
114 | \r |
115 | void pfDeleteTask( PForthTask task )\r |
116 | {\r |
117 | pfTaskData_t *cftd = (pfTaskData_t *)task;\r |
118 | FREE_VAR( cftd->td_ReturnLimit );\r |
119 | FREE_VAR( cftd->td_StackLimit );\r |
120 | pfFreeMem( cftd );\r |
121 | }\r |
122 | \r |
123 | /* Allocate some extra cells to protect against mild stack underflows. */\r |
124 | #define STACK_SAFETY (8)\r |
1cb310e6 |
125 | PForthTask pfCreateTask( cell_t UserStackDepth, cell_t ReturnStackDepth )\r |
bb6b2dcd |
126 | {\r |
127 | pfTaskData_t *cftd;\r |
128 | \r |
129 | cftd = ( pfTaskData_t * ) pfAllocMem( sizeof( pfTaskData_t ) );\r |
130 | if( !cftd ) goto nomem;\r |
131 | pfSetMemory( cftd, 0, sizeof( pfTaskData_t ));\r |
132 | \r |
133 | /* Allocate User Stack */\r |
1cb310e6 |
134 | cftd->td_StackLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) *\r |
bb6b2dcd |
135 | (UserStackDepth + STACK_SAFETY)));\r |
136 | if( !cftd->td_StackLimit ) goto nomem;\r |
137 | cftd->td_StackBase = cftd->td_StackLimit + UserStackDepth;\r |
138 | cftd->td_StackPtr = cftd->td_StackBase;\r |
139 | \r |
140 | /* Allocate Return Stack */\r |
1cb310e6 |
141 | cftd->td_ReturnLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) * ReturnStackDepth) );\r |
bb6b2dcd |
142 | if( !cftd->td_ReturnLimit ) goto nomem;\r |
143 | cftd->td_ReturnBase = cftd->td_ReturnLimit + ReturnStackDepth;\r |
144 | cftd->td_ReturnPtr = cftd->td_ReturnBase;\r |
145 | \r |
146 | /* Allocate Float Stack */\r |
147 | #ifdef PF_SUPPORT_FP\r |
148 | /* Allocate room for as many Floats as we do regular data. */\r |
1cb310e6 |
149 | cftd->td_FloatStackLimit = (PF_FLOAT *) pfAllocMem((ucell_t)(sizeof(PF_FLOAT) *\r |
bb6b2dcd |
150 | (UserStackDepth + STACK_SAFETY)));\r |
151 | if( !cftd->td_FloatStackLimit ) goto nomem;\r |
152 | cftd->td_FloatStackBase = cftd->td_FloatStackLimit + UserStackDepth;\r |
153 | cftd->td_FloatStackPtr = cftd->td_FloatStackBase;\r |
154 | #endif\r |
155 | \r |
156 | cftd->td_InputStream = PF_STDIN;\r |
157 | \r |
158 | cftd->td_SourcePtr = &cftd->td_TIB[0];\r |
159 | cftd->td_SourceNum = 0;\r |
160 | \r |
161 | return (PForthTask) cftd;\r |
162 | \r |
163 | nomem:\r |
164 | ERR("CreateTaskContext: insufficient memory.\n");\r |
165 | if( cftd ) pfDeleteTask( (PForthTask) cftd );\r |
166 | return NULL;\r |
167 | }\r |
168 | \r |
169 | /***************************************************************\r |
170 | ** Dictionary Management\r |
171 | ***************************************************************/\r |
172 | \r |
1cb310e6 |
173 | cell_t pfExecIfDefined( const char *CString )\r |
bb6b2dcd |
174 | {\r |
175 | int result = 0;\r |
b3ad2602 |
176 | if( NAME_BASE != (cell_t)NULL)\r |
bb6b2dcd |
177 | {\r |
178 | ExecToken XT;\r |
179 | if( ffFindC( CString, &XT ) )\r |
180 | {\r |
181 | result = pfCatch( XT );\r |
182 | }\r |
183 | }\r |
184 | return result;\r |
185 | }\r |
186 | \r |
187 | /***************************************************************\r |
188 | ** Delete a dictionary created by pfCreateDictionary()\r |
189 | */\r |
190 | void pfDeleteDictionary( PForthDictionary dictionary )\r |
191 | {\r |
192 | pfDictionary_t *dic = (pfDictionary_t *) dictionary;\r |
193 | if( !dic ) return;\r |
194 | \r |
195 | if( dic->dic_Flags & PF_DICF_ALLOCATED_SEGMENTS )\r |
196 | {\r |
197 | FREE_VAR( dic->dic_HeaderBaseUnaligned );\r |
198 | FREE_VAR( dic->dic_CodeBaseUnaligned );\r |
199 | }\r |
200 | pfFreeMem( dic );\r |
201 | }\r |
202 | \r |
203 | /***************************************************************\r |
204 | ** Create a complete dictionary.\r |
205 | ** The dictionary consists of two parts, the header with the names,\r |
206 | ** and the code portion.\r |
207 | ** Delete using pfDeleteDictionary().\r |
208 | ** Return pointer to dictionary management structure.\r |
209 | */\r |
1cb310e6 |
210 | PForthDictionary pfCreateDictionary( cell_t HeaderSize, cell_t CodeSize )\r |
bb6b2dcd |
211 | {\r |
212 | /* Allocate memory for initial dictionary. */\r |
213 | pfDictionary_t *dic;\r |
214 | \r |
215 | dic = ( pfDictionary_t * ) pfAllocMem( sizeof( pfDictionary_t ) );\r |
216 | if( !dic ) goto nomem;\r |
217 | pfSetMemory( dic, 0, sizeof( pfDictionary_t ));\r |
218 | \r |
219 | dic->dic_Flags |= PF_DICF_ALLOCATED_SEGMENTS;\r |
220 | \r |
221 | /* Align dictionary segments to preserve alignment of floats across hosts.\r |
222 | * Thank you Helmut Proelss for pointing out that this needs to be cast\r |
1cb310e6 |
223 | * to (ucell_t) on 16 bit systems.\r |
bb6b2dcd |
224 | */\r |
1cb310e6 |
225 | #define DIC_ALIGNMENT_SIZE ((ucell_t)(0x10))\r |
a80283a7 |
226 | #define DIC_ALIGN(addr) ((((ucell_t)(addr)) + DIC_ALIGNMENT_SIZE - 1) & ~(DIC_ALIGNMENT_SIZE - 1))\r |
bb6b2dcd |
227 | \r |
228 | /* Allocate memory for header. */\r |
229 | if( HeaderSize > 0 )\r |
230 | {\r |
a80283a7 |
231 | dic->dic_HeaderBaseUnaligned = (ucell_t) pfAllocMem( (ucell_t) HeaderSize + DIC_ALIGNMENT_SIZE );\r |
bb6b2dcd |
232 | if( !dic->dic_HeaderBaseUnaligned ) goto nomem;\r |
233 | /* Align header base. */\r |
234 | dic->dic_HeaderBase = DIC_ALIGN(dic->dic_HeaderBaseUnaligned);\r |
a80283a7 |
235 | pfSetMemory( (char *) dic->dic_HeaderBase, 0xA5, (ucell_t) HeaderSize);\r |
bb6b2dcd |
236 | dic->dic_HeaderLimit = dic->dic_HeaderBase + HeaderSize;\r |
b3ad2602 |
237 | dic->dic_HeaderPtr = dic->dic_HeaderBase;\r |
bb6b2dcd |
238 | }\r |
239 | else\r |
240 | {\r |
a80283a7 |
241 | dic->dic_HeaderBase = 0;\r |
bb6b2dcd |
242 | }\r |
243 | \r |
244 | /* Allocate memory for code. */\r |
a80283a7 |
245 | dic->dic_CodeBaseUnaligned = (ucell_t) pfAllocMem( (ucell_t) CodeSize + DIC_ALIGNMENT_SIZE );\r |
bb6b2dcd |
246 | if( !dic->dic_CodeBaseUnaligned ) goto nomem;\r |
247 | dic->dic_CodeBase = DIC_ALIGN(dic->dic_CodeBaseUnaligned);\r |
a80283a7 |
248 | pfSetMemory( (char *) dic->dic_CodeBase, 0x5A, (ucell_t) CodeSize);\r |
bb6b2dcd |
249 | \r |
250 | dic->dic_CodeLimit = dic->dic_CodeBase + CodeSize;\r |
a80283a7 |
251 | dic->dic_CodePtr.Byte = ((uint8_t *) (dic->dic_CodeBase + QUADUP(NUM_PRIMITIVES))); \r |
bb6b2dcd |
252 | \r |
253 | return (PForthDictionary) dic;\r |
254 | nomem:\r |
255 | pfDeleteDictionary( dic );\r |
256 | return NULL;\r |
257 | }\r |
258 | \r |
259 | /***************************************************************\r |
260 | ** Used by Quit and other routines to restore system.\r |
261 | ***************************************************************/\r |
262 | \r |
263 | static void pfResetForthTask( void )\r |
264 | {\r |
265 | /* Go back to terminal input. */\r |
266 | gCurrentTask->td_InputStream = PF_STDIN;\r |
267 | \r |
268 | /* Reset stacks. */\r |
269 | gCurrentTask->td_StackPtr = gCurrentTask->td_StackBase;\r |
270 | gCurrentTask->td_ReturnPtr = gCurrentTask->td_ReturnBase;\r |
271 | #ifdef PF_SUPPORT_FP /* Reset Floating Point stack too! */\r |
272 | gCurrentTask->td_FloatStackPtr = gCurrentTask->td_FloatStackBase;\r |
273 | #endif\r |
274 | \r |
275 | /* Advance >IN to end of input. */\r |
276 | gCurrentTask->td_IN = gCurrentTask->td_SourceNum;\r |
277 | gVarState = 0;\r |
278 | }\r |
279 | \r |
280 | /***************************************************************\r |
281 | ** Set current task context.\r |
282 | ***************************************************************/\r |
283 | \r |
284 | void pfSetCurrentTask( PForthTask task )\r |
285 | { \r |
286 | gCurrentTask = (pfTaskData_t *) task;\r |
287 | }\r |
288 | \r |
289 | /***************************************************************\r |
290 | ** Set Quiet Flag.\r |
291 | ***************************************************************/\r |
292 | \r |
1cb310e6 |
293 | void pfSetQuiet( cell_t IfQuiet )\r |
bb6b2dcd |
294 | { \r |
1cb310e6 |
295 | gVarQuiet = (cell_t) IfQuiet;\r |
bb6b2dcd |
296 | }\r |
297 | \r |
298 | /***************************************************************\r |
299 | ** Query message status.\r |
300 | ***************************************************************/\r |
301 | \r |
1cb310e6 |
302 | cell_t pfQueryQuiet( void )\r |
bb6b2dcd |
303 | { \r |
304 | return gVarQuiet;\r |
305 | }\r |
306 | \r |
307 | /***************************************************************\r |
308 | ** Top level interpreter.\r |
309 | ***************************************************************/\r |
310 | ThrowCode pfQuit( void )\r |
311 | {\r |
312 | ThrowCode exception;\r |
313 | int go = 1;\r |
314 | \r |
315 | while(go)\r |
316 | {\r |
317 | exception = ffOuterInterpreterLoop();\r |
318 | if( exception == 0 )\r |
319 | {\r |
320 | exception = ffOK();\r |
321 | }\r |
322 | \r |
323 | switch( exception )\r |
324 | {\r |
325 | case 0:\r |
326 | break;\r |
327 | \r |
328 | case THROW_BYE:\r |
329 | go = 0;\r |
330 | break;\r |
331 | \r |
332 | case THROW_ABORT:\r |
333 | default:\r |
334 | ffDotS();\r |
335 | pfReportThrow( exception );\r |
336 | pfHandleIncludeError();\r |
337 | pfResetForthTask();\r |
338 | break;\r |
339 | }\r |
340 | }\r |
341 | \r |
342 | return gVarReturnCode;\r |
343 | }\r |
344 | \r |
345 | /***************************************************************\r |
346 | ** Include file based on 'C' name.\r |
347 | ***************************************************************/\r |
348 | \r |
1cb310e6 |
349 | cell_t pfIncludeFile( const char *FileName )\r |
bb6b2dcd |
350 | {\r |
351 | FileStream *fid;\r |
1cb310e6 |
352 | cell_t Result;\r |
bb6b2dcd |
353 | char buffer[32];\r |
1cb310e6 |
354 | cell_t numChars, len;\r |
bb6b2dcd |
355 | \r |
356 | /* Open file. */\r |
357 | fid = sdOpenFile( FileName, "r" );\r |
358 | if( fid == NULL )\r |
359 | {\r |
360 | ERR("pfIncludeFile could not open ");\r |
361 | ERR(FileName);\r |
362 | EMIT_CR;\r |
363 | return -1;\r |
364 | }\r |
365 | \r |
366 | /* Create a dictionary word named ::::FileName for FILE? */\r |
367 | pfCopyMemory( &buffer[0], "::::", 4);\r |
1cb310e6 |
368 | len = (cell_t) pfCStringLength(FileName);\r |
bb6b2dcd |
369 | numChars = ( len > (32-4-1) ) ? (32-4-1) : len;\r |
370 | pfCopyMemory( &buffer[4], &FileName[len-numChars], numChars+1 );\r |
371 | CreateDicEntryC( ID_NOOP, buffer, 0 );\r |
372 | \r |
90975d26 |
373 | Result = ffIncludeFile( fid ); /* Also close the file. */\r |
bb6b2dcd |
374 | \r |
375 | /* Create a dictionary word named ;;;; for FILE? */\r |
376 | CreateDicEntryC( ID_NOOP, ";;;;", 0 );\r |
377 | \r |
bb6b2dcd |
378 | return Result;\r |
379 | }\r |
380 | \r |
381 | /***************************************************************\r |
382 | ** Output 'C' string message.\r |
383 | ** Use sdTerminalOut which works before initializing gCurrentTask.\r |
384 | ***************************************************************/\r |
385 | void pfDebugMessage( const char *CString )\r |
386 | {\r |
387 | #if 0\r |
388 | while( *CString )\r |
389 | {\r |
390 | char c = *CString++;\r |
391 | if( c == '\n' )\r |
392 | {\r |
393 | sdTerminalOut( 0x0D );\r |
394 | sdTerminalOut( 0x0A );\r |
395 | pfDebugMessage( "DBG: " );\r |
396 | }\r |
397 | else\r |
398 | {\r |
399 | sdTerminalOut( c );\r |
400 | }\r |
401 | }\r |
402 | #else\r |
403 | (void)CString;\r |
404 | #endif\r |
405 | }\r |
406 | \r |
407 | /***************************************************************\r |
408 | ** Print a decimal number to debug output.\r |
409 | */\r |
410 | void pfDebugPrintDecimalNumber( int n )\r |
411 | {\r |
412 | pfDebugMessage( ConvertNumberToText( n, 10, TRUE, 1 ) );\r |
413 | }\r |
414 | \r |
415 | \r |
416 | /***************************************************************\r |
417 | ** Output 'C' string message.\r |
418 | ** This is provided to help avoid the use of printf() and other I/O\r |
419 | ** which may not be present on a small embedded system.\r |
420 | ** Uses ioType & ioEmit so requires that gCurrentTask has been initialized.\r |
421 | ***************************************************************/\r |
422 | void pfMessage( const char *CString )\r |
423 | {\r |
1cb310e6 |
424 | ioType( CString, (cell_t) pfCStringLength(CString) );\r |
bb6b2dcd |
425 | }\r |
426 | \r |
427 | /**************************************************************************\r |
1cb310e6 |
428 | ** Main entry point for pForth.\r |
bb6b2dcd |
429 | */\r |
1cb310e6 |
430 | cell_t pfDoForth( const char *DicFileName, const char *SourceName, cell_t IfInit )\r |
bb6b2dcd |
431 | {\r |
432 | pfTaskData_t *cftd;\r |
433 | pfDictionary_t *dic = NULL;\r |
1cb310e6 |
434 | cell_t Result = 0;\r |
bb6b2dcd |
435 | ExecToken EntryPoint = 0;\r |
bb6b2dcd |
436 | \r |
437 | #ifdef PF_USER_INIT\r |
438 | Result = PF_USER_INIT;\r |
b3651f38 |
439 | if( Result < 0 ) goto error1;\r |
bb6b2dcd |
440 | #endif\r |
441 | \r |
442 | pfInit();\r |
443 | \r |
bb6b2dcd |
444 | /* Allocate Task structure. */\r |
445 | pfDebugMessage("pfDoForth: call pfCreateTask()\n");\r |
446 | cftd = pfCreateTask( DEFAULT_USER_DEPTH, DEFAULT_RETURN_DEPTH );\r |
447 | \r |
448 | if( cftd )\r |
449 | {\r |
450 | pfSetCurrentTask( cftd );\r |
451 | \r |
a80283a7 |
452 | if( !gVarQuiet )\r |
bb6b2dcd |
453 | {\r |
454 | MSG( "PForth V"PFORTH_VERSION );\r |
6b91cb54 |
455 | if( IsHostLittleEndian() ) MSG("-LE");\r |
456 | else MSG("-BE");\r |
bb6b2dcd |
457 | #if PF_BIG_ENDIAN_DIC\r |
458 | MSG("/BE");\r |
459 | #elif PF_LITTLE_ENDIAN_DIC\r |
460 | MSG("/LE");\r |
461 | #endif\r |
1cb310e6 |
462 | if (sizeof(cell_t) == 8)\r |
463 | {\r |
464 | MSG("/64");\r |
465 | }\r |
466 | else if (sizeof(cell_t) == 4)\r |
467 | {\r |
468 | MSG("/32");\r |
469 | }\r |
470 | \r |
bb6b2dcd |
471 | MSG( ", built "__DATE__" "__TIME__ );\r |
472 | }\r |
473 | \r |
474 | /* Don't use MSG before task set. */\r |
475 | if( SourceName )\r |
476 | {\r |
477 | pfDebugMessage("SourceName = "); pfDebugMessage(SourceName); pfDebugMessage("\n");\r |
478 | }\r |
479 | \r |
480 | \r |
481 | #ifdef PF_NO_GLOBAL_INIT\r |
b3651f38 |
482 | if( LoadCustomFunctionTable() < 0 ) goto error2; /* Init custom 'C' call array. */\r |
bb6b2dcd |
483 | #endif\r |
484 | \r |
485 | #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))\r |
486 | if( IfInit )\r |
487 | {\r |
488 | pfDebugMessage("Build dictionary from scratch.\n");\r |
489 | dic = pfBuildDictionary( DEFAULT_HEADER_SIZE, DEFAULT_CODE_SIZE );\r |
490 | }\r |
491 | else\r |
492 | #else\r |
493 | TOUCH(IfInit);\r |
494 | #endif /* !PF_NO_INIT && !PF_NO_SHELL*/\r |
495 | {\r |
b3651f38 |
496 | if( DicFileName )\r |
bb6b2dcd |
497 | {\r |
b3651f38 |
498 | pfDebugMessage("DicFileName = "); pfDebugMessage(DicFileName); pfDebugMessage("\n");\r |
4f237935 |
499 | if( !gVarQuiet )\r |
500 | {\r |
501 | EMIT_CR;\r |
502 | }\r |
b3651f38 |
503 | dic = pfLoadDictionary( DicFileName, &EntryPoint );\r |
bb6b2dcd |
504 | }\r |
505 | else\r |
506 | {\r |
4f237935 |
507 | if( !gVarQuiet )\r |
508 | {\r |
509 | MSG(" (static)");\r |
510 | EMIT_CR;\r |
511 | }\r |
bb6b2dcd |
512 | dic = pfLoadStaticDictionary(); \r |
513 | }\r |
514 | }\r |
b3651f38 |
515 | if( dic == NULL ) goto error2;\r |
a80283a7 |
516 | \r |
517 | if( !gVarQuiet )\r |
518 | {\r |
519 | EMIT_CR;\r |
520 | }\r |
521 | \r |
bb6b2dcd |
522 | pfDebugMessage("pfDoForth: try AUTO.INIT\n");\r |
523 | Result = pfExecIfDefined("AUTO.INIT");\r |
524 | if( Result != 0 )\r |
525 | {\r |
526 | MSG("Error in AUTO.INIT");\r |
b3651f38 |
527 | goto error2;\r |
bb6b2dcd |
528 | }\r |
b3651f38 |
529 | \r |
bb6b2dcd |
530 | if( EntryPoint != 0 )\r |
531 | {\r |
532 | Result = pfCatch( EntryPoint );\r |
533 | }\r |
534 | #ifndef PF_NO_SHELL\r |
535 | else\r |
536 | {\r |
537 | if( SourceName == NULL )\r |
538 | {\r |
539 | pfDebugMessage("pfDoForth: pfQuit\n");\r |
540 | Result = pfQuit();\r |
541 | }\r |
542 | else\r |
543 | {\r |
544 | if( !gVarQuiet )\r |
545 | {\r |
546 | MSG("Including: ");\r |
547 | MSG(SourceName);\r |
548 | MSG("\n");\r |
549 | }\r |
550 | Result = pfIncludeFile( SourceName );\r |
551 | }\r |
552 | }\r |
553 | #endif /* PF_NO_SHELL */\r |
554 | \r |
555 | /* Clean up after running Forth. */\r |
556 | pfExecIfDefined("AUTO.TERM");\r |
557 | pfDeleteDictionary( dic );\r |
558 | pfDeleteTask( cftd );\r |
559 | }\r |
560 | \r |
561 | pfTerm();\r |
562 | \r |
563 | #ifdef PF_USER_TERM\r |
564 | PF_USER_TERM;\r |
565 | #endif\r |
566 | \r |
567 | return Result;\r |
568 | \r |
b3651f38 |
569 | error2:\r |
bb6b2dcd |
570 | MSG("pfDoForth: Error occured.\n");\r |
571 | pfDeleteTask( cftd );\r |
a80283a7 |
572 | /* Terminate so we restore normal shell tty mode. */\r |
b3651f38 |
573 | pfTerm();\r |
574 | \r |
575 | #ifdef PF_USER_INIT\r |
576 | error1:\r |
577 | #endif\r |
578 | \r |
bb6b2dcd |
579 | return -1;\r |
580 | }\r |
e2531e83 |
581 | \r |
582 | \r |
583 | #ifdef PF_UNIT_TEST\r |
584 | cell_t pfUnitTest( void )\r |
585 | {\r |
586 | cell_t numErrors = 0;\r |
587 | numErrors += pfUnitTestText();\r |
588 | return numErrors;\r |
589 | }\r |
590 | #endif\r |