/* @(#) pf_guts.h 98/01/28 1.4 */
/***************************************************************
** Include file for PForth, a Forth based on 'C'
** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
** The pForth software code is dedicated to the public domain,
** and any third party may reproduce, distribute and modify
** the pForth software code or any derivative works thereof
** without any compensation or license. The pForth software
** code is provided on an "as is" basis without any warranty
** of any kind, including, without limitation, the implied
** warranties of merchantability and fitness for a particular
** purpose and their equivalents under the laws of any jurisdiction.
***************************************************************/
** PFORTH_VERSION changes when PForth is modified and released.
** See README file for version info.
#define PFORTH_VERSION "27"
** PFORTH_FILE_VERSION changes when incompatible changes are made
** in the ".dic" file format.
** FV3 - 950225 - Use ABS_TO_CODEREL for CodePtr. See file "pf_save.c".
** FV4 - 950309 - Added NameSize and CodeSize to pfSaveForth().
** FV5 - 950316 - Added Floats and reserved words.
** FV6 - 961213 - Added ID_LOCAL_PLUSSTORE, ID_COLON_P, etc.
** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.
** FV8 - 980818 - Added Endian flag.
** FV9 - 20100503 - Added support for 64-bit CELL.
#define PF_FILE_VERSION (9) /* Bump this whenever primitives added. */
#define PF_EARLIEST_FILE_VERSION (9) /* earliest one still compatible */
/***************************************************************
** Sizes and other constants
***************************************************************/
#define FLAG_PRECEDENCE (0x80)
#define FLAG_IMMEDIATE (0x40)
#define FLAG_SMUDGE (0x20)
#define MASK_NAME_SIZE (0x1F)
#define TRACE_INNER (0x0002)
#define TRACE_COMPILE (0x0004)
#define TRACE_SPECIAL (0x0008)
/* Numeric types returned by NUMBER? */
#define NUM_TYPE_SINGLE (1)
#define NUM_TYPE_DOUBLE (2)
#define NUM_TYPE_FLOAT (3)
#define CREATE_BODY_OFFSET (3*sizeof(cell_t))
/***************************************************************
** Do NOT change the order of these IDs or dictionary files will break!
***************************************************************/
enum cforth_primitive_ids
ID_EXIT
= 0, /* ID_EXIT must always be zero. */
/* Do NOT change the order of these IDs or dictionary files will break! */
ID_COMP_ZERO_GREATERTHAN
,
/* Added to support 64 bit operation. */
/* If you add a word here, take away one reserved word below. */
/* Only reserve space if we are adding FP so that we can detect
** unsupported primitives when loading dictionary.
/* Add new IDs by replacing reserved IDs or extending FP routines. */
/* Do NOT change the order of these IDs or dictionary files will break! */
NUM_PRIMITIVES
/* This must always be LAST */
/***************************************************************
***************************************************************/
/* ANSI standard definitions needed by pForth */
#define THROW_ABORT_QUOTE (-2)
#define THROW_STACK_OVERFLOW (-3)
#define THROW_STACK_UNDERFLOW (-4)
#define THROW_UNDEFINED_WORD (-13)
#define THROW_EXECUTING (-14)
#define THROW_PAIRS (-22)
#define THROW_FLOAT_STACK_UNDERFLOW ( -45)
/* THROW codes unique to pForth */
#define THROW_BYE (-256) /* Exit program. */
#define THROW_SEMICOLON (-257) /* Error detected at ; */
#define THROW_DEFERRED (-258) /* Not a deferred word. Used in system.fth */
/***************************************************************
***************************************************************/
typedef struct pfTaskData_s
cell_t
*td_StackPtr
; /* Primary data stack */
cell_t
*td_ReturnPtr
; /* Return stack */
PF_FLOAT
*td_FloatStackPtr
;
PF_FLOAT
*td_FloatStackBase
;
PF_FLOAT
*td_FloatStackLimit
;
cell_t
*td_InsPtr
; /* Instruction pointer, "PC" */
FileStream
*td_InputStream
;
char td_TIB
[TIB_SIZE
]; /* Buffer for terminal input. */
cell_t td_IN
; /* Index into Source */
cell_t td_SourceNum
; /* #TIB after REFILL */
char *td_SourcePtr
; /* Pointer to TIB or other source. */
cell_t td_LineNumber
; /* Incremented on every refill. */
cell_t td_OUT
; /* Current output column. */
/* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/
typedef struct cfNameLinks
cell_t cfnl_PreviousName
; /* name relative address of previous */
ExecToken cfnl_ExecToken
; /* Execution token for word. */
/* Followed by variable length name field. */
#define PF_DICF_ALLOCATED_SEGMENTS ( 0x0001)
typedef struct pfDictionary_s
/* Headers contain pointers to names and dictionary. */
ucell_t dic_HeaderBaseUnaligned
;
/* Code segment contains tokenized code and data. */
ucell_t dic_CodeBaseUnaligned
;
/* Save state of include when nesting files. */
typedef struct IncludeFrame
char inf_SaveTIB
[TIB_SIZE
];
#define MAX_INCLUDE_DEPTH (16)
/***************************************************************
***************************************************************/
int pfCatch( ExecToken XT
);
/***************************************************************
***************************************************************/
extern pfTaskData_t
*gCurrentTask
;
extern pfDictionary_t
*gCurrentDictionary
;
extern char gScratch
[TIB_SIZE
];
extern cell_t gNumPrimitives
;
extern ExecToken gLocalCompiler_XT
; /* CFA of (LOCAL) compiler. */
extern ExecToken gNumberQ_XT
; /* XT of NUMBER? */
extern ExecToken gQuitP_XT
; /* XT of (QUIT) */
extern ExecToken gAcceptP_XT
; /* XT of ACCEPT */
#define DEPTH_AT_COLON_INVALID (-100)
extern cell_t gDepthAtColon
;
extern cell_t gVarContext
; /* Points to last name field. */
extern cell_t gVarState
; /* 1 if compiling. */
extern cell_t gVarBase
; /* Numeric Base. */
extern cell_t gVarEcho
; /* Echo input from file. */
extern cell_t gVarEchoAccept
; /* Echo input from ACCEPT. */
extern cell_t gVarTraceLevel
;
extern cell_t gVarTraceStack
;
extern cell_t gVarTraceFlags
;
extern cell_t gVarQuiet
; /* Suppress unnecessary messages, OK, etc. */
extern cell_t gVarReturnCode
; /* Returned to caller of Forth, eg. UNIX shell. */
extern IncludeFrame gIncludeStack
[MAX_INCLUDE_DEPTH
];
extern cell_t gIncludeIndex
;
/***************************************************************
***************************************************************/
/* Endian specific macros for creating target dictionaries for machines with
** different endian-ness.
#if defined(PF_BIG_ENDIAN_DIC)
#define WRITE_FLOAT_DIC WriteFloatBigEndian
#define WRITE_CELL_DIC(addr,data) WriteCellBigEndian((uint8_t *)(addr),(ucell_t)(data))
#define WRITE_SHORT_DIC(addr,data) Write16BigEndian((uint8_t *)(addr),(uint16_t)(data))
#define READ_FLOAT_DIC ReadFloatBigEndian
#define READ_CELL_DIC(addr) ReadCellBigEndian((const uint8_t *)(addr))
#define READ_SHORT_DIC(addr) Read16BigEndian((const uint8_t *)(addr))
#elif defined(PF_LITTLE_ENDIAN_DIC)
#define WRITE_FLOAT_DIC WriteFloatLittleEndian
#define WRITE_CELL_DIC(addr,data) WriteCellLittleEndian((uint8_t *)(addr),(ucell_t)(data))
#define WRITE_SHORT_DIC(addr,data) Write16LittleEndian((uint8_t *)(addr),(uint16_t)(data))
#define READ_FLOAT_DIC ReadFloatLittleEndian
#define READ_CELL_DIC(addr) ReadCellLittleEndian((const uint8_t *)(addr))
#define READ_SHORT_DIC(addr) Read16LittleEndian((const uint8_t *)(addr))
#define WRITE_FLOAT_DIC(addr,data) { *((PF_FLOAT *)(addr)) = (PF_FLOAT)(data); }
#define WRITE_CELL_DIC(addr,data) { *((cell_t *)(addr)) = (cell_t)(data); }
#define WRITE_SHORT_DIC(addr,data) { *((int16_t *)(addr)) = (int16_t)(data); }
#define READ_FLOAT_DIC(addr) ( *((PF_FLOAT *)(addr)) )
#define READ_CELL_DIC(addr) ( *((const ucell_t *)(addr)) )
#define READ_SHORT_DIC(addr) ( *((const uint16_t *)(addr)) )
#define HEADER_HERE (gCurrentDictionary->dic_HeaderPtr.Cell)
#define CODE_HERE (gCurrentDictionary->dic_CodePtr.Cell)
#define CODE_COMMA( N ) WRITE_CELL_DIC(CODE_HERE++,(N))
#define NAME_BASE (gCurrentDictionary->dic_HeaderBase)
#define CODE_BASE (gCurrentDictionary->dic_CodeBase)
#define NAME_SIZE (gCurrentDictionary->dic_HeaderLimit - gCurrentDictionary->dic_HeaderBase)
#define CODE_SIZE (gCurrentDictionary->dic_CodeLimit - gCurrentDictionary->dic_CodeBase)
#define IN_CODE_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_CodeLimit) )
#define IN_NAME_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )
#define IN_DICS(addr) (IN_CODE_DIC(addr) || IN_NAME_DIC(addr))
#define ABS_TO_NAMEREL( a ) ((cell_t) (((ucell_t) a) - NAME_BASE ))
#define ABS_TO_CODEREL( a ) ((cell_t) (((ucell_t) a) - CODE_BASE ))
#define NAMEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + NAME_BASE))
#define CODEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + CODE_BASE))
/* The check for >0 is only needed for CLONE testing. !!! */
#define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))
#define FREE_VAR(v) { if (v) { pfFreeMem((void *)(v)); v = 0; } }
#define DATA_STACK_DEPTH (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr)
#define DROP_DATA_STACK (gCurrentTask->td_StackPtr++)
#define POP_DATA_STACK (*gCurrentTask->td_StackPtr++)
#define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell_t) x; }
/* Force Quad alignment. */
#define QUADUP(x) (((x)+3)&~3)
#define MIN(a,b) ( ((a)<(b)) ? (a) : (b) )
#define MAX(a,b) ( ((a)>(b)) ? (a) : (b) )
#define TOUCH(argument) ((void)argument)
/***************************************************************
***************************************************************/
#define EMIT(c) ioEmit(c)
#define EMIT_CR EMIT('\n');
#define MSG(cs) pfMessage(cs)
#define DBUG(x) /* PRT(x) */
#define DBUGX(x) /* DBUG(x) */
#define MSG_NUM_D(msg,num) { MSG(msg); ffDot((cell_t) num); EMIT_CR; }
#define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((cell_t) num); EMIT_CR; }
#define DBUG_NUM_D(msg,num) { pfDebugMessage(msg); pfDebugPrintDecimalNumber((cell_t) num); pfDebugMessage("\n"); }