1 /* @(#) pf_guts.h 98/01/28 1.4 */
\r
5 /***************************************************************
\r
6 ** Include file for PForth, a Forth based on 'C'
\r
9 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\r
11 ** The pForth software code is dedicated to the public domain,
\r
12 ** and any third party may reproduce, distribute and modify
\r
13 ** the pForth software code or any derivative works thereof
\r
14 ** without any compensation or license. The pForth software
\r
15 ** code is provided on an "as is" basis without any warranty
\r
16 ** of any kind, including, without limitation, the implied
\r
17 ** warranties of merchantability and fitness for a particular
\r
18 ** purpose and their equivalents under the laws of any jurisdiction.
\r
20 ***************************************************************/
\r
23 ** PFORTH_VERSION changes when PForth is modified and released.
\r
24 ** See README file for version info.
\r
26 #define PFORTH_VERSION "27"
\r
29 ** PFORTH_FILE_VERSION changes when incompatible changes are made
\r
30 ** in the ".dic" file format.
\r
32 ** FV3 - 950225 - Use ABS_TO_CODEREL for CodePtr. See file "pf_save.c".
\r
33 ** FV4 - 950309 - Added NameSize and CodeSize to pfSaveForth().
\r
34 ** FV5 - 950316 - Added Floats and reserved words.
\r
35 ** FV6 - 961213 - Added ID_LOCAL_PLUSSTORE, ID_COLON_P, etc.
\r
36 ** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.
\r
37 ** FV8 - 980818 - Added Endian flag.
\r
38 ** FV9 - 20100503 - Added support for 64-bit CELL.
\r
40 #define PF_FILE_VERSION (9) /* Bump this whenever primitives added. */
\r
41 #define PF_EARLIEST_FILE_VERSION (9) /* earliest one still compatible */
\r
43 /***************************************************************
\r
44 ** Sizes and other constants
\r
45 ***************************************************************/
\r
47 #define TIB_SIZE (256)
\r
60 #define FLAG_PRECEDENCE (0x80)
\r
61 #define FLAG_IMMEDIATE (0x40)
\r
62 #define FLAG_SMUDGE (0x20)
\r
63 #define MASK_NAME_SIZE (0x1F)
\r
65 /* Debug TRACE flags */
\r
66 #define TRACE_INNER (0x0002)
\r
67 #define TRACE_COMPILE (0x0004)
\r
68 #define TRACE_SPECIAL (0x0008)
\r
70 /* Numeric types returned by NUMBER? */
\r
71 #define NUM_TYPE_BAD (0)
\r
72 #define NUM_TYPE_SINGLE (1)
\r
73 #define NUM_TYPE_DOUBLE (2)
\r
74 #define NUM_TYPE_FLOAT (3)
\r
76 #define CREATE_BODY_OFFSET (3*sizeof(cell_t))
\r
78 /***************************************************************
\r
79 ** Primitive Token IDS
\r
80 ** Do NOT change the order of these IDs or dictionary files will break!
\r
81 ***************************************************************/
\r
82 enum cforth_primitive_ids
\r
84 ID_EXIT = 0, /* ID_EXIT must always be zero. */
\r
85 /* Do NOT change the order of these IDs or dictionary files will break! */
\r
116 ID_COMP_GREATERTHAN,
\r
119 ID_COMP_U_GREATERTHAN,
\r
120 ID_COMP_U_LESSTHAN,
\r
121 ID_COMP_ZERO_EQUAL,
\r
122 ID_COMP_ZERO_GREATERTHAN,
\r
123 ID_COMP_ZERO_LESSTHAN,
\r
124 ID_COMP_ZERO_NOT_EQUAL,
\r
156 ID_FILE_REPOSITION,
\r
188 ID_LOCAL_PLUSSTORE,
\r
203 ID_NAME_TO_PREVIOUS,
\r
256 ID_VAR_HEADERS_BASE,
\r
257 ID_VAR_HEADERS_LIMIT,
\r
258 ID_VAR_HEADERS_PTR,
\r
261 ID_VAR_RETURN_CODE,
\r
265 ID_VAR_TRACE_FLAGS,
\r
266 ID_VAR_TRACE_LEVEL,
\r
267 ID_VAR_TRACE_STACK,
\r
279 /* Added to support 64 bit operation. */
\r
284 /* If you add a word here, take away one reserved word below. */
\r
285 #ifdef PF_SUPPORT_FP
\r
286 /* Only reserve space if we are adding FP so that we can detect
\r
287 ** unsupported primitives when loading dictionary.
\r
308 ID_FP_F_ZERO_LESS_THAN,
\r
309 ID_FP_F_ZERO_EQUALS,
\r
351 /* Add new IDs by replacing reserved IDs or extending FP routines. */
\r
352 /* Do NOT change the order of these IDs or dictionary files will break! */
\r
353 NUM_PRIMITIVES /* This must always be LAST */
\r
358 /***************************************************************
\r
360 ***************************************************************/
\r
361 /* ANSI standard definitions needed by pForth */
\r
362 #define THROW_ABORT (-1)
\r
363 #define THROW_ABORT_QUOTE (-2)
\r
364 #define THROW_STACK_OVERFLOW (-3)
\r
365 #define THROW_STACK_UNDERFLOW (-4)
\r
366 #define THROW_UNDEFINED_WORD (-13)
\r
367 #define THROW_EXECUTING (-14)
\r
368 #define THROW_PAIRS (-22)
\r
369 #define THROW_FLOAT_STACK_UNDERFLOW ( -45)
\r
370 #define THROW_QUIT (-56)
\r
372 /* THROW codes unique to pForth */
\r
373 #define THROW_BYE (-256) /* Exit program. */
\r
374 #define THROW_SEMICOLON (-257) /* Error detected at ; */
\r
375 #define THROW_DEFERRED (-258) /* Not a deferred word. Used in system.fth */
\r
377 /***************************************************************
\r
379 ***************************************************************/
\r
381 typedef struct pfTaskData_s
\r
383 cell_t *td_StackPtr; /* Primary data stack */
\r
384 cell_t *td_StackBase;
\r
385 cell_t *td_StackLimit;
\r
386 cell_t *td_ReturnPtr; /* Return stack */
\r
387 cell_t *td_ReturnBase;
\r
388 cell_t *td_ReturnLimit;
\r
389 #ifdef PF_SUPPORT_FP
\r
390 PF_FLOAT *td_FloatStackPtr;
\r
391 PF_FLOAT *td_FloatStackBase;
\r
392 PF_FLOAT *td_FloatStackLimit;
\r
394 cell_t *td_InsPtr; /* Instruction pointer, "PC" */
\r
395 FileStream *td_InputStream;
\r
397 char td_TIB[TIB_SIZE]; /* Buffer for terminal input. */
\r
398 cell_t td_IN; /* Index into Source */
\r
399 cell_t td_SourceNum; /* #TIB after REFILL */
\r
400 char *td_SourcePtr; /* Pointer to TIB or other source. */
\r
401 cell_t td_LineNumber; /* Incremented on every refill. */
\r
402 cell_t td_OUT; /* Current output column. */
\r
405 typedef struct pfNode
\r
407 struct pfNode *n_Next;
\r
408 struct pfNode *n_Prev;
\r
411 /* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/
\r
412 typedef struct cfNameLinks
\r
414 cell_t cfnl_PreviousName; /* name relative address of previous */
\r
415 ExecToken cfnl_ExecToken; /* Execution token for word. */
\r
416 /* Followed by variable length name field. */
\r
419 #define PF_DICF_ALLOCATED_SEGMENTS ( 0x0001)
\r
420 typedef struct pfDictionary_s
\r
424 /* Headers contain pointers to names and dictionary. */
\r
426 ucell_t dic_HeaderBaseUnaligned;
\r
428 ucell_t dic_HeaderBase;
\r
429 ucell_t dic_HeaderPtr;
\r
430 ucell_t dic_HeaderLimit;
\r
431 /* Code segment contains tokenized code and data. */
\r
432 ucell_t dic_CodeBaseUnaligned;
\r
433 ucell_t dic_CodeBase;
\r
439 ucell_t dic_CodeLimit;
\r
442 /* Save state of include when nesting files. */
\r
443 typedef struct IncludeFrame
\r
445 FileStream *inf_FileID;
\r
446 cell_t inf_LineNumber;
\r
447 cell_t inf_SourceNum;
\r
449 char inf_SaveTIB[TIB_SIZE];
\r
452 #define MAX_INCLUDE_DEPTH (16)
\r
454 /***************************************************************
\r
456 ***************************************************************/
\r
462 int pfCatch( ExecToken XT );
\r
468 /***************************************************************
\r
469 ** External Globals
\r
470 ***************************************************************/
\r
471 extern pfTaskData_t *gCurrentTask;
\r
472 extern pfDictionary_t *gCurrentDictionary;
\r
473 extern char gScratch[TIB_SIZE];
\r
474 extern cell_t gNumPrimitives;
\r
476 extern ExecToken gLocalCompiler_XT; /* CFA of (LOCAL) compiler. */
\r
477 extern ExecToken gNumberQ_XT; /* XT of NUMBER? */
\r
478 extern ExecToken gQuitP_XT; /* XT of (QUIT) */
\r
479 extern ExecToken gAcceptP_XT; /* XT of ACCEPT */
\r
481 #define DEPTH_AT_COLON_INVALID (-100)
\r
482 extern cell_t gDepthAtColon;
\r
484 /* Global variables. */
\r
485 extern cell_t gVarContext; /* Points to last name field. */
\r
486 extern cell_t gVarState; /* 1 if compiling. */
\r
487 extern cell_t gVarBase; /* Numeric Base. */
\r
488 extern cell_t gVarEcho; /* Echo input from file. */
\r
489 extern cell_t gVarEchoAccept; /* Echo input from ACCEPT. */
\r
490 extern cell_t gVarTraceLevel;
\r
491 extern cell_t gVarTraceStack;
\r
492 extern cell_t gVarTraceFlags;
\r
493 extern cell_t gVarQuiet; /* Suppress unnecessary messages, OK, etc. */
\r
494 extern cell_t gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */
\r
496 extern IncludeFrame gIncludeStack[MAX_INCLUDE_DEPTH];
\r
497 extern cell_t gIncludeIndex;
\r
498 /***************************************************************
\r
500 ***************************************************************/
\r
503 /* Endian specific macros for creating target dictionaries for machines with
\r
505 ** different endian-ness.
\r
509 #if defined(PF_BIG_ENDIAN_DIC)
\r
511 #define WRITE_FLOAT_DIC WriteFloatBigEndian
\r
512 #define WRITE_CELL_DIC(addr,data) WriteCellBigEndian((uint8_t *)(addr),(ucell_t)(data))
\r
513 #define WRITE_SHORT_DIC(addr,data) Write16BigEndian((uint8_t *)(addr),(uint16_t)(data))
\r
514 #define READ_FLOAT_DIC ReadFloatBigEndian
\r
515 #define READ_CELL_DIC(addr) ReadCellBigEndian((const uint8_t *)(addr))
\r
516 #define READ_SHORT_DIC(addr) Read16BigEndian((const uint8_t *)(addr))
\r
518 #elif defined(PF_LITTLE_ENDIAN_DIC)
\r
520 #define WRITE_FLOAT_DIC WriteFloatLittleEndian
\r
521 #define WRITE_CELL_DIC(addr,data) WriteCellLittleEndian((uint8_t *)(addr),(ucell_t)(data))
\r
522 #define WRITE_SHORT_DIC(addr,data) Write16LittleEndian((uint8_t *)(addr),(uint16_t)(data))
\r
523 #define READ_FLOAT_DIC ReadFloatLittleEndian
\r
524 #define READ_CELL_DIC(addr) ReadCellLittleEndian((const uint8_t *)(addr))
\r
525 #define READ_SHORT_DIC(addr) Read16LittleEndian((const uint8_t *)(addr))
\r
529 #define WRITE_FLOAT_DIC(addr,data) { *((PF_FLOAT *)(addr)) = (PF_FLOAT)(data); }
\r
530 #define WRITE_CELL_DIC(addr,data) { *((cell_t *)(addr)) = (cell_t)(data); }
\r
531 #define WRITE_SHORT_DIC(addr,data) { *((int16_t *)(addr)) = (int16_t)(data); }
\r
532 #define READ_FLOAT_DIC(addr) ( *((PF_FLOAT *)(addr)) )
\r
533 #define READ_CELL_DIC(addr) ( *((const ucell_t *)(addr)) )
\r
534 #define READ_SHORT_DIC(addr) ( *((const uint16_t *)(addr)) )
\r
539 #define HEADER_HERE (gCurrentDictionary->dic_HeaderPtr.Cell)
\r
540 #define CODE_HERE (gCurrentDictionary->dic_CodePtr.Cell)
\r
541 #define CODE_COMMA( N ) WRITE_CELL_DIC(CODE_HERE++,(N))
\r
542 #define NAME_BASE (gCurrentDictionary->dic_HeaderBase)
\r
543 #define CODE_BASE (gCurrentDictionary->dic_CodeBase)
\r
544 #define NAME_SIZE (gCurrentDictionary->dic_HeaderLimit - gCurrentDictionary->dic_HeaderBase)
\r
545 #define CODE_SIZE (gCurrentDictionary->dic_CodeLimit - gCurrentDictionary->dic_CodeBase)
\r
547 #define IN_CODE_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_CodeLimit) )
\r
549 #define IN_NAME_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )
\r
550 #define IN_DICS(addr) (IN_CODE_DIC(addr) || IN_NAME_DIC(addr))
\r
552 /* Address conversion */
\r
553 #define ABS_TO_NAMEREL( a ) ((cell_t) (((ucell_t) a) - NAME_BASE ))
\r
554 #define ABS_TO_CODEREL( a ) ((cell_t) (((ucell_t) a) - CODE_BASE ))
\r
555 #define NAMEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + NAME_BASE))
\r
556 #define CODEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + CODE_BASE))
\r
558 /* The check for >0 is only needed for CLONE testing. !!! */
\r
559 #define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))
\r
561 #define FREE_VAR(v) { if (v) { pfFreeMem((void *)(v)); v = 0; } }
\r
563 #define DATA_STACK_DEPTH (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr)
\r
564 #define DROP_DATA_STACK (gCurrentTask->td_StackPtr++)
\r
565 #define POP_DATA_STACK (*gCurrentTask->td_StackPtr++)
\r
566 #define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell_t) x; }
\r
568 /* Force Quad alignment. */
\r
569 #define QUADUP(x) (((x)+3)&~3)
\r
571 #define MIN(a,b) ( ((a)<(b)) ? (a) : (b) )
\r
572 #define MAX(a,b) ( ((a)>(b)) ? (a) : (b) )
\r
576 #define TOUCH(argument) ((void)argument)
\r
579 /***************************************************************
\r
580 ** I/O related macros
\r
581 ***************************************************************/
\r
583 #define EMIT(c) ioEmit(c)
\r
584 #define EMIT_CR EMIT('\n');
\r
586 #define MSG(cs) pfMessage(cs)
\r
587 #define ERR(x) MSG(x)
\r
589 #define DBUG(x) /* PRT(x) */
\r
590 #define DBUGX(x) /* DBUG(x) */
\r
592 #define MSG_NUM_D(msg,num) { MSG(msg); ffDot((cell_t) num); EMIT_CR; }
\r
593 #define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((cell_t) num); EMIT_CR; }
\r
595 #define DBUG_NUM_D(msg,num) { pfDebugMessage(msg); pfDebugPrintDecimalNumber((cell_t) num); pfDebugMessage("\n"); }
\r
597 #endif /* _pf_guts_h */
\r