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