1 /* @(#) pf_guts.h 98/01/28 1.4 */
5 /***************************************************************
6 ** Include file for PForth, a Forth based on 'C'
9 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
11 ** The pForth software code is dedicated to the public domain,
12 ** and any third party may reproduce, distribute and modify
13 ** the pForth software code or any derivative works thereof
14 ** without any compensation or license. The pForth software
15 ** code is provided on an "as is" basis without any warranty
16 ** of any kind, including, without limitation, the implied
17 ** warranties of merchantability and fitness for a particular
18 ** purpose and their equivalents under the laws of any jurisdiction.
20 ***************************************************************/
23 ** PFORTH_VERSION changes when PForth is modified and released.
24 ** See README file for version info.
26 #define PFORTH_VERSION "21"
29 ** PFORTH_FILE_VERSION changes when incompatible changes are made
30 ** in the ".dic" file format.
32 ** FV3 - 950225 - Use ABS_TO_CODEREL for CodePtr. See file "pf_save.c".
33 ** FV4 - 950309 - Added NameSize and CodeSize to pfSaveForth().
34 ** FV5 - 950316 - Added Floats and reserved words.
35 ** FV6 - 961213 - Added ID_LOCAL_PLUSSTORE, ID_COLON_P, etc.
36 ** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.
\r
37 ** FV8 - 980818 - Added Endian flag.
39 #define PF_FILE_VERSION (8) /* Bump this whenever primitives added. */
40 #define PF_EARLIEST_FILE_VERSION (8) /* earliest one still compatible */
42 /***************************************************************
43 ** Sizes and other constants
44 ***************************************************************/
46 #define TIB_SIZE (256)
59 #define FLAG_PRECEDENCE (0x80)
60 #define FLAG_IMMEDIATE (0x40)
61 #define FLAG_SMUDGE (0x20)
62 #define MASK_NAME_SIZE (0x1F)
64 /* Debug TRACE flags */
65 #define TRACE_INNER (0x0002)
66 #define TRACE_COMPILE (0x0004)
67 #define TRACE_SPECIAL (0x0008)
69 /* Numeric types returned by NUMBER? */
70 #define NUM_TYPE_BAD (0)
71 #define NUM_TYPE_SINGLE (1)
72 #define NUM_TYPE_DOUBLE (2)
73 #define NUM_TYPE_FLOAT (3)
75 #define CREATE_BODY_OFFSET (3*sizeof(cell))
77 /***************************************************************
78 ** Primitive Token IDS
79 ** Do NOT change the order of these IDs or dictionary files will break!
80 ***************************************************************/
81 enum cforth_primitive_ids
83 ID_EXIT = 0, /* ID_EXIT must always be zero. */
84 /* Do NOT change the order of these IDs or dictionary files will break! */
118 ID_COMP_U_GREATERTHAN,
121 ID_COMP_ZERO_GREATERTHAN,
122 ID_COMP_ZERO_LESSTHAN,
123 ID_COMP_ZERO_NOT_EQUAL,
256 ID_VAR_HEADERS_LIMIT,
273 /* If you add a word here, take away one reserved word below. */
275 /* Only reserve space if we are adding FP so that we can detect
276 ** unsupported primitives when loading dictionary.
304 ID_FP_F_ZERO_LESS_THAN,
347 /* Add new IDs by replacing reserved IDs or extending FP routines. */
348 /* Do NOT change the order of these IDs or dictionary files will break! */
349 NUM_PRIMITIVES /* This must always be LAST */
353 /***************************************************************
355 ***************************************************************/
356 #define CFTD_FLAG_GO (0x0001)
357 /* This flag is true when ABORTing to cause the 'C' code to unravel. */
358 #define CFTD_FLAG_ABORT (0x0002)
360 typedef struct cfTaskData
362 cell *td_StackPtr; /* Primary data stack */
365 cell *td_ReturnPtr; /* Return stack */
367 cell *td_ReturnLimit;
369 PF_FLOAT *td_FloatStackPtr;
370 PF_FLOAT *td_FloatStackBase;
371 PF_FLOAT *td_FloatStackLimit;
373 cell *td_InsPtr; /* Instruction pointer, "PC" */
375 FileStream *td_InputStream;
377 char td_TIB[TIB_SIZE]; /* Buffer for terminal input. */
378 cell td_IN; /* Index into Source */
379 cell td_SourceNum; /* #TIB after REFILL */
380 char *td_SourcePtr; /* Pointer to TIB or other source. */
381 int32 td_LineNumber; /* Incremented on every refill. */
382 cell td_OUT; /* Current output column. */
385 typedef struct pfNode
387 struct pfNode *n_Next;
388 struct pfNode *n_Prev;
391 /* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/
392 typedef struct cfNameLinks
394 cell cfnl_PreviousName; /* name relative address of previous */
395 ExecToken cfnl_ExecToken; /* Execution token for word. */
396 /* Followed by variable length name field. */
399 #define PF_DICF_ALLOCATED_SEGMENTS ( 0x0001)
400 typedef struct cfDictionary
404 /* Headers contain pointers to names and dictionary. */
\r
405 uint8 *dic_HeaderBaseUnaligned;
\r
406 uint8 *dic_HeaderBase;
412 uint8 *dic_HeaderLimit;
413 /* Code segment contains tokenized code and data. */
\r
414 uint8 *dic_CodeBaseUnaligned;
\r
421 uint8 *dic_CodeLimit;
424 /* Save state of include when nesting files. */
425 typedef struct IncludeFrame
427 FileStream *inf_FileID;
428 int32 inf_LineNumber;
431 char inf_SaveTIB[TIB_SIZE];
434 #define MAX_INCLUDE_DEPTH (8)
436 /***************************************************************
438 ***************************************************************/
444 void pfExecuteToken( ExecToken XT );
450 /***************************************************************
452 ***************************************************************/
453 extern cfTaskData *gCurrentTask;
454 extern cfDictionary *gCurrentDictionary;
455 extern char gScratch[TIB_SIZE];
456 extern int32 gNumPrimitives;
458 extern ExecToken gLocalCompiler_XT; /* CFA of (LOCAL) compiler. */
460 #define DEPTH_AT_COLON_INVALID (-100)
461 extern int32 gDepthAtColon;
463 /* Global variables. */
464 extern char *gVarContext; /* Points to last name field. */
465 extern cell gVarState; /* 1 if compiling. */
466 extern cell gVarBase; /* Numeric Base. */
467 extern cell gVarEcho; /* Echo input from file. */
468 extern cell gVarEchoAccept; /* Echo input from ACCEPT. */
469 extern cell gVarTraceLevel;
470 extern cell gVarTraceStack;
471 extern cell gVarTraceFlags;
472 extern cell gVarQuiet; /* Suppress unnecessary messages, OK, etc. */
473 extern cell gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */
475 /***************************************************************
477 ***************************************************************/
479 /* Endian specific macros for creating target dictionaries for machines with
\r
480 ** different endian-ness.
\r
482 #if defined(PF_BIG_ENDIAN_DIC)
\r
483 #define WRITE_FLOAT_DIC WriteFloatBigEndian
\r
484 #define WRITE_LONG_DIC(addr,data) WriteLongBigEndian((uint32 *)(addr),(uint32)(data))
\r
485 #define WRITE_SHORT_DIC(addr,data) WriteShortBigEndian((uint16 *)(addr),(uint16)(data))
\r
486 #define READ_FLOAT_DIC ReadFloatBigEndian
\r
487 #define READ_LONG_DIC(addr) ReadLongBigEndian((uint32 *)(addr))
\r
488 #define READ_SHORT_DIC(addr) ReadShortBigEndian((uint16 *)(addr))
\r
489 #elif defined(PF_LITTLE_ENDIAN_DIC)
\r
490 #define WRITE_FLOAT_DIC WriteFloatLittleEndian
\r
491 #define WRITE_LONG_DIC(addr,data) WriteLongLittleEndian((uint32 *)(addr),(uint32)(data))
\r
492 #define WRITE_SHORT_DIC(addr,data) WriteShortLittleEndian((uint16 *)(addr),(uint16)(data))
\r
493 #define READ_FLOAT_DIC ReadFloatLittleEndian
\r
494 #define READ_LONG_DIC(addr) ReadLongLittleEndian((uint32 *)(addr))
\r
495 #define READ_SHORT_DIC(addr) ReadShortLittleEndian((uint16 *)(addr))
\r
497 #define WRITE_FLOAT_DIC(addr,data) { *((PF_FLOAT *)(addr)) = (PF_FLOAT)(data); }
\r
498 #define WRITE_LONG_DIC(addr,data) { *((int32 *)(addr)) = (int32)(data); }
\r
499 #define WRITE_SHORT_DIC(addr,data) { *((int16 *)(addr)) = (int16)(data); }
\r
500 #define READ_FLOAT_DIC(addr) ( *((PF_FLOAT *)(addr)) )
\r
501 #define READ_LONG_DIC(addr) ( *((int32 *)(addr)) )
\r
502 #define READ_SHORT_DIC(addr) ( *((int16 *)(addr)) )
\r
505 #define HEADER_HERE (gCurrentDictionary->dic_HeaderPtr.Cell)
506 #define CODE_HERE (gCurrentDictionary->dic_CodePtr.Cell)
507 #define CODE_COMMA( N ) WRITE_LONG_DIC(CODE_HERE++,(N))
508 #define NAME_BASE (gCurrentDictionary->dic_HeaderBase)
509 #define CODE_BASE (gCurrentDictionary->dic_CodeBase)
510 #define NAME_SIZE (gCurrentDictionary->dic_HeaderLimit - gCurrentDictionary->dic_HeaderBase)
511 #define CODE_SIZE (gCurrentDictionary->dic_CodeLimit - gCurrentDictionary->dic_CodeBase)
\r
513 #define IN_CODE_DIC(addr) ( ( ((uint8 *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8 *)(addr)) < gCurrentDictionary->dic_CodeLimit) )
\r
514 #define IN_NAME_DIC(addr) ( ( ((uint8 *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8 *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )
515 #define IN_DICS(addr) (IN_CODE_DIC(addr) || IN_NAME_DIC(addr))
\r
517 /* Address conversion */
518 #define ABS_TO_NAMEREL( a ) ((int32) (((uint8 *) a) - NAME_BASE ))
519 #define ABS_TO_CODEREL( a ) ((int32) (((uint8 *) a) - CODE_BASE ))
520 #define NAMEREL_TO_ABS( a ) ((char *) (((int32) a) + NAME_BASE))
521 #define CODEREL_TO_ABS( a ) ((cell *) (((int32) a) + CODE_BASE))
523 /* The check for >0 is only needed for CLONE testing. !!! */
524 #define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))
526 #define SET_ABORT { gCurrentTask->td_Flags |= CFTD_FLAG_ABORT; }
527 #define CLEAR_ABORT { gCurrentTask->td_Flags &= ~CFTD_FLAG_ABORT; }
528 #define CHECK_ABORT (gCurrentTask->td_Flags & CFTD_FLAG_ABORT)
530 #define FREE_VAR(v) { if (v) { pfFreeMem(v); v = NULL; } }
532 #define DATA_STACK_DEPTH (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr)
533 #define DROP_DATA_STACK (gCurrentTask->td_StackPtr++)
534 #define POP_DATA_STACK (*gCurrentTask->td_StackPtr++)
535 #define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell) x; }
537 /* Force Quad alignment. */
538 #define QUADUP(x) (((x)+3)&~3)
540 #define MIN(a,b) ( ((a)<(b)) ? (a) : (b) )
541 #define MAX(a,b) ( ((a)>(b)) ? (a) : (b) )
545 #define TOUCH(argument) ((void)argument)
548 /***************************************************************
549 ** I/O related macros
550 ***************************************************************/
552 #define EMIT(c) ioEmit(c)
553 #define EMIT_CR EMIT('\n');
555 #define DBUG(x) /* PRT(x) */
556 #define DBUGX(x) /* DBUG(x) */
558 #define MSG(cs) pfMessage(cs)
559 #define ERR(x) MSG(x)
561 #define MSG_NUM_D(msg,num) { MSG(msg); ffDot((int32) num); EMIT_CR; }
562 #define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((int32) num); EMIT_CR; }
564 #endif /* _pf_guts_h */