TEMPOBJECTDIR = $(PFORTHDIR)/tempobjects
# This is needed to get pForth to build on Snow Leopard and other 64 bit platforms.
-WIDTHOPT=-m32
+WIDTHOPT=
FULL_WARNINGS = \
-fsigned-char \
-Winline \
-Wmissing-prototypes \
-Wmissing-declarations
-
+
DEBUGOPTS = -g
CCOPTS = $(WIDTHOPT) -x c -DPF_SUPPORT_FP -O2 $(FULL_WARNINGS) $(EXTRA_CCOPTS) $(DEBUGOPTS)
PFEMBOBJS = ${PFTEMP:${CSRCDIR}/%=${OBJECTDIR}/%}
COMPILE = $(COMPILER) $(CCOPTS) $(CDEFS)
-
+
${TEMPOBJECTDIR}/%.o: ${TEMPOBJECTDIR} $(PFINCLUDES) ${CSRCDIR}/%.c
$(COMPILE) -O -o ${TEMPOBJECTDIR}/$*.o -c ${CSRCDIR}/$*.c
-
-${OBJECTDIR}/%.o: ${OBJECTDIR} $(PFINCLUDES) ${CSRCDIR}/%.c ${CSRCDIR}/pfdicdat.h
+
+${OBJECTDIR}/%.o: ${OBJECTDIR} $(PFINCLUDES) ${CSRCDIR}/%.c ${CSRCDIR}/pfdicdat.h
$(COMPILE) -O -o ${OBJECTDIR}/$*.o -c ${CSRCDIR}/$*.c $(EMBCCOPTS)
all: $(PFORTHAPP)
@echo ${PFOBJS}
@echo "EMBEDDED OBJECT FILES ------------------"
@echo ${PFEMBOBJS}
-
-${TEMPOBJECTDIR}:
+
+${TEMPOBJECTDIR}:
mkdir -p ${TEMPOBJECTDIR}/posix
mkdir -p ${TEMPOBJECTDIR}/stdio
-${OBJECTDIR}:
+${OBJECTDIR}:
mkdir -p ${OBJECTDIR}/posix
mkdir -p ${OBJECTDIR}/stdio
$(COMPILER) $(PFEMBOBJS) $(WIDTHOPT) -lm -o $(PFORTHAPP)
@echo ""
@echo "Standalone pForth executable written to $(PFORTHAPP)"
-
-
+
+
# target aliases
pfdicapp: $(PFDICAPP)
clean:
- -rm -f $(PFOBJS) $(PFEMBOBJS)
- -rm $(PFORTHAPP)
- -rm $(PFDICDAT)
- -rm $(PFORTHDIC)
- -rm $(PFDICAPP)
+ rm -f $(PFOBJS) $(PFEMBOBJS)
+ rm -f $(PFORTHAPP)
+ rm -f $(PFDICDAT)
+ rm -f $(PFORTHDIC)
+ rm -f $(PFDICAPP)
extern CFunc0 CustomFunctionTable[];\r
\r
/***************************************************************/\r
-int32 CallUserFunction( int32 Index, int32 ReturnMode, int32 NumParams )\r
+cell_t CallUserFunction( cell_t Index, int32_t ReturnMode, int32_t NumParams )\r
{\r
- cell P1, P2, P3, P4, P5;\r
- cell Result = 0;\r
+ cell_t P1, P2, P3, P4, P5;\r
+ cell_t Result = 0;\r
CFunc0 CF;\r
\r
DBUG(("CallUserFunction: Index = %d, ReturnMode = %d, NumParams = %d\n",\r
\r
#if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))\r
/***************************************************************/\r
-Err CreateGlueToC( const char *CName, uint32 Index, int32 ReturnMode, int32 NumParams )\r
+Err CreateGlueToC( const char *CName, ucell_t Index, cell_t ReturnMode, int32_t NumParams )\r
{\r
- uint32 Packed;\r
+ ucell_t Packed;\r
char FName[40];\r
\r
CStringToForth( FName, CName );\r
**\r
***************************************************************/\r
\r
-typedef cell (*CFunc0)( void );\r
-typedef cell (*CFunc1)( cell P1 );\r
-typedef cell (*CFunc2)( cell P1, cell P2 );\r
-typedef cell (*CFunc3)( cell P1, cell P2, cell P3 );\r
-typedef cell (*CFunc4)( cell P1, cell P2, cell P3, cell P4 );\r
-typedef cell (*CFunc5)( cell P1, cell P2, cell P3, cell P4, cell P5 );\r
+typedef cell_t (*CFunc0)( void );\r
+typedef cell_t (*CFunc1)( cell_t P1 );\r
+typedef cell_t (*CFunc2)( cell_t P1, cell_t P2 );\r
+typedef cell_t (*CFunc3)( cell_t P1, cell_t P2, cell_t P3 );\r
+typedef cell_t (*CFunc4)( cell_t P1, cell_t P2, cell_t P3, cell_t P4 );\r
+typedef cell_t (*CFunc5)( cell_t P1, cell_t P2, cell_t P3, cell_t P4, cell_t P5 );\r
\r
#ifdef __cplusplus\r
extern "C" {\r
#endif\r
\r
-Err CreateGlueToC( const char *CName, uint32 Index, int32 ReturnMode, int32 NumParams );\r
+Err CreateGlueToC( const char *CName, ucell_t Index, cell_t ReturnMode, int32_t NumParams );\r
Err CompileCustomFunctions( void );\r
Err LoadCustomFunctionTable( void );\r
-int32 CallUserFunction( int32 Index, int32 ReturnMode, int32 NumParams );\r
+cell_t CallUserFunction( cell_t Index, int32_t ReturnMode, int32_t NumParams );\r
\r
#ifdef __cplusplus\r
} \r
#ifdef PF_NO_CLIB\r
/* Count chars until NUL. Replace strlen() */\r
#define NUL ((char) 0)\r
-cell pfCStringLength( const char *s )\r
+cell_t pfCStringLength( const char *s )\r
{\r
- cell len = 0;\r
+ cell_t len = 0;\r
while( *s++ != NUL ) len++;\r
return len;\r
}\r
\r
-/* void *memset (void *s, int32 c, size_t n); */\r
-void *pfSetMemory( void *s, cell c, cell n )\r
+/* void *memset (void *s, cell_t c, size_t n); */\r
+void *pfSetMemory( void *s, cell_t c, cell_t n )\r
{\r
- uint8 *p = s, byt = (uint8) c;\r
+ uint8_t *p = s, byt = (uint8_t) c;\r
while( (n--) > 0) *p++ = byt;\r
return s;\r
}\r
\r
-/* void *memccpy (void *s1, const void *s2, int32 c, size_t n); */\r
-void *pfCopyMemory( void *s1, const void *s2, cell n)\r
+/* void *memccpy (void *s1, const void *s2, cell_t c, size_t n); */\r
+void *pfCopyMemory( void *s1, const void *s2, cell_t n)\r
{\r
- uint8 *p1 = s1;\r
- const uint8 *p2 = s2;\r
+ uint8_t *p1 = s1;\r
+ const uint8_t *p2 = s2;\r
while( (n--) > 0) *p1++ = *p2++;\r
return s1;\r
}\r
extern "C" {\r
#endif\r
\r
- cell pfCStringLength( const char *s );\r
- void *pfSetMemory( void *s, cell c, cell n );\r
- void *pfCopyMemory( void *s1, const void *s2, cell n);\r
+ cell_t pfCStringLength( const char *s );\r
+ void *pfSetMemory( void *s, cell_t c, cell_t n );\r
+ void *pfCopyMemory( void *s1, const void *s2, cell_t n);\r
#define EXIT(n) {while(1);}\r
\r
#ifdef __cplusplus\r
char gScratch[TIB_SIZE];\r
pfTaskData_t *gCurrentTask = NULL;\r
pfDictionary_t *gCurrentDictionary;\r
-int32 gNumPrimitives;\r
+cell_t gNumPrimitives;\r
\r
ExecToken gLocalCompiler_XT; /* custom compiler for local variables */\r
ExecToken gNumberQ_XT; /* XT of NUMBER? */\r
ExecToken gAcceptP_XT; /* XT of ACCEPT */\r
\r
/* Depth of data stack when colon called. */\r
-int32 gDepthAtColon;\r
+cell_t gDepthAtColon;\r
\r
/* Global Forth variables. */\r
char *gVarContext; /* Points to last name field. */\r
-cell gVarState; /* 1 if compiling. */\r
-cell gVarBase; /* Numeric Base. */\r
-cell gVarEcho; /* Echo input. */\r
-cell gVarTraceLevel; /* Trace Level for Inner Interpreter. */\r
-cell gVarTraceStack; /* Dump Stack each time if true. */\r
-cell gVarTraceFlags; /* Enable various internal debug messages. */\r
-cell gVarQuiet; /* Suppress unnecessary messages, OK, etc. */\r
-cell gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */\r
+cell_t gVarState; /* 1 if compiling. */\r
+cell_t gVarBase; /* Numeric Base. */\r
+cell_t gVarEcho; /* Echo input. */\r
+cell_t gVarTraceLevel; /* Trace Level for Inner Interpreter. */\r
+cell_t gVarTraceStack; /* Dump Stack each time if true. */\r
+cell_t gVarTraceFlags; /* Enable various internal debug messages. */\r
+cell_t gVarQuiet; /* Suppress unnecessary messages, OK, etc. */\r
+cell_t gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */\r
\r
/* data for INCLUDE that allows multiple nested files. */\r
IncludeFrame gIncludeStack[MAX_INCLUDE_DEPTH];\r
-int32 gIncludeIndex;\r
+cell_t gIncludeIndex;\r
\r
static void pfResetForthTask( void );\r
static void pfInit( void );\r
\r
/* Allocate some extra cells to protect against mild stack underflows. */\r
#define STACK_SAFETY (8)\r
-PForthTask pfCreateTask( int32 UserStackDepth, int32 ReturnStackDepth )\r
+PForthTask pfCreateTask( cell_t UserStackDepth, cell_t ReturnStackDepth )\r
{\r
pfTaskData_t *cftd;\r
\r
pfSetMemory( cftd, 0, sizeof( pfTaskData_t ));\r
\r
/* Allocate User Stack */\r
- cftd->td_StackLimit = (cell *) pfAllocMem((uint32)(sizeof(int32) *\r
+ cftd->td_StackLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) *\r
(UserStackDepth + STACK_SAFETY)));\r
if( !cftd->td_StackLimit ) goto nomem;\r
cftd->td_StackBase = cftd->td_StackLimit + UserStackDepth;\r
cftd->td_StackPtr = cftd->td_StackBase;\r
\r
/* Allocate Return Stack */\r
- cftd->td_ReturnLimit = (cell *) pfAllocMem((uint32)(sizeof(int32) * ReturnStackDepth) );\r
+ cftd->td_ReturnLimit = (cell_t *) pfAllocMem((ucell_t)(sizeof(cell_t) * ReturnStackDepth) );\r
if( !cftd->td_ReturnLimit ) goto nomem;\r
cftd->td_ReturnBase = cftd->td_ReturnLimit + ReturnStackDepth;\r
cftd->td_ReturnPtr = cftd->td_ReturnBase;\r
/* Allocate Float Stack */\r
#ifdef PF_SUPPORT_FP\r
/* Allocate room for as many Floats as we do regular data. */\r
- cftd->td_FloatStackLimit = (PF_FLOAT *) pfAllocMem((uint32)(sizeof(PF_FLOAT) *\r
+ cftd->td_FloatStackLimit = (PF_FLOAT *) pfAllocMem((ucell_t)(sizeof(PF_FLOAT) *\r
(UserStackDepth + STACK_SAFETY)));\r
if( !cftd->td_FloatStackLimit ) goto nomem;\r
cftd->td_FloatStackBase = cftd->td_FloatStackLimit + UserStackDepth;\r
** Dictionary Management\r
***************************************************************/\r
\r
-int32 pfExecIfDefined( const char *CString )\r
+cell_t pfExecIfDefined( const char *CString )\r
{\r
int result = 0;\r
if( NAME_BASE != NULL)\r
** Delete using pfDeleteDictionary().\r
** Return pointer to dictionary management structure.\r
*/\r
-PForthDictionary pfCreateDictionary( int32 HeaderSize, int32 CodeSize )\r
+PForthDictionary pfCreateDictionary( cell_t HeaderSize, cell_t CodeSize )\r
{\r
/* Allocate memory for initial dictionary. */\r
pfDictionary_t *dic;\r
\r
/* Align dictionary segments to preserve alignment of floats across hosts.\r
* Thank you Helmut Proelss for pointing out that this needs to be cast\r
- * to (uint32) on 16 bit systems.\r
+ * to (ucell_t) on 16 bit systems.\r
*/\r
-#define DIC_ALIGNMENT_SIZE ((uint32)(0x10))\r
-#define DIC_ALIGN(addr) ((uint8 *)((((uint32)(addr)) + DIC_ALIGNMENT_SIZE - 1) & ~(DIC_ALIGNMENT_SIZE - 1)))\r
+#define DIC_ALIGNMENT_SIZE ((ucell_t)(0x10))\r
+#define DIC_ALIGN(addr) ((uint8_t *)((((ucell_t)(addr)) + DIC_ALIGNMENT_SIZE - 1) & ~(DIC_ALIGNMENT_SIZE - 1)))\r
\r
/* Allocate memory for header. */\r
if( HeaderSize > 0 )\r
{\r
- dic->dic_HeaderBaseUnaligned = ( uint8 * ) pfAllocMem( (uint32) HeaderSize + DIC_ALIGNMENT_SIZE );\r
+ dic->dic_HeaderBaseUnaligned = ( uint8_t * ) pfAllocMem( (ucell_t) HeaderSize + DIC_ALIGNMENT_SIZE );\r
if( !dic->dic_HeaderBaseUnaligned ) goto nomem;\r
/* Align header base. */\r
dic->dic_HeaderBase = DIC_ALIGN(dic->dic_HeaderBaseUnaligned);\r
- pfSetMemory( dic->dic_HeaderBase, 0xA5, (uint32) HeaderSize);\r
+ pfSetMemory( dic->dic_HeaderBase, 0xA5, (ucell_t) HeaderSize);\r
dic->dic_HeaderLimit = dic->dic_HeaderBase + HeaderSize;\r
dic->dic_HeaderPtr.Byte = dic->dic_HeaderBase;\r
}\r
}\r
\r
/* Allocate memory for code. */\r
- dic->dic_CodeBaseUnaligned = ( uint8 * ) pfAllocMem( (uint32) CodeSize + DIC_ALIGNMENT_SIZE );\r
+ dic->dic_CodeBaseUnaligned = ( uint8_t * ) pfAllocMem( (ucell_t) CodeSize + DIC_ALIGNMENT_SIZE );\r
if( !dic->dic_CodeBaseUnaligned ) goto nomem;\r
dic->dic_CodeBase = DIC_ALIGN(dic->dic_CodeBaseUnaligned);\r
- pfSetMemory( dic->dic_CodeBase, 0x5A, (uint32) CodeSize);\r
+ pfSetMemory( dic->dic_CodeBase, 0x5A, (ucell_t) CodeSize);\r
\r
dic->dic_CodeLimit = dic->dic_CodeBase + CodeSize;\r
dic->dic_CodePtr.Byte = dic->dic_CodeBase + QUADUP(NUM_PRIMITIVES); \r
** Set Quiet Flag.\r
***************************************************************/\r
\r
-void pfSetQuiet( int32 IfQuiet )\r
+void pfSetQuiet( cell_t IfQuiet )\r
{ \r
- gVarQuiet = (cell) IfQuiet;\r
+ gVarQuiet = (cell_t) IfQuiet;\r
}\r
\r
/***************************************************************\r
** Query message status.\r
***************************************************************/\r
\r
-int32 pfQueryQuiet( void )\r
+cell_t pfQueryQuiet( void )\r
{ \r
return gVarQuiet;\r
}\r
** Include file based on 'C' name.\r
***************************************************************/\r
\r
-int32 pfIncludeFile( const char *FileName )\r
+cell_t pfIncludeFile( const char *FileName )\r
{\r
FileStream *fid;\r
- int32 Result;\r
+ cell_t Result;\r
char buffer[32];\r
- int32 numChars, len;\r
+ cell_t numChars, len;\r
\r
/* Open file. */\r
fid = sdOpenFile( FileName, "r" );\r
\r
/* Create a dictionary word named ::::FileName for FILE? */\r
pfCopyMemory( &buffer[0], "::::", 4);\r
- len = (int32) pfCStringLength(FileName);\r
+ len = (cell_t) pfCStringLength(FileName);\r
numChars = ( len > (32-4-1) ) ? (32-4-1) : len;\r
pfCopyMemory( &buffer[4], &FileName[len-numChars], numChars+1 );\r
CreateDicEntryC( ID_NOOP, buffer, 0 );\r
***************************************************************/\r
void pfMessage( const char *CString )\r
{\r
- ioType( CString, (int32) pfCStringLength(CString) );\r
+ ioType( CString, (cell_t) pfCStringLength(CString) );\r
}\r
\r
/**************************************************************************\r
-** Main entry point for pForth.
+** Main entry point for pForth.\r
*/\r
-int32 pfDoForth( const char *DicFileName, const char *SourceName, int32 IfInit )\r
+cell_t pfDoForth( const char *DicFileName, const char *SourceName, cell_t IfInit )\r
{\r
pfTaskData_t *cftd;\r
pfDictionary_t *dic = NULL;\r
- int32 Result = 0;\r
+ cell_t Result = 0;\r
ExecToken EntryPoint = 0;\r
\r
#ifdef PF_USER_INIT\r
#elif PF_LITTLE_ENDIAN_DIC\r
MSG("/LE");\r
#endif\r
+ if (sizeof(cell_t) == 8)\r
+ {\r
+ MSG("/64");\r
+ }\r
+ else if (sizeof(cell_t) == 4)\r
+ {\r
+ MSG("/32");\r
+ }\r
+ \r
MSG( ", built "__DATE__" "__TIME__ );\r
}\r
\r
** PFORTH_VERSION changes when PForth is modified and released.\r
** See README file for version info.\r
*/\r
-#define PFORTH_VERSION "24"\r
+#define PFORTH_VERSION "25"\r
\r
/*\r
** PFORTH_FILE_VERSION changes when incompatible changes are made\r
** FV6 - 961213 - Added ID_LOCAL_PLUSSTORE, ID_COLON_P, etc.\r
** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.\r
** FV8 - 980818 - Added Endian flag.\r
+** FV9 - 20100503 - Added support for 64-bit CELL.\r
*/\r
-#define PF_FILE_VERSION (8) /* Bump this whenever primitives added. */\r
-#define PF_EARLIEST_FILE_VERSION (8) /* earliest one still compatible */\r
+#define PF_FILE_VERSION (9) /* Bump this whenever primitives added. */\r
+#define PF_EARLIEST_FILE_VERSION (9) /* earliest one still compatible */\r
\r
/***************************************************************\r
** Sizes and other constants\r
#define NUM_TYPE_DOUBLE (2)\r
#define NUM_TYPE_FLOAT (3)\r
\r
-#define CREATE_BODY_OFFSET (3*sizeof(cell))\r
+#define CREATE_BODY_OFFSET (3*sizeof(cell_t))\r
\r
/***************************************************************\r
** Primitive Token IDS\r
ID_INTERPRET,\r
ID_FILE_WO,\r
ID_FILE_BIN,\r
+ /* Added to support 64 bit operation. */\r
+ ID_CELL,\r
+ ID_CELLS,\r
/* If you add a word here, take away one reserved word below. */\r
#ifdef PF_SUPPORT_FP\r
/* Only reserve space if we are adding FP so that we can detect\r
ID_RESERVED12,\r
ID_RESERVED13,\r
ID_RESERVED14,\r
- ID_RESERVED15,\r
- ID_RESERVED16,\r
ID_FP_D_TO_F,\r
ID_FP_FSTORE,\r
ID_FP_FTIMES,\r
\r
typedef struct pfTaskData_s\r
{\r
- cell *td_StackPtr; /* Primary data stack */\r
- cell *td_StackBase;\r
- cell *td_StackLimit;\r
- cell *td_ReturnPtr; /* Return stack */\r
- cell *td_ReturnBase;\r
- cell *td_ReturnLimit;\r
+ cell_t *td_StackPtr; /* Primary data stack */\r
+ cell_t *td_StackBase;\r
+ cell_t *td_StackLimit;\r
+ cell_t *td_ReturnPtr; /* Return stack */\r
+ cell_t *td_ReturnBase;\r
+ cell_t *td_ReturnLimit;\r
#ifdef PF_SUPPORT_FP\r
PF_FLOAT *td_FloatStackPtr;\r
PF_FLOAT *td_FloatStackBase;\r
PF_FLOAT *td_FloatStackLimit;\r
#endif\r
- cell *td_InsPtr; /* Instruction pointer, "PC" */\r
+ cell_t *td_InsPtr; /* Instruction pointer, "PC" */\r
FileStream *td_InputStream;\r
/* Terminal. */\r
char td_TIB[TIB_SIZE]; /* Buffer for terminal input. */\r
- cell td_IN; /* Index into Source */\r
- cell td_SourceNum; /* #TIB after REFILL */\r
+ cell_t td_IN; /* Index into Source */\r
+ cell_t td_SourceNum; /* #TIB after REFILL */\r
char *td_SourcePtr; /* Pointer to TIB or other source. */\r
- int32 td_LineNumber; /* Incremented on every refill. */\r
- cell td_OUT; /* Current output column. */\r
+ cell_t td_LineNumber; /* Incremented on every refill. */\r
+ cell_t td_OUT; /* Current output column. */\r
} pfTaskData_t;\r
\r
typedef struct pfNode\r
/* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/\r
typedef struct cfNameLinks\r
{\r
- cell cfnl_PreviousName; /* name relative address of previous */\r
+ cell_t cfnl_PreviousName; /* name relative address of previous */\r
ExecToken cfnl_ExecToken; /* Execution token for word. */\r
/* Followed by variable length name field. */\r
} cfNameLinks;\r
typedef struct pfDictionary_s\r
{\r
pfNode dic_Node;\r
- uint32 dic_Flags;\r
+ ucell_t dic_Flags;\r
/* Headers contain pointers to names and dictionary. */\r
\r
- uint8 *dic_HeaderBaseUnaligned;\r
+ uint8_t *dic_HeaderBaseUnaligned;\r
\r
- uint8 *dic_HeaderBase;\r
+ uint8_t *dic_HeaderBase;\r
union\r
{\r
- cell *Cell;\r
- uint8 *Byte;\r
+ cell_t *Cell;\r
+ uint8_t *Byte;\r
} dic_HeaderPtr;\r
- uint8 *dic_HeaderLimit;\r
+ uint8_t *dic_HeaderLimit;\r
/* Code segment contains tokenized code and data. */\r
\r
- uint8 *dic_CodeBaseUnaligned;\r
+ uint8_t *dic_CodeBaseUnaligned;\r
\r
- uint8 *dic_CodeBase;\r
+ uint8_t *dic_CodeBase;\r
union\r
{\r
- cell *Cell;\r
- uint8 *Byte;\r
+ cell_t *Cell;\r
+ uint8_t *Byte;\r
} dic_CodePtr;\r
- uint8 *dic_CodeLimit;\r
+ uint8_t *dic_CodeLimit;\r
} pfDictionary_t;\r
\r
/* Save state of include when nesting files. */\r
typedef struct IncludeFrame\r
{\r
FileStream *inf_FileID;\r
- int32 inf_LineNumber;\r
- int32 inf_SourceNum;\r
- int32 inf_IN;\r
+ cell_t inf_LineNumber;\r
+ cell_t inf_SourceNum;\r
+ cell_t inf_IN;\r
char inf_SaveTIB[TIB_SIZE];\r
} IncludeFrame;\r
\r
extern pfTaskData_t *gCurrentTask;\r
extern pfDictionary_t *gCurrentDictionary;\r
extern char gScratch[TIB_SIZE];\r
-extern int32 gNumPrimitives;\r
+extern cell_t gNumPrimitives;\r
\r
extern ExecToken gLocalCompiler_XT; /* CFA of (LOCAL) compiler. */\r
extern ExecToken gNumberQ_XT; /* XT of NUMBER? */\r
extern ExecToken gAcceptP_XT; /* XT of ACCEPT */\r
\r
#define DEPTH_AT_COLON_INVALID (-100)\r
-extern int32 gDepthAtColon;\r
+extern cell_t gDepthAtColon;\r
\r
/* Global variables. */\r
extern char *gVarContext; /* Points to last name field. */\r
-extern cell gVarState; /* 1 if compiling. */\r
-extern cell gVarBase; /* Numeric Base. */\r
-extern cell gVarEcho; /* Echo input from file. */\r
-extern cell gVarEchoAccept; /* Echo input from ACCEPT. */\r
-extern cell gVarTraceLevel;\r
-extern cell gVarTraceStack;\r
-extern cell gVarTraceFlags;\r
-extern cell gVarQuiet; /* Suppress unnecessary messages, OK, etc. */\r
-extern cell gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */\r
+extern cell_t gVarState; /* 1 if compiling. */\r
+extern cell_t gVarBase; /* Numeric Base. */\r
+extern cell_t gVarEcho; /* Echo input from file. */\r
+extern cell_t gVarEchoAccept; /* Echo input from ACCEPT. */\r
+extern cell_t gVarTraceLevel;\r
+extern cell_t gVarTraceStack;\r
+extern cell_t gVarTraceFlags;\r
+extern cell_t gVarQuiet; /* Suppress unnecessary messages, OK, etc. */\r
+extern cell_t gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */\r
\r
extern IncludeFrame gIncludeStack[MAX_INCLUDE_DEPTH];\r
-extern int32 gIncludeIndex;\r
+extern cell_t gIncludeIndex;\r
/***************************************************************\r
** Macros\r
***************************************************************/\r
#if defined(PF_BIG_ENDIAN_DIC)\r
\r
#define WRITE_FLOAT_DIC WriteFloatBigEndian\r
-#define WRITE_LONG_DIC(addr,data) WriteLongBigEndian((uint32 *)(addr),(uint32)(data))\r
-#define WRITE_SHORT_DIC(addr,data) WriteShortBigEndian((uint16 *)(addr),(uint16)(data))\r
+#define WRITE_CELL_DIC(addr,data) WriteCellBigEndian((uint8_t *)(addr),(ucell_t)(data))\r
+#define WRITE_SHORT_DIC(addr,data) Write16BigEndian((uint8_t *)(addr),(uint16_t)(data))\r
#define READ_FLOAT_DIC ReadFloatBigEndian\r
-#define READ_LONG_DIC(addr) ReadLongBigEndian((const uint32 *)(addr))\r
-#define READ_SHORT_DIC(addr) ReadShortBigEndian((const uint16 *)(addr))\r
+#define READ_CELL_DIC(addr) ReadCellBigEndian((const uint8_t *)(addr))\r
+#define READ_SHORT_DIC(addr) Read16BigEndian((const uint8_t *)(addr))\r
\r
#elif defined(PF_LITTLE_ENDIAN_DIC)\r
\r
#define WRITE_FLOAT_DIC WriteFloatLittleEndian\r
-#define WRITE_LONG_DIC(addr,data) WriteLongLittleEndian((uint32 *)(addr),(uint32)(data))\r
-#define WRITE_SHORT_DIC(addr,data) WriteShortLittleEndian((uint16 *)(addr),(uint16)(data))\r
+#define WRITE_CELL_DIC(addr,data) WriteCellLittleEndian((uint8_t *)(addr),(ucell_t)(data))\r
+#define WRITE_SHORT_DIC(addr,data) Write16LittleEndian((uint8_t *)(addr),(uint16_t)(data))\r
#define READ_FLOAT_DIC ReadFloatLittleEndian\r
-#define READ_LONG_DIC(addr) ReadLongLittleEndian((const uint32 *)(addr))\r
-#define READ_SHORT_DIC(addr) ReadShortLittleEndian((const uint16 *)(addr))\r
+#define READ_CELL_DIC(addr) ReadCellLittleEndian((const uint8_t *)(addr))\r
+#define READ_SHORT_DIC(addr) Read16LittleEndian((const uint8_t *)(addr))\r
\r
#else\r
\r
#define WRITE_FLOAT_DIC(addr,data) { *((PF_FLOAT *)(addr)) = (PF_FLOAT)(data); }\r
-#define WRITE_LONG_DIC(addr,data) { *((int32 *)(addr)) = (int32)(data); }\r
-#define WRITE_SHORT_DIC(addr,data) { *((int16 *)(addr)) = (int16)(data); }\r
+#define WRITE_CELL_DIC(addr,data) { *((cell_t *)(addr)) = (cell_t)(data); }\r
+#define WRITE_SHORT_DIC(addr,data) { *((int16_t *)(addr)) = (int16_t)(data); }\r
#define READ_FLOAT_DIC(addr) ( *((PF_FLOAT *)(addr)) )\r
-#define READ_LONG_DIC(addr) ( *((const uint32 *)(addr)) )\r
-#define READ_SHORT_DIC(addr) ( *((const uint16 *)(addr)) )\r
+#define READ_CELL_DIC(addr) ( *((const ucell_t *)(addr)) )\r
+#define READ_SHORT_DIC(addr) ( *((const uint16_t *)(addr)) )\r
\r
#endif\r
\r
\r
#define HEADER_HERE (gCurrentDictionary->dic_HeaderPtr.Cell)\r
#define CODE_HERE (gCurrentDictionary->dic_CodePtr.Cell)\r
-#define CODE_COMMA( N ) WRITE_LONG_DIC(CODE_HERE++,(N))\r
+#define CODE_COMMA( N ) WRITE_CELL_DIC(CODE_HERE++,(N))\r
#define NAME_BASE (gCurrentDictionary->dic_HeaderBase)\r
#define CODE_BASE (gCurrentDictionary->dic_CodeBase)\r
#define NAME_SIZE (gCurrentDictionary->dic_HeaderLimit - gCurrentDictionary->dic_HeaderBase)\r
#define CODE_SIZE (gCurrentDictionary->dic_CodeLimit - gCurrentDictionary->dic_CodeBase)\r
\r
-#define IN_CODE_DIC(addr) ( ( ((uint8 *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8 *)(addr)) < gCurrentDictionary->dic_CodeLimit) )\r
+#define IN_CODE_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_CodeLimit) )\r
\r
-#define IN_NAME_DIC(addr) ( ( ((uint8 *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8 *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )\r
+#define IN_NAME_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )\r
#define IN_DICS(addr) (IN_CODE_DIC(addr) || IN_NAME_DIC(addr))\r
\r
/* Address conversion */\r
-#define ABS_TO_NAMEREL( a ) ((int32) (((uint8 *) a) - NAME_BASE ))\r
-#define ABS_TO_CODEREL( a ) ((int32) (((uint8 *) a) - CODE_BASE ))\r
-#define NAMEREL_TO_ABS( a ) ((char *) (((int32) a) + NAME_BASE))\r
-#define CODEREL_TO_ABS( a ) ((cell *) (((int32) a) + CODE_BASE))\r
+#define ABS_TO_NAMEREL( a ) ((cell_t) (((uint8_t *) a) - NAME_BASE ))\r
+#define ABS_TO_CODEREL( a ) ((cell_t) (((uint8_t *) a) - CODE_BASE ))\r
+#define NAMEREL_TO_ABS( a ) ((char *) (((cell_t) a) + NAME_BASE))\r
+#define CODEREL_TO_ABS( a ) ((cell_t *) (((cell_t) a) + CODE_BASE))\r
\r
/* The check for >0 is only needed for CLONE testing. !!! */\r
#define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))\r
#define DATA_STACK_DEPTH (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr)\r
#define DROP_DATA_STACK (gCurrentTask->td_StackPtr++)\r
#define POP_DATA_STACK (*gCurrentTask->td_StackPtr++)\r
-#define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell) x; }\r
+#define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell_t) x; }\r
\r
/* Force Quad alignment. */\r
#define QUADUP(x) (((x)+3)&~3)\r
#define DBUG(x) /* PRT(x) */\r
#define DBUGX(x) /* DBUG(x) */\r
\r
-#define MSG_NUM_D(msg,num) { MSG(msg); ffDot((int32) num); EMIT_CR; }\r
-#define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((int32) num); EMIT_CR; }\r
+#define MSG_NUM_D(msg,num) { MSG(msg); ffDot((cell_t) num); EMIT_CR; }\r
+#define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((cell_t) num); EMIT_CR; }\r
\r
-#define DBUG_NUM_D(msg,num) { pfDebugMessage(msg); pfDebugPrintDecimalNumber((int32) num); pfDebugMessage("\n"); }\r
+#define DBUG_NUM_D(msg,num) { pfDebugMessage(msg); pfDebugPrintDecimalNumber((cell_t) num); pfDebugMessage("\n"); }\r
\r
#endif /* _pf_guts_h */\r
\r
#define STKPTR (DataStackPtr)\r
#define M_POP (*(STKPTR++))\r
-#define M_PUSH(n) {*(--(STKPTR)) = (cell) (n);}\r
+#define M_PUSH(n) {*(--(STKPTR)) = (cell_t) (n);}\r
#define M_STACK(n) (STKPTR[n])\r
\r
#define TOS (TopOfStack)\r
#define M_R_DROP {TORPTR++;}\r
#define M_R_POP (*(TORPTR++))\r
#define M_R_PICK(n) (TORPTR[n])\r
-#define M_R_PUSH(n) {*(--(TORPTR)) = (cell) (n);}\r
+#define M_R_PUSH(n) {*(--(TORPTR)) = (cell_t) (n);}\r
\r
/***************************************************************\r
** Misc Forth macros\r
***************************************************************/\r
\r
-#define M_BRANCH { InsPtr = (cell *) (((uint8 *) InsPtr) + READ_LONG_DIC(InsPtr)); }\r
+#define M_BRANCH { InsPtr = (cell_t *) (((uint8_t *) InsPtr) + READ_CELL_DIC(InsPtr)); }\r
\r
/* Cache top of data stack like in JForth. */\r
#ifdef PF_SUPPORT_FP\r
ffDotS( ); \\r
LOAD_REGISTERS;\r
\r
-#define DO_VAR(varname) { PUSH_TOS; TOS = (cell) &varname; }\r
+#define DO_VAR(varname) { PUSH_TOS; TOS = (cell_t) &varname; }\r
\r
#ifdef PF_SUPPORT_FP\r
#define M_THROW(err) \\r
#define TRACENAMES /* no names */\r
#else\r
/* Display name of executing routine. */\r
-static void TraceNames( ExecToken Token, int32 Level )\r
+static void TraceNames( ExecToken Token, cell_t Level )\r
{\r
char *DebugName;\r
- int32 i;\r
+ cell_t i;\r
\r
if( ffTokenToName( Token, &DebugName ) )\r
{\r
- cell NumSpaces;\r
+ cell_t NumSpaces;\r
if( gCurrentTask->td_OUT > 0 ) EMIT_CR;\r
EMIT( '>' );\r
for( i=0; i<Level; i++ )\r
#endif /* PF_NO_SHELL */\r
\r
/* Use local copy of CODE_BASE for speed. */\r
-#define LOCAL_CODEREL_TO_ABS( a ) ((cell *) (((int32) a) + CodeBase))\r
+#define LOCAL_CODEREL_TO_ABS( a ) ((cell_t *) (((cell_t) a) + CodeBase))\r
\r
static const char *pfSelectFileModeCreate( int fam );\r
static const char *pfSelectFileModeOpen( int fam );\r
/**************************************************************/\r
int pfCatch( ExecToken XT )\r
{\r
- register cell TopOfStack; /* Cache for faster execution. */\r
- register cell *DataStackPtr;\r
- register cell *ReturnStackPtr;\r
- register cell *InsPtr = NULL;\r
- register cell Token;\r
- cell Scratch;\r
+ register cell_t TopOfStack; /* Cache for faster execution. */\r
+ register cell_t *DataStackPtr;\r
+ register cell_t *ReturnStackPtr;\r
+ register cell_t *InsPtr = NULL;\r
+ register cell_t Token;\r
+ cell_t Scratch;\r
\r
#ifdef PF_SUPPORT_FP\r
PF_FLOAT fpTopOfStack;\r
PF_FLOAT *InitialFloatStack;\r
#endif\r
#ifdef PF_SUPPORT_TRACE\r
- int32 Level = 0;\r
+ cell_t Level = 0;\r
#endif\r
- cell *LocalsPtr = NULL;\r
- cell Temp;\r
- cell *InitialReturnStack;\r
- cell *InitialDataStack;\r
- cell FakeSecondary[2];\r
+ cell_t *LocalsPtr = NULL;\r
+ cell_t Temp;\r
+ cell_t *InitialReturnStack;\r
+ cell_t *InitialDataStack;\r
+ cell_t FakeSecondary[2];\r
char *CharPtr;\r
- cell *CellPtr;\r
+ cell_t *CellPtr;\r
FileStream *FileID;\r
- uint8 *CodeBase = CODE_BASE;\r
+ uint8_t *CodeBase = CODE_BASE;\r
ThrowCode ExceptionReturnCode = 0;\r
\r
/* FIXME\r
M_R_PUSH( InsPtr );\r
\r
/* Convert execution token to absolute address. */\r
- InsPtr = (cell *) ( LOCAL_CODEREL_TO_ABS(Token) );\r
+ InsPtr = (cell_t *) ( LOCAL_CODEREL_TO_ABS(Token) );\r
\r
/* Fetch token at IP. */\r
- Token = READ_LONG_DIC(InsPtr++);\r
+ Token = READ_CELL_DIC(InsPtr++);\r
\r
#ifdef PF_SUPPORT_TRACE\r
/* Bump level for trace display */\r
** Used to implement semicolon.\r
** Put first in switch because ID_EXIT==0 */\r
case ID_EXIT:\r
- InsPtr = ( cell *) M_R_POP;\r
+ InsPtr = ( cell_t *) M_R_POP;\r
#ifdef PF_SUPPORT_TRACE\r
Level--;\r
#endif\r
case ID_2LITERAL_P:\r
/* hi part stored first, put on top of stack */\r
PUSH_TOS;\r
- TOS = READ_LONG_DIC(InsPtr++);\r
- M_PUSH(READ_LONG_DIC(InsPtr++));\r
+ TOS = READ_CELL_DIC(InsPtr++);\r
+ M_PUSH(READ_CELL_DIC(InsPtr++));\r
endcase;\r
\r
case ID_2MINUS: TOS -= 2; endcase;\r
\r
case ID_ALITERAL_P:\r
PUSH_TOS;\r
- TOS = (cell) LOCAL_CODEREL_TO_ABS( READ_LONG_DIC(InsPtr++) );\r
+ TOS = (cell_t) LOCAL_CODEREL_TO_ABS( READ_CELL_DIC(InsPtr++) );\r
endcase;\r
\r
/* Allocate some extra and put validation identifier at base */\r
#define PF_MEMORY_VALIDATOR (0xA81B4D69)\r
case ID_ALLOCATE:\r
/* Allocate at least one cell's worth because we clobber first cell. */\r
- if ( TOS < sizeof(cell) )\r
+ if ( TOS < sizeof(cell_t) )\r
{\r
- Temp = sizeof(cell);\r
+ Temp = sizeof(cell_t);\r
}\r
else\r
{\r
Temp = TOS;\r
}\r
/* Allocate extra cells worth because we store validation info. */\r
- CellPtr = (cell *) pfAllocMem( Temp + sizeof(cell) );\r
+ CellPtr = (cell_t *) pfAllocMem( Temp + sizeof(cell_t) );\r
if( CellPtr )\r
{\r
/* This was broken into two steps because different compilers incremented\r
** CellPtr before or after the XOR step. */\r
- Temp = (int32)CellPtr ^ PF_MEMORY_VALIDATOR;\r
+ Temp = (cell_t)CellPtr ^ PF_MEMORY_VALIDATOR;\r
*CellPtr++ = Temp;\r
- M_PUSH( (cell) CellPtr );\r
+ M_PUSH( (cell_t) CellPtr );\r
TOS = 0;\r
}\r
else\r
\r
case ID_CALL_C:\r
SAVE_REGISTERS;\r
- Scratch = READ_LONG_DIC(InsPtr++);\r
+ Scratch = READ_CELL_DIC(InsPtr++);\r
CallUserFunction( Scratch & 0xFFFF,\r
(Scratch >> 31) & 1,\r
(Scratch >> 24) & 0x7F );\r
LOAD_REGISTERS;\r
endcase;\r
-\r
- case ID_CFETCH: TOS = *((uint8 *) TOS); endcase;\r
+ \r
+ /* Support 32/64 bit operation. */\r
+ case ID_CELL:\r
+ M_PUSH( TOS );\r
+ TOS = sizeof(cell_t);\r
+ endcase;\r
+ \r
+ case ID_CELLS:\r
+ TOS = TOS * sizeof(cell_t);\r
+ endcase;\r
+ \r
+ case ID_CFETCH: TOS = *((uint8_t *) TOS); endcase;\r
\r
case ID_CMOVE: /* ( src dst n -- ) */\r
{\r
register char *DstPtr = (char *) M_POP; /* dst */\r
CharPtr = (char *) M_POP; /* src */\r
- for( Scratch=0; (uint32) Scratch < (uint32) TOS ; Scratch++ )\r
+ for( Scratch=0; (ucell_t) Scratch < (ucell_t) TOS ; Scratch++ )\r
{\r
*DstPtr++ = *CharPtr++;\r
}\r
{\r
register char *DstPtr = ((char *) M_POP) + TOS; /* dst */\r
CharPtr = ((char *) M_POP) + TOS;; /* src */\r
- for( Scratch=0; (uint32) Scratch < (uint32) TOS ; Scratch++ )\r
+ for( Scratch=0; (ucell_t) Scratch < (ucell_t) TOS ; Scratch++ )\r
{\r
*(--DstPtr) = *(--CharPtr);\r
}\r
case ID_COMPARE:\r
{\r
const char *s1, *s2;\r
- int32 len1;\r
+ cell_t len1;\r
s2 = (const char *) M_POP;\r
len1 = M_POP;\r
s1 = (const char *) M_POP;\r
TOS = ( M_POP < TOS ) ? FTRUE : FFALSE ;\r
endcase;\r
case ID_COMP_U_GREATERTHAN:\r
- TOS = ( ((uint32)M_POP) > ((uint32)TOS) ) ? FTRUE : FFALSE ;\r
+ TOS = ( ((ucell_t)M_POP) > ((ucell_t)TOS) ) ? FTRUE : FFALSE ;\r
endcase;\r
case ID_COMP_U_LESSTHAN:\r
- TOS = ( ((uint32)M_POP) < ((uint32)TOS) ) ? FTRUE : FFALSE ;\r
+ TOS = ( ((ucell_t)M_POP) < ((ucell_t)TOS) ) ? FTRUE : FFALSE ;\r
endcase;\r
case ID_COMP_ZERO_EQUAL:\r
TOS = ( TOS == 0 ) ? FTRUE : FFALSE ;\r
case ID_CREATE_P:\r
PUSH_TOS;\r
/* Put address of body on stack. Insptr points after code start. */\r
- TOS = (cell) ((char *)InsPtr - sizeof(cell) + CREATE_BODY_OFFSET );\r
+ TOS = (cell_t) ((char *)InsPtr - sizeof(cell_t) + CREATE_BODY_OFFSET );\r
endcase;\r
\r
case ID_CSTORE: /* ( c caddr -- ) */\r
- *((uint8 *) TOS) = (uint8) M_POP;\r
+ *((uint8_t *) TOS) = (uint8_t) M_POP;\r
M_DROP;\r
endcase;\r
\r
/* Double precision add. */\r
case ID_D_PLUS: /* D+ ( al ah bl bh -- sl sh ) */ \r
{\r
- register ucell ah,al,bl,sh,sl;\r
+ register ucell_t ah,al,bl,sh,sl;\r
#define bh TOS\r
bl = M_POP;\r
ah = M_POP;\r
/* Double precision subtract. */\r
case ID_D_MINUS: /* D- ( al ah bl bh -- sl sh ) */ \r
{\r
- register ucell ah,al,bl,sh,sl;\r
+ register ucell_t ah,al,bl,sh,sl;\r
#define bh TOS\r
bl = M_POP;\r
ah = M_POP;\r
\r
/* Perform 32*32 bit multiply for 64 bit result, by factoring into 16 bit quantities. */\r
/* Using an improved algorithm suggested by Steve Green. */\r
- case ID_D_UMTIMES: /* M* ( a b -- pl ph ) */ \r
+ case ID_D_UMTIMES: /* UM* ( a b -- pl ph ) */ \r
{\r
- ucell ahi, alo, bhi, blo, temp;\r
- ucell pl, ph;\r
+ ucell_t ahi, alo, bhi, blo, temp;\r
+ ucell_t pl, ph;\r
/* Get values from stack. */\r
ahi = M_POP;\r
bhi = TOS;\r
/* Perform 32*32 bit multiply for 64 bit result, using shift and add. */\r
case ID_D_MTIMES: /* M* ( a b -- pl ph ) */ \r
{\r
- cell a,b;\r
- ucell ap,bp, ahi, alo, bhi, blo, temp;\r
- ucell pl, ph;\r
+ cell_t a,b;\r
+ ucell_t ap,bp, ahi, alo, bhi, blo, temp;\r
+ ucell_t pl, ph;\r
/* Get values from stack. */\r
a = M_POP;\r
b = TOS;\r
/* Perform 64/32 bit divide for 32 bit result, using shift and subtract. */\r
case ID_D_UMSMOD: /* UM/MOD ( al ah bdiv -- rem q ) */ \r
{\r
- ucell ah,al, q,di, bl,bh, sl,sh;\r
+ ucell_t ah,al, q,di, bl,bh, sl,sh;\r
ah = M_POP;\r
al = M_POP;\r
bh = TOS;\r
/* Perform 64/32 bit divide for 64 bit result, using shift and subtract. */\r
case ID_D_MUSMOD: /* MU/MOD ( al am bdiv -- rem ql qh ) */ \r
{\r
- register ucell ah,am,al,ql,qh,di;\r
-#define bdiv ((ucell)TOS)\r
+ register ucell_t ah,am,al,ql,qh,di;\r
+#define bdiv ((ucell_t)TOS)\r
ah = 0;\r
am = M_POP;\r
al = M_POP;\r
qh = ql = 0;\r
- for( di=0; di<64; di++ )\r
+#define NBITS (sizeof(cell_t)*8)\r
+ for( di=0; di<2*NBITS; di++ )\r
{\r
if( bdiv <= ah )\r
{\r
ah = ah - bdiv;\r
ql |= 1;\r
}\r
- qh = (qh << 1) | (ql >> 31);\r
+ qh = (qh << 1) | (ql >> (NBITS-1));\r
ql = ql << 1;\r
- ah = (ah << 1) | (am >> 31);\r
- am = (am << 1) | (al >> 31);\r
+ ah = (ah << 1) | (am >> (NBITS-1));\r
+ am = (am << 1) | (al >> (NBITS-1));\r
al = al << 1;\r
DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));\r
}\r
\r
case ID_EOL: /* ( -- end_of_line_char ) */\r
PUSH_TOS;\r
- TOS = (cell) '\n';\r
+ TOS = (cell_t) '\n';\r
endcase;\r
\r
case ID_ERRORQ_P: /* ( flag num -- , quit if flag true ) */\r
#endif\r
if( IsTokenPrimitive( TOS ) )\r
{\r
- WRITE_LONG_DIC( (cell *) &FakeSecondary[0], TOS); /* Build a fake secondary and execute it. */\r
+ WRITE_CELL_DIC( (cell_t *) &FakeSecondary[0], TOS); /* Build a fake secondary and execute it. */\r
InsPtr = &FakeSecondary[0];\r
}\r
else\r
{\r
- InsPtr = (cell *) LOCAL_CODEREL_TO_ABS(TOS);\r
+ InsPtr = (cell_t *) LOCAL_CODEREL_TO_ABS(TOS);\r
}\r
M_DROP;\r
endcase;\r
#if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
if( IN_DICS( TOS ) )\r
{\r
- TOS = (cell) READ_LONG_DIC((cell *)TOS);\r
+ TOS = (cell_t) READ_CELL_DIC((cell_t *)TOS);\r
}\r
else\r
{\r
- TOS = *((cell *)TOS);\r
+ TOS = *((cell_t *)TOS);\r
}\r
#else\r
- TOS = *((cell *)TOS);\r
+ TOS = *((cell_t *)TOS);\r
#endif\r
endcase;\r
\r
if( Scratch < TIB_SIZE-2 )\r
{\r
const char *famText = pfSelectFileModeCreate( TOS );\r
- pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
+ pfCopyMemory( gScratch, (char *) Temp, (ucell_t) Scratch );\r
gScratch[Scratch] = '\0';\r
DBUG(("Create file = %s with famTxt %s\n", gScratch, famText ));\r
FileID = sdOpenFile( gScratch, famText );\r
TOS = ( FileID == NULL ) ? -1 : 0 ;\r
- M_PUSH( (cell) FileID );\r
+ M_PUSH( (cell_t) FileID );\r
}\r
else\r
{\r
if( Scratch < TIB_SIZE-2 )\r
{\r
const char *famText = pfSelectFileModeOpen( TOS );\r
- pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
+ pfCopyMemory( gScratch, (char *) Temp, (ucell_t) Scratch );\r
gScratch[Scratch] = '\0';\r
DBUG(("Open file = %s\n", gScratch ));\r
FileID = sdOpenFile( gScratch, famText );\r
\r
TOS = ( FileID == NULL ) ? -1 : 0 ;\r
- M_PUSH( (cell) FileID );\r
+ M_PUSH( (cell_t) FileID );\r
}\r
else\r
{\r
register char *DstPtr;\r
Temp = M_POP; /* num */\r
DstPtr = (char *) M_POP; /* dst */\r
- for( Scratch=0; (uint32) Scratch < (uint32) Temp ; Scratch++ )\r
+ for( Scratch=0; (ucell_t) Scratch < (ucell_t) Temp ; Scratch++ )\r
{\r
*DstPtr++ = (char) TOS;\r
}\r
\r
case ID_FINDNFA:\r
TOS = ffFindNFA( (const ForthString *) TOS, (const ForthString **) &Temp );\r
- M_PUSH( (cell) Temp );\r
+ M_PUSH( (cell_t) Temp );\r
endcase;\r
#endif /* !PF_NO_SHELL */\r
\r
}\r
else\r
{\r
- CellPtr = (cell *) TOS;\r
+ CellPtr = (cell_t *) TOS;\r
CellPtr--;\r
- if( ((uint32)*CellPtr) != ((uint32)CellPtr ^ PF_MEMORY_VALIDATOR))\r
+ if( ((ucell_t)*CellPtr) != ((ucell_t)CellPtr ^ PF_MEMORY_VALIDATOR))\r
{\r
TOS = -2; /* FIXME error code */\r
}\r
\r
case ID_HERE:\r
PUSH_TOS;\r
- TOS = (cell)CODE_HERE;\r
+ TOS = (cell_t)CODE_HERE;\r
endcase;\r
\r
case ID_NUMBERQ_P: /* ( addr -- 0 | n 1 ) */\r
/* Convert using number converter in 'C'.\r
** Only supports single precision for bootstrap.\r
*/\r
- TOS = (cell) ffNumberQ( (char *) TOS, &Temp );\r
+ TOS = (cell_t) ffNumberQ( (char *) TOS, &Temp );\r
if( TOS == NUM_TYPE_SINGLE)\r
{\r
M_PUSH( Temp ); /* Push single number */\r
case ID_LITERAL_P:\r
DBUG(("ID_LITERAL_P: InsPtr = 0x%x, *InsPtr = 0x%x\n", InsPtr, *InsPtr ));\r
PUSH_TOS;\r
- TOS = READ_LONG_DIC(InsPtr++);\r
+ TOS = READ_CELL_DIC(InsPtr++);\r
endcase;\r
\r
#ifndef PF_NO_SHELL\r
case ID_LOCAL_ENTRY: /* ( x0 x1 ... xn n -- ) */\r
/* create local stack frame */\r
{\r
- int32 i = TOS;\r
- cell *lp;\r
+ cell_t i = TOS;\r
+ cell_t *lp;\r
DBUG(("LocalEntry: n = %d\n", TOS));\r
/* End of locals. Create stack frame */\r
DBUG(("LocalEntry: before RP@ = 0x%x, LP = 0x%x\n",\r
DBUG(("LocalExit: before RP@ = 0x%x, LP = 0x%x\n",\r
TORPTR, LocalsPtr));\r
TORPTR = LocalsPtr;\r
- LocalsPtr = (cell *) M_R_POP;\r
+ LocalsPtr = (cell_t *) M_R_POP;\r
DBUG(("LocalExit: after RP@ = 0x%x, LP = 0x%x\n",\r
TORPTR, LocalsPtr));\r
endcase;\r
\r
#ifndef PF_NO_SHELL\r
case ID_NAME_TO_TOKEN:\r
- TOS = (cell) NameToToken((ForthString *)TOS);\r
+ TOS = (cell_t) NameToToken((ForthString *)TOS);\r
endcase;\r
\r
case ID_NAME_TO_PREVIOUS:\r
- TOS = (cell) NameToPrevious((ForthString *)TOS);\r
+ TOS = (cell_t) NameToPrevious((ForthString *)TOS);\r
endcase;\r
#endif\r
\r
#if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
if( IN_DICS( TOS ) )\r
{\r
- Scratch = READ_LONG_DIC((cell *)TOS);\r
+ Scratch = READ_CELL_DIC((cell_t *)TOS);\r
Scratch += M_POP;\r
- WRITE_LONG_DIC((cell *)TOS,Scratch);\r
+ WRITE_CELL_DIC((cell_t *)TOS,Scratch);\r
}\r
else\r
{\r
- *((cell *)TOS) += M_POP;\r
+ *((cell_t *)TOS) += M_POP;\r
}\r
#else\r
- *((cell *)TOS) += M_POP;\r
+ *((cell_t *)TOS) += M_POP;\r
#endif\r
M_DROP;\r
endcase;\r
\r
case ID_PLUSLOOP_P: /* ( delta -- ) ( R: index limit -- | index limit ) */\r
{\r
- ucell OldIndex, NewIndex, Limit;\r
+ ucell_t OldIndex, NewIndex, Limit;\r
\r
Limit = M_R_POP;\r
OldIndex = M_R_POP;\r
/* Resize memory allocated by ALLOCATE. */\r
case ID_RESIZE: /* ( addr1 u -- addr2 result ) */\r
{\r
- cell *Addr1 = (cell *) M_POP;\r
+ cell_t *Addr1 = (cell_t *) M_POP;\r
// Point to validator below users address.\r
- cell *FreePtr = Addr1 - 1;\r
- if( ((uint32)*FreePtr) != ((uint32)FreePtr ^ PF_MEMORY_VALIDATOR))\r
+ cell_t *FreePtr = Addr1 - 1;\r
+ if( ((ucell_t)*FreePtr) != ((ucell_t)FreePtr ^ PF_MEMORY_VALIDATOR))\r
{\r
// 090218 - Fixed bug, was returning zero.\r
M_PUSH( Addr1 );\r
else\r
{\r
/* Try to allocate. */\r
- CellPtr = (cell *) pfAllocMem( TOS + sizeof(cell) );\r
+ CellPtr = (cell_t *) pfAllocMem( TOS + sizeof(cell_t) );\r
if( CellPtr )\r
{\r
/* Copy memory including validation. */\r
- pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell) );\r
- *CellPtr = (cell)(((uint32)CellPtr) ^ (uint32)PF_MEMORY_VALIDATOR);\r
+ pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell_t) );\r
+ *CellPtr = (cell_t)(((ucell_t)CellPtr) ^ (ucell_t)PF_MEMORY_VALIDATOR);\r
// 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub.\r
// Increment past validator to user address.\r
- M_PUSH( (cell) (CellPtr + 1) );\r
+ M_PUSH( (cell_t) (CellPtr + 1) );\r
TOS = 0; // Result code.\r
// Mark old cell as dead so we can't free it twice.\r
FreePtr[0] = 0xDeadBeef;\r
*/\r
case ID_RP_FETCH: /* ( -- rp , address of top of return stack ) */\r
PUSH_TOS;\r
- TOS = (cell)TORPTR; /* value before calling RP@ */\r
+ TOS = (cell_t)TORPTR; /* value before calling RP@ */\r
endcase;\r
\r
case ID_RP_STORE: /* ( rp -- , address of top of return stack ) */\r
- TORPTR = (cell *) TOS;\r
+ TORPTR = (cell_t *) TOS;\r
M_DROP;\r
endcase;\r
\r
case ID_ROLL: /* ( xu xu-1 xu-1 ... x0 u -- xu-1 xu-1 ... x0 xu ) */\r
{\r
- int32 ri;\r
- cell *srcPtr, *dstPtr;\r
+ cell_t ri;\r
+ cell_t *srcPtr, *dstPtr;\r
Scratch = M_STACK(TOS);\r
srcPtr = &M_STACK(TOS-1);\r
dstPtr = &M_STACK(TOS);\r
endcase;\r
\r
/* Logical right shift */\r
- case ID_RSHIFT: { TOS = ((uint32)M_POP) >> TOS; } endcase; \r
+ case ID_RSHIFT: { TOS = ((ucell_t)M_POP) >> TOS; } endcase; \r
\r
#ifndef PF_NO_SHELL\r
case ID_SAVE_FORTH_P: /* ( $name Entry NameSize CodeSize -- err ) */\r
{\r
- int32 NameSize, CodeSize, EntryPoint;\r
+ cell_t NameSize, CodeSize, EntryPoint;\r
CodeSize = TOS;\r
NameSize = M_POP;\r
EntryPoint = M_POP;\r
\r
case ID_SP_FETCH: /* ( -- sp , address of top of stack, sorta ) */\r
PUSH_TOS;\r
- TOS = (cell)STKPTR;\r
+ TOS = (cell_t)STKPTR;\r
endcase;\r
\r
case ID_SP_STORE: /* ( sp -- , address of top of stack, sorta ) */\r
- STKPTR = (cell *) TOS;\r
+ STKPTR = (cell_t *) TOS;\r
M_DROP;\r
endcase;\r
\r
#if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
if( IN_DICS( TOS ) )\r
{\r
- WRITE_LONG_DIC((cell *)TOS,M_POP);\r
+ WRITE_CELL_DIC(TOS,M_POP);\r
}\r
else\r
{\r
- *((cell *)TOS) = M_POP;\r
+ *((cell_t *)TOS) = M_POP;\r
}\r
#else\r
- *((cell *)TOS) = M_POP;\r
+ *((cell_t *)TOS) = M_POP;\r
#endif\r
M_DROP;\r
endcase;\r
Scratch = M_POP; /* cnt */\r
Temp = M_POP; /* addr */\r
TOS = ffScan( (char *) Temp, Scratch, (char) TOS, &CharPtr );\r
- M_PUSH((cell) CharPtr);\r
+ M_PUSH((cell_t) CharPtr);\r
endcase;\r
\r
#ifndef PF_NO_SHELL\r
Scratch = M_POP; /* cnt */\r
Temp = M_POP; /* addr */\r
TOS = ffSkip( (char *) Temp, Scratch, (char) TOS, &CharPtr );\r
- M_PUSH((cell) CharPtr);\r
+ M_PUSH((cell_t) CharPtr);\r
endcase;\r
\r
case ID_SOURCE: /* ( -- c-addr num ) */\r
PUSH_TOS;\r
- M_PUSH( (cell) gCurrentTask->td_SourcePtr );\r
- TOS = (cell) gCurrentTask->td_SourceNum;\r
+ M_PUSH( (cell_t) gCurrentTask->td_SourcePtr );\r
+ TOS = (cell_t) gCurrentTask->td_SourceNum;\r
endcase;\r
\r
case ID_SOURCE_SET: /* ( c-addr num -- ) */\r
endcase;\r
\r
case ID_SOURCE_ID_PUSH: /* ( source-id -- ) */\r
- TOS = (cell)ffConvertSourceIDToStream( TOS );\r
+ TOS = (cell_t)ffConvertSourceIDToStream( TOS );\r
Scratch = ffPushInputStream((FileStream *) TOS );\r
if( Scratch )\r
{\r
case ID_VAR_RETURN_CODE: DO_VAR(gVarReturnCode); endcase;\r
\r
case ID_WORD:\r
- TOS = (cell) ffWord( (char) TOS );\r
+ TOS = (cell_t) ffWord( (char) TOS );\r
endcase;\r
\r
case ID_WORD_FETCH: /* ( waddr -- w ) */\r
#if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
if( IN_DICS( TOS ) )\r
{\r
- TOS = (uint16) READ_SHORT_DIC((uint16 *)TOS);\r
+ TOS = (uint16_t) READ_SHORT_DIC((uint8_t *)TOS);\r
}\r
else\r
{\r
- TOS = *((uint16 *)TOS);\r
+ TOS = *((uint16_t *)TOS);\r
}\r
#else\r
- TOS = *((uint16 *)TOS);\r
+ TOS = *((uint16_t *)TOS);\r
#endif\r
endcase;\r
\r
#if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
if( IN_DICS( TOS ) )\r
{\r
- WRITE_SHORT_DIC((uint16 *)TOS,(uint16)M_POP);\r
+ WRITE_SHORT_DIC(TOS,M_POP);\r
}\r
else\r
{\r
- *((uint16 *)TOS) = (uint16) M_POP;\r
+ *((uint16_t *)TOS) = (uint16_t) M_POP;\r
}\r
#else\r
- *((uint16 *)TOS) = (uint16) M_POP;\r
+ *((uint16_t *)TOS) = (uint16_t) M_POP;\r
#endif\r
M_DROP;\r
endcase;\r
ERR("pfCatch: Unrecognised token = 0x");\r
ffDotHex(Token);\r
ERR(" at 0x");\r
- ffDotHex((int32) InsPtr);\r
+ ffDotHex((cell_t) InsPtr);\r
EMIT_CR;\r
InsPtr = 0;\r
endcase;\r
}\r
\r
- if(InsPtr) Token = READ_LONG_DIC(InsPtr++); /* Traverse to next token in secondary. */\r
+ if(InsPtr) Token = READ_CELL_DIC(InsPtr++); /* Traverse to next token in secondary. */\r
\r
#ifdef PF_DEBUG\r
M_DOTS;\r
*/\r
void ioEmit( char c )\r
{\r
- int32 Result;\r
+ cell_t Result;\r
\r
Result = sdTerminalOut(c);\r
if( Result < 0 ) EXIT(1);\r
/***************************************************************\r
** Send an entire string..\r
*/\r
-void ioType( const char *s, int32 n )\r
+void ioType( const char *s, cell_t n )\r
{\r
- int32 i;\r
+ cell_t i;\r
\r
for( i=0; i<n; i++)\r
{\r
/***************************************************************\r
** Return single character from input device, always keyboard.\r
*/\r
-cell ioKey( void )\r
+cell_t ioKey( void )\r
{\r
- cell c;\r
+ cell_t c;\r
sdEnableInput();\r
c = sdTerminalIn();\r
sdDisableInput();\r
#define SPACE (0x20)\r
#define BACKSPACE (0x08)\r
#define DELETE (0x7F)\r
-cell ioAccept( char *buffer, cell maxChars )\r
+cell_t ioAccept( char *buffer, cell_t maxChars )\r
{\r
int c;\r
int len;\r
FileStream *PF_STDIN;\r
FileStream *PF_STDOUT;\r
\r
-int32 sdInputChar( FileStream *stream )\r
+cell_t sdInputChar( FileStream *stream )\r
{\r
UNIMPLEMENTED("sdInputChar");\r
TOUCH(stream);\r
TOUCH(Mode);\r
return NULL;\r
}\r
-int32 sdFlushFile( FileStream * Stream )\r
+cell_t sdFlushFile( FileStream * Stream )\r
{\r
TOUCH(Stream);\r
return 0;\r
}\r
-int32 sdReadFile( void *ptr, int32 Size, int32 nItems, FileStream * Stream ) \r
+cell_t sdReadFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream ) \r
{ \r
UNIMPLEMENTED("sdReadFile");\r
TOUCH(ptr);\r
TOUCH(Stream);\r
return 0; \r
}\r
-int32 sdWriteFile( void *ptr, int32 Size, int32 nItems, FileStream * Stream )\r
+cell_t sdWriteFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream )\r
{ \r
UNIMPLEMENTED("sdWriteFile");\r
TOUCH(ptr);\r
TOUCH(Stream);\r
return 0; \r
}\r
-int32 sdSeekFile( FileStream * Stream, int32 Position, int32 Mode ) \r
+cell_t sdSeekFile( FileStream * Stream, cell_t Position, int32_t Mode ) \r
{ \r
UNIMPLEMENTED("sdSeekFile");\r
TOUCH(Stream);\r
TOUCH(Mode);\r
return 0; \r
}\r
-int32 sdTellFile( FileStream * Stream ) \r
+cell_t sdTellFile( FileStream * Stream ) \r
{ \r
UNIMPLEMENTED("sdTellFile");\r
TOUCH(Stream);\r
return 0; \r
}\r
-int32 sdCloseFile( FileStream * Stream ) \r
+cell_t sdCloseFile( FileStream * Stream ) \r
{ \r
UNIMPLEMENTED("sdCloseFile");\r
TOUCH(Stream);\r
\r
/* Prototypes for stubs. */\r
FileStream *sdOpenFile( const char *FileName, const char *Mode );\r
- int32 sdFlushFile( FileStream * Stream );\r
- int32 sdReadFile( void *ptr, int32 Size, int32 nItems, FileStream * Stream );\r
- int32 sdWriteFile( void *ptr, int32 Size, int32 nItems, FileStream * Stream );\r
- int32 sdSeekFile( FileStream * Stream, int32 Position, int32 Mode );\r
- int32 sdTellFile( FileStream * Stream );\r
- int32 sdCloseFile( FileStream * Stream );\r
- int32 sdInputChar( FileStream *stream );\r
+ cell_t sdFlushFile( FileStream * Stream );\r
+ cell_t sdReadFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream );\r
+ cell_t sdWriteFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream );\r
+ cell_t sdSeekFile( FileStream * Stream, cell_t Position, int32_t Mode );\r
+ cell_t sdTellFile( FileStream * Stream );\r
+ cell_t sdCloseFile( FileStream * Stream );\r
+ cell_t sdInputChar( FileStream *stream );\r
\r
#ifdef __cplusplus\r
} \r
extern "C" {\r
#endif\r
\r
-cell ioAccept( char *Target, cell n1 );\r
-cell ioKey( void);\r
+cell_t ioAccept( char *Target, cell_t n1 );\r
+cell_t ioKey( void);\r
void ioEmit( char c );\r
-void ioType( const char *s, int32 n);\r
+void ioType( const char *s, cell_t n);\r
\r
#ifdef __cplusplus\r
} \r
#define TRUE (1)\r
#define FALSE (0)\r
#endif\r
-
-static const char *gErrorMsg32Bit = "ERROR - A long is not 4 bytes. Are we running on a 64-bit machine?!\n";
\r
#ifdef PF_EMBEDDED\r
int main( void )\r
{\r
char IfInit = 0; \r
const char *DicName = NULL;\r
- const char *SourceName = NULL;
- // Check to make sure we are running in 32-bit mode.
- if( sizeof(long) != 4 )
- {
- pfMessage(gErrorMsg32Bit);
- return 1;
- }\r
+ const char *SourceName = NULL;\r
pfMessage("\npForth Embedded\n");\r
return pfDoForth( DicName, SourceName, IfInit);\r
}\r
const char *SourceName = NULL;\r
char IfInit = FALSE;\r
char *s;\r
- int32 i;\r
+ cell_t i;\r
int Result;\r
-
- // Check to make sure we are running in 32-bit mode.
- if( sizeof(long) != 4 )
- {
- ERR((gErrorMsg32Bit));
- return 1;
- }
- \r
+\r
/* For Metroworks on Mac */\r
#ifdef __MWERKS__\r
argc = ccommand(&argv);\r
#endif\r
-\r
+ \r
/* Parse command line. */\r
for( i=1; i<argc; i++ )\r
{\r
#ifdef PF_NO_MALLOC\r
\r
static char *gMemPoolPtr;\r
-static uint32 gMemPoolSize;\r
+static ucell_t gMemPoolSize;\r
\r
/* CUSTOM: Make the memory pool bigger if you want. */\r
#ifndef PF_MEM_POOL_SIZE\r
dllNextNode( NodePtr ) ));\r
}\r
\r
-int32 dllCheckNode( DoublyLinkedListNode *NodePtr )\r
+cell_t dllCheckNode( DoublyLinkedListNode *NodePtr )\r
{\r
if( (NodePtr->dlln_Next->dlln_Previous != NodePtr) ||\r
(NodePtr->dlln_Previous->dlln_Next != NodePtr))\r
typedef struct MemListNode\r
{\r
DoublyLinkedListNode mln_Node;\r
- int32 mln_Size;\r
+ cell_t mln_Size;\r
} MemListNode;\r
\r
#ifdef PF_DEBUG\r
/***************************************************************\r
** Free mem of any size.\r
*/\r
-static void pfFreeRawMem( char *Mem, int32 NumBytes )\r
+static void pfFreeRawMem( char *Mem, cell_t NumBytes )\r
{\r
MemListNode *mln, *FreeNode;\r
MemListNode *AdjacentLower = NULL;\r
DBUG(("\npfFreeRawMem: Align NumBytes to 0x%x\n", NumBytes ));\r
\r
/* Check memory alignment. */\r
- if( ( ((int32)Mem) & (PF_MEM_BLOCK_SIZE - 1)) != 0)\r
+ if( ( ((cell_t)Mem) & (PF_MEM_BLOCK_SIZE - 1)) != 0)\r
{\r
- MSG_NUM_H("pfFreeRawMem: misaligned Mem = 0x", (int32) Mem );\r
+ MSG_NUM_H("pfFreeRawMem: misaligned Mem = 0x", (cell_t) Mem );\r
return;\r
}\r
\r
/***************************************************************\r
** Setup memory list. Initialize allocator.\r
*/\r
-static void pfInitMemBlock( void *addr, uint32 poolSize )\r
+static void pfInitMemBlock( void *addr, ucell_t poolSize )\r
{\r
char *AlignedMemory;\r
- int32 AlignedSize;\r
+ cell_t AlignedSize;\r
\r
pfDebugMessage("pfInitMemBlock()\n");\r
/* Set globals. */\r
dllSetupList( &gMemList );\r
\r
/* Adjust to next highest aligned memory location. */\r
- AlignedMemory = (char *) ((((int32)gMemPoolPtr) + PF_MEM_BLOCK_SIZE - 1) &\r
+ AlignedMemory = (char *) ((((cell_t)gMemPoolPtr) + PF_MEM_BLOCK_SIZE - 1) &\r
~(PF_MEM_BLOCK_SIZE - 1));\r
\r
/* Adjust size to reflect aligned memory. */\r
/***************************************************************\r
** Allocate mem from list of free nodes.\r
*/\r
-static char *pfAllocRawMem( int32 NumBytes )\r
+static char *pfAllocRawMem( cell_t NumBytes )\r
{\r
char *Mem = NULL;\r
MemListNode *mln;\r
{\r
if( mln->mln_Size >= NumBytes )\r
{\r
- int32 RemSize;\r
+ cell_t RemSize;\r
\r
Mem = (char *) mln;\r
\r
/***************************************************************\r
** Keep mem size at first cell.\r
*/\r
-char *pfAllocMem( int32 NumBytes )\r
+char *pfAllocMem( cell_t NumBytes )\r
{\r
- int32 *IntMem;\r
+ cell_t *IntMem;\r
\r
if( NumBytes <= 0 ) return NULL;\r
\r
/* Allocate an extra cell for size. */\r
- NumBytes += sizeof(int32);\r
+ NumBytes += sizeof(cell_t);\r
\r
- IntMem = (int32 *)pfAllocRawMem( NumBytes );\r
+ IntMem = (cell_t *)pfAllocRawMem( NumBytes );\r
\r
if( IntMem != NULL ) *IntMem++ = NumBytes;\r
\r
*/\r
void pfFreeMem( void *Mem )\r
{\r
- int32 *IntMem;\r
- int32 NumBytes;\r
+ cell_t *IntMem;\r
+ cell_t NumBytes;\r
\r
if( Mem == NULL ) return;\r
\r
/* Allocate an extra cell for size. */\r
- IntMem = (int32 *) Mem;\r
+ IntMem = (cell_t *) Mem;\r
IntMem--;\r
NumBytes = *IntMem;\r
\r
#endif\r
\r
void pfInitMemoryAllocator( void );\r
- char *pfAllocMem( int32 NumBytes );\r
+ char *pfAllocMem( cell_t NumBytes );\r
void pfFreeMem( void *Mem );\r
\r
#ifdef __cplusplus\r
** of names and code was the same when saved and reloaded.\r
** 940228 PLB Added PF_NO_FILEIO version\r
** 961204 PLB Added PF_STATIC_DIC\r
-** 000623 PLB Cast chars as uint32 before shifting for 16 bit systems.\r
+** 000623 PLB Cast chars as ucell_t before shifting for 16 bit systems.\r
***************************************************************/\r
\r
+#include <assert.h>\r
+\r
#include "pf_all.h"\r
\r
/* If no File I/O, then force static dictionary. */\r
\r
/***************************************************************/\r
/* Endian-ness tools. */\r
-uint32 ReadLongBigEndian( const uint32 *addr )\r
+ucell_t ReadCellBigEndian( const uint8_t *addr )\r
{\r
- const unsigned char *bp = (const unsigned char *) addr;\r
-/* We must cast char to uint32 before shifting because\r
-** of systems with 16 bit ints. 000623 */\r
- uint32 temp = ((uint32)bp[0])<<24;\r
- temp |= ((uint32)bp[1])<<16;\r
- temp |= ((uint32)bp[2])<<8;\r
- temp |= ((uint32)bp[3]);\r
+ ucell_t temp = (ucell_t)addr[0];\r
+ temp = (temp << 8) | ((ucell_t)addr[1]);\r
+ temp = (temp << 8) | ((ucell_t)addr[2]);\r
+ temp = (temp << 8) | ((ucell_t)addr[3]);\r
+ if( sizeof(ucell_t) == 8 )\r
+ {\r
+ temp = (temp << 8) | ((ucell_t)addr[4]);\r
+ temp = (temp << 8) | ((ucell_t)addr[5]);\r
+ temp = (temp << 8) | ((ucell_t)addr[6]);\r
+ temp = (temp << 8) | ((ucell_t)addr[7]);\r
+ }\r
+ \r
return temp;\r
}\r
/***************************************************************/\r
-uint16 ReadShortBigEndian( const uint16 *addr )\r
+/* Endian-ness tools. */\r
+uint32_t Read32BigEndian( const uint8_t *addr )\r
{\r
- const unsigned char *bp = (const unsigned char *) addr;\r
- return (uint16) ((bp[0]<<8) | bp[1]);\r
+ uint32_t temp = (uint32_t)addr[0];\r
+ temp = (temp << 8) | ((uint32_t)addr[1]);\r
+ temp = (temp << 8) | ((uint32_t)addr[2]);\r
+ temp = (temp << 8) | ((uint32_t)addr[3]);\r
+ return temp;\r
}\r
\r
/***************************************************************/\r
-uint32 ReadLongLittleEndian( const uint32 *addr )\r
+uint16_t Read16BigEndian( const uint8_t *addr )\r
{\r
- const unsigned char *bp = (const unsigned char *) addr;\r
-/* We must cast char to uint32 before shifting because\r
-** of systems with 16 bit ints. 000623 */\r
- uint32 temp = ((uint32)bp[3])<<24;\r
- temp |= ((uint32)bp[2])<<16;\r
- temp |= ((uint32)bp[1])<<8;\r
- temp |= ((uint32)bp[0]);\r
+ return (uint16_t) ((addr[0]<<8) | addr[1]);\r
+}\r
+\r
+/***************************************************************/\r
+ucell_t ReadCellLittleEndian( const uint8_t *addr )\r
+{\r
+ ucell_t temp = 0;\r
+ if( sizeof(ucell_t) == 8 )\r
+ {\r
+ temp = (temp << 8) | ((uint32_t)addr[7]);\r
+ temp = (temp << 8) | ((uint32_t)addr[6]);\r
+ temp = (temp << 8) | ((uint32_t)addr[5]);\r
+ temp = (temp << 8) | ((uint32_t)addr[4]);\r
+ }\r
+ temp = (temp << 8) | ((uint32_t)addr[3]);\r
+ temp = (temp << 8) | ((uint32_t)addr[2]);\r
+ temp = (temp << 8) | ((uint32_t)addr[1]);\r
+ temp = (temp << 8) | ((uint32_t)addr[0]);\r
return temp;\r
}\r
+\r
/***************************************************************/\r
-uint16 ReadShortLittleEndian( const uint16 *addr )\r
+uint32_t Read32LittleEndian( const uint8_t *addr )\r
+{\r
+ uint32_t temp = (uint32_t)addr[3];\r
+ temp = (temp << 8) | ((uint32_t)addr[2]);\r
+ temp = (temp << 8) | ((uint32_t)addr[1]);\r
+ temp = (temp << 8) | ((uint32_t)addr[0]);\r
+ return temp;\r
+}\r
+\r
+/***************************************************************/\r
+uint16_t Read16LittleEndian( const uint8_t *addr )\r
{\r
const unsigned char *bp = (const unsigned char *) addr;\r
- return (uint16) ((bp[1]<<8) | bp[0]);\r
+ return (uint16_t) ((bp[1]<<8) | bp[0]);\r
}\r
\r
#ifdef PF_SUPPORT_FP\r
#endif /* PF_SUPPORT_FP */\r
\r
/***************************************************************/\r
-void WriteLongBigEndian( uint32 *addr, uint32 data )\r
+void WriteCellBigEndian( uint8_t *addr, ucell_t data )\r
{\r
- unsigned char *bp = (unsigned char *) addr;\r
-\r
- bp[0] = (unsigned char) (data>>24);\r
- bp[1] = (unsigned char) (data>>16);\r
- bp[2] = (unsigned char) (data>>8);\r
- bp[3] = (unsigned char) (data);\r
+ // Write should be in order of increasing address\r
+ // to optimize for burst writes to DRAM.\r
+ if( sizeof(ucell_t) == 8 )\r
+ {\r
+ *addr++ = (uint8_t) (data>>56);\r
+ *addr++ = (uint8_t) (data>>48);\r
+ *addr++ = (uint8_t) (data>>40);\r
+ *addr++ = (uint8_t) (data>>32);\r
+ }\r
+ *addr++ = (uint8_t) (data>>24);\r
+ *addr++ = (uint8_t) (data>>16);\r
+ *addr++ = (uint8_t) (data>>8);\r
+ *addr = (uint8_t) (data);\r
}\r
\r
/***************************************************************/\r
-void WriteShortBigEndian( uint16 *addr, uint16 data )\r
+void Write32BigEndian( uint8_t *addr, uint32_t data )\r
{\r
- unsigned char *bp = (unsigned char *) addr;\r
-\r
- bp[0] = (unsigned char) (data>>8);\r
- bp[1] = (unsigned char) (data);\r
+ *addr++ = (uint8_t) (data>>24);\r
+ *addr++ = (uint8_t) (data>>16);\r
+ *addr++ = (uint8_t) (data>>8);\r
+ *addr = (uint8_t) (data);\r
}\r
\r
/***************************************************************/\r
-void WriteLongLittleEndian( uint32 *addr, uint32 data )\r
+void Write16BigEndian( uint8_t *addr, uint16_t data )\r
{\r
- unsigned char *bp = (unsigned char *) addr;\r
+ *addr++ = (uint8_t) (data>>8);\r
+ *addr = (uint8_t) (data);\r
+}\r
\r
- bp[0] = (unsigned char) (data);\r
- bp[1] = (unsigned char) (data>>8);\r
- bp[2] = (unsigned char) (data>>16);\r
- bp[3] = (unsigned char) (data>>24);\r
+/***************************************************************/\r
+void WriteCellLittleEndian( uint8_t *addr, ucell_t data )\r
+{\r
+ // Write should be in order of increasing address\r
+ // to optimize for burst writes to DRAM.\r
+ if( sizeof(ucell_t) == 8 )\r
+ {\r
+ *addr++ = (uint8_t) data; // LSB at near end\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ }\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr = (uint8_t) data;\r
}\r
/***************************************************************/\r
-void WriteShortLittleEndian( uint16 *addr, uint16 data )\r
+void Write32LittleEndian( uint8_t *addr, uint32_t data )\r
{\r
- unsigned char *bp = (unsigned char *) addr;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr = (uint8_t) data;\r
+}\r
\r
- bp[0] = (unsigned char) (data);\r
- bp[1] = (unsigned char) (data>>8);\r
+/***************************************************************/\r
+void Write16LittleEndian( uint8_t *addr, uint16_t data )\r
+{\r
+ *addr++ = (uint8_t) data;\r
+ data = data >> 8;\r
+ *addr = (uint8_t) data;\r
}\r
\r
/***************************************************************/\r
\r
#if defined(PF_NO_FILEIO) || defined(PF_NO_SHELL)\r
\r
-int32 ffSaveForth( const char *FileName, ExecToken EntryPoint, int32 NameSize, int32 CodeSize)\r
+cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
{\r
TOUCH(FileName);\r
TOUCH(EntryPoint);\r
#else /* PF_NO_FILEIO or PF_NO_SHELL */\r
\r
/***************************************************************/\r
-static int32 WriteLong( FileStream *fid, int32 Val )\r
+static int Write32ToFile( FileStream *fid, uint32_t Val )\r
{\r
- int32 numw;\r
- uint32 pad;\r
+ int numw;\r
+ uint8_t pad[4];\r
\r
- WriteLongBigEndian(&pad,Val);\r
- numw = sdWriteFile( (char *) &pad, 1, sizeof(int32), fid );\r
- if( numw != sizeof(int32) ) return -1;\r
+ Write32BigEndian(pad,Val);\r
+ numw = sdWriteFile( pad, 1, sizeof(pad), fid );\r
+ if( numw != sizeof(pad) ) return -1;\r
return 0;\r
}\r
\r
/***************************************************************/\r
-static int32 WriteChunk( FileStream *fid, int32 ID, char *Data, int32 NumBytes )\r
+static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t NumBytes )\r
{\r
- int32 numw;\r
- int32 EvenNumW;\r
+ cell_t numw;\r
+ cell_t EvenNumW;\r
\r
EvenNumW = EVENUP(NumBytes);\r
\r
- if( WriteLong( fid, ID ) < 0 ) goto error;\r
- if( WriteLong( fid, EvenNumW ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, ID ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error;\r
\r
numw = sdWriteFile( Data, 1, EvenNumW, fid );\r
if( numw != EvenNumW ) goto error;\r
return 0;\r
error:\r
- pfReportError("WriteChunk", PF_ERR_WRITE_FILE);\r
+ pfReportError("WriteChunkToFile", PF_ERR_WRITE_FILE);\r
return -1;\r
}\r
\r
** If EntryPoint is NULL, save as development environment.\r
** If EntryPoint is non-NULL, save as turnKey environment with no names.\r
*/\r
-int32 ffSaveForth( const char *FileName, ExecToken EntryPoint, int32 NameSize, int32 CodeSize)\r
+cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
{\r
FileStream *fid;\r
DictionaryInfoChunk SD;\r
- int32 FormSize;\r
- int32 NameChunkSize = 0;\r
- int32 CodeChunkSize;\r
- uint32 rhp, rcp;\r
- uint32 *p;\r
+ uint32_t FormSize;\r
+ uint32_t NameChunkSize = 0;\r
+ uint32_t CodeChunkSize;\r
+ uint32_t relativeCodePtr;\r
int i;\r
\r
fid = sdOpenFile( FileName, "wb" );\r
pfExecIfDefined("AUTO.TERM");\r
\r
/* Write FORM Header ---------------------------- */\r
- if( WriteLong( fid, ID_FORM ) < 0 ) goto error;\r
- if( WriteLong( fid, 0 ) < 0 ) goto error;\r
- if( WriteLong( fid, ID_P4TH ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, ID_FORM ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, 0 ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, ID_P4TH ) < 0 ) goto error;\r
\r
/* Write P4DI Dictionary Info ------------------ */\r
SD.sd_Version = PF_FILE_VERSION;\r
\r
- rcp = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */\r
- SD.sd_RelCodePtr = rcp; \r
- SD.sd_UserStackSize = sizeof(cell) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);\r
- SD.sd_ReturnStackSize = sizeof(cell) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);\r
+ relativeCodePtr = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */\r
+ SD.sd_RelCodePtr = relativeCodePtr; \r
+ SD.sd_UserStackSize = sizeof(cell_t) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);\r
+ SD.sd_ReturnStackSize = sizeof(cell_t) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);\r
SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */\r
\r
#ifdef PF_SUPPORT_FP\r
SD.sd_FloatSize = 0;\r
#endif\r
\r
- SD.sd_Reserved = 0;\r
+ SD.sd_CellSize = sizeof(cell_t);\r
\r
-/* Set bit that specifiec whether dictionary is BIG or LITTLE Endian. */\r
+/* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */\r
{\r
#if defined(PF_BIG_ENDIAN_DIC)\r
int eflag = SD_F_BIG_ENDIAN_DIC;\r
}\r
else\r
{\r
+ uint32_t relativeHeaderPtr;\r
/* Development mode. */\r
SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);\r
- rhp = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr.Byte);\r
- SD.sd_RelHeaderPtr = rhp;\r
+ relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr.Byte);\r
+ SD.sd_RelHeaderPtr = relativeHeaderPtr;\r
\r
/* How much real name space is there? */\r
- NameChunkSize = QUADUP(rhp); /* Align */\r
+ NameChunkSize = QUADUP(relativeHeaderPtr); /* Align */\r
\r
/* NameSize must be 0 or greater than NameChunkSize + 1K */\r
NameSize = QUADUP(NameSize); /* Align */\r
}\r
\r
/* How much real code is there? */\r
- CodeChunkSize = QUADUP(rcp);\r
+ CodeChunkSize = QUADUP(relativeCodePtr);\r
CodeSize = QUADUP(CodeSize); /* Align */\r
CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );\r
SD.sd_CodeSize = CodeSize;\r
\r
\r
-/* Convert all fields in structure from Native to BigEndian. */\r
- p = (uint32 *) &SD;\r
- for( i=0; i<((int)(sizeof(SD)/sizeof(int32))); i++ )\r
+/* Convert all fields in DictionaryInfoChunk from Native to BigEndian. \r
+ * This assumes they are all 32-bit integers.\r
+ */\r
{\r
- WriteLongBigEndian( &p[i], p[i] );\r
+ uint32_t *p = (uint32_t *) &SD;\r
+ for( i=0; i<((int)(sizeof(SD)/sizeof(uint32_t))); i++ )\r
+ {\r
+ Write32BigEndian( (uint8_t *)&p[i], p[i] );\r
+ }\r
}\r
\r
- if( WriteChunk( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
+ if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
\r
/* Write Name Fields if NameSize non-zero ------- */\r
if( NameSize > 0 )\r
{\r
- if( WriteChunk( fid, ID_P4NM, (char *) NAME_BASE,\r
+ if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,\r
NameChunkSize ) < 0 ) goto error;\r
}\r
\r
/* Write Code Fields ---------------------------- */\r
- if( WriteChunk( fid, ID_P4CD, (char *) CODE_BASE,\r
+ if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,\r
CodeChunkSize ) < 0 ) goto error;\r
\r
FormSize = sdTellFile( fid ) - 8;\r
sdSeekFile( fid, 4, PF_SEEK_SET );\r
- if( WriteLong( fid, FormSize ) < 0 ) goto error;\r
+ if( Write32ToFile( fid, FormSize ) < 0 ) goto error;\r
\r
sdCloseFile( fid );\r
\r
-\r
-\r
/* Restore initialization. */\r
-\r
pfExecIfDefined("AUTO.INIT");\r
-\r
return 0;\r
\r
error:\r
sdSeekFile( fid, 0, PF_SEEK_SET );\r
- WriteLong( fid, ID_BADF ); /* Mark file as bad. */\r
+ Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */\r
sdCloseFile( fid );\r
\r
/* Restore initialization. */\r
-\r
pfExecIfDefined("AUTO.INIT");\r
\r
return -1;\r
#ifndef PF_NO_FILEIO\r
\r
/***************************************************************/\r
-static int32 ReadLong( FileStream *fid, int32 *ValPtr )\r
+static uint32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )\r
{\r
- int32 numr;\r
- uint32 temp;\r
-\r
- numr = sdReadFile( &temp, 1, sizeof(int32), fid );\r
- if( numr != sizeof(int32) ) return -1;\r
- *ValPtr = ReadLongBigEndian( &temp );\r
+ int32_t numr;\r
+ uint8_t pad[4];\r
+ numr = sdReadFile( pad, 1, sizeof(pad), fid );\r
+ if( numr != sizeof(pad) ) return -1;\r
+ *ValPtr = Read32BigEndian( pad );\r
return 0;\r
}\r
\r
pfDictionary_t *dic = NULL;\r
FileStream *fid;\r
DictionaryInfoChunk *sd;\r
- int32 ChunkID;\r
- int32 ChunkSize;\r
- int32 FormSize;\r
- int32 BytesLeft;\r
- int32 numr;\r
- uint32 *p;\r
+ uint32_t ChunkID;\r
+ uint32_t ChunkSize;\r
+ uint32_t FormSize;\r
+ uint32_t BytesLeft;\r
+ uint32_t numr;\r
int i;\r
int isDicBigEndian;\r
\r
}\r
\r
/* Read FORM, Size, ID */\r
- if (ReadLong( fid, &ChunkID ) < 0) goto read_error;\r
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
if( ChunkID != ID_FORM )\r
{\r
pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);\r
goto error;\r
}\r
\r
- if (ReadLong( fid, &FormSize ) < 0) goto read_error;\r
+ if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;\r
BytesLeft = FormSize;\r
\r
- if (ReadLong( fid, &ChunkID ) < 0) goto read_error;\r
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
BytesLeft -= 4;\r
if( ChunkID != ID_P4TH )\r
{\r
/* Scan and parse all chunks in file. */\r
while( BytesLeft > 0 )\r
{\r
- if (ReadLong( fid, &ChunkID ) < 0) goto read_error;\r
- if (ReadLong( fid, &ChunkSize ) < 0) goto read_error;\r
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
+ if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;\r
BytesLeft -= 8;\r
\r
- DBUG(("ChunkID = %4s, Size = %d\n", &ChunkID, ChunkSize ));\r
+ DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));\r
\r
switch( ChunkID )\r
{\r
BytesLeft -= ChunkSize;\r
\r
/* Convert all fields in structure from BigEndian to Native. */\r
- p = (uint32 *) sd;\r
- for( i=0; i<((int)(sizeof(*sd)/sizeof(int32))); i++ )\r
{\r
- p[i] = ReadLongBigEndian( &p[i] );\r
+ uint32_t *p = (uint32_t *) sd;\r
+ for( i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++ )\r
+ {\r
+ p[i] = Read32BigEndian( (uint8_t *)&p[i] );\r
+ }\r
}\r
-\r
+ \r
isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;\r
\r
if( !gVarQuiet )\r
MSG_NUM_D(" Name space size = ", sd->sd_NameSize );\r
MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );\r
MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );\r
+ MSG_NUM_D(" Cell Size = ", sd->sd_CellSize );\r
MSG( (isDicBigEndian ? " Big Endian Dictionary" :\r
" Little Endian Dictionary") );\r
if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");\r
pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );\r
goto error;\r
}\r
+ if( sd->sd_CellSize != sizeof(cell_t) )\r
+ {\r
+ pfReportError("pfLoadDictionary", PF_ERR_CELL_SIZE_CONFLICT );\r
+ goto error;\r
+ }\r
if( sd->sd_NumPrimitives > NUM_PRIMITIVES )\r
{\r
pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );\r
if( sd->sd_NameSize > 0 )\r
{\r
gVarContext = (char *) NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */\r
- gCurrentDictionary->dic_HeaderPtr.Byte = (uint8 *)\r
+ gCurrentDictionary->dic_HeaderPtr.Byte = (uint8_t *)\r
NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);\r
}\r
else\r
gVarContext = 0;\r
gCurrentDictionary->dic_HeaderPtr.Byte = NULL;\r
}\r
- gCurrentDictionary->dic_CodePtr.Byte = (uint8 *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
+ gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */\r
/* Pass EntryPoint back to caller. */\r
if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;\r
\r
if( NAME_BASE != NULL)\r
{\r
- int32 Result;\r
+ cell_t Result;\r
/* Find special words in dictionary for global XTs. */\r
if( (Result = FindSpecialXTs()) < 0 )\r
{\r
}\r
}\r
\r
-DBUG(("pfLoadDictionary: return 0x%x\n", dic));\r
+DBUG(("pfLoadDictionary: return %p\n", dic));\r
return (PForthDictionary) dic;\r
\r
nomem_error:\r
PForthDictionary pfLoadStaticDictionary( void )\r
{\r
#ifdef PF_STATIC_DIC\r
- int32 Result;\r
+ cell_t Result;\r
pfDictionary_t *dic;\r
- int32 NewNameSize, NewCodeSize;\r
+ cell_t NewNameSize, NewCodeSize;\r
\r
if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
{\r
\r
pfCopyMemory( dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );\r
pfCopyMemory( dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );\r
- DBUG("Static data copied to newly allocated dictionaries.\n");\r
+ DBUG(("Static data copied to newly allocated dictionaries.\n"));\r
\r
- dic->dic_CodePtr.Byte = (uint8 *) CODEREL_TO_ABS(CODEPTR);\r
+ dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);\r
gNumPrimitives = NUM_PRIMITIVES;\r
\r
if( NAME_BASE != NULL)\r
{\r
/* Setup name space. */\r
- dic->dic_HeaderPtr.Byte = (uint8 *) NAMEREL_TO_ABS(HEADERPTR);\r
+ dic->dic_HeaderPtr.Byte = (uint8_t *) NAMEREL_TO_ABS(HEADERPTR);\r
gVarContext = (char *) NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */\r
\r
/* Find special words in dictionary for global XTs. */\r
\r
typedef struct DictionaryInfoChunk\r
{\r
-/* All fields are stored in BIG ENDIAN format for consistency in data files. */\r
-/* All fileds must be the same size as int32 for easy endian conversion. */\r
- int32 sd_Version;\r
- int32 sd_RelContext; /* relative ptr to Dictionary Context */\r
- int32 sd_RelHeaderPtr; /* relative ptr to Dictionary Header Ptr */\r
- int32 sd_RelCodePtr; /* relative ptr to Dictionary Header Ptr */\r
- ExecToken sd_EntryPoint; /* relative ptr to entry point or NULL */\r
- int32 sd_UserStackSize; /* in bytes */\r
- int32 sd_ReturnStackSize; /* in bytes */\r
- int32 sd_NameSize; /* in bytes */\r
- int32 sd_CodeSize; /* in bytes */\r
- int32 sd_NumPrimitives; /* To distinguish between primitive and secondary. */\r
- uint32 sd_Flags;\r
- int32 sd_FloatSize; /* In bytes. Must match code. 0 means no floats. */\r
- uint32 sd_Reserved;\r
+/* All fields are stored in BIG ENDIAN format for consistency in data files.\r
+ * All fields must be the same size for easy endian conversion.\r
+ * All fields must be 32 bit for file compatibility with older versions.\r
+ */\r
+ int32_t sd_Version;\r
+ int32_t sd_RelContext; /* relative ptr to Dictionary Context */\r
+ int32_t sd_RelHeaderPtr; /* relative ptr to Dictionary Header Ptr */\r
+ int32_t sd_RelCodePtr; /* relative ptr to Dictionary Header Ptr */\r
+ int32_t sd_EntryPoint; /* relative ptr to entry point or NULL */\r
+ int32_t sd_UserStackSize; /* in bytes */\r
+ int32_t sd_ReturnStackSize; /* in bytes */\r
+ int32_t sd_NameSize; /* in bytes */\r
+ int32_t sd_CodeSize; /* in bytes */\r
+ int32_t sd_NumPrimitives; /* To distinguish between primitive and secondary. */\r
+ uint32_t sd_Flags;\r
+ int32_t sd_FloatSize; /* In bytes. Must match code. 0 means no floats. */\r
+ int32_t sd_CellSize; /* In bytes. Must match code. */\r
} DictionaryInfoChunk;\r
\r
/* Bits in sd_Flags */\r
#define SD_F_BIG_ENDIAN_DIC (1<<0)\r
\r
#ifndef MAKE_ID\r
-#define MAKE_ID(a,b,c,d) ((((uint32)a)<<24)|(((uint32)b)<<16)|(((uint32)c)<<8)|((uint32)d))\r
+#define MAKE_ID(a,b,c,d) ((((uint32_t)a)<<24)|(((uint32_t)b)<<16)|(((uint32_t)c)<<8)|((uint32_t)d))\r
#endif\r
\r
#define ID_FORM MAKE_ID('F','O','R','M')\r
extern "C" {\r
#endif\r
\r
-int32 ffSaveForth( const char *FileName, ExecToken EntryPoint, int32 NameSize, int32 CodeSize );\r
+cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize );\r
\r
/* Endian-ness tools. */\r
-\r
int IsHostLittleEndian( void );\r
-uint32 ReadLongBigEndian( const uint32 *addr );\r
-uint16 ReadShortBigEndian( const uint16 *addr );\r
-uint32 ReadLongLittleEndian( const uint32 *addr );\r
-uint16 ReadShortLittleEndian( const uint16 *addr );\r
-void WriteLongBigEndian( uint32 *addr, uint32 data );\r
-void WriteShortBigEndian( uint16 *addr, uint16 data );\r
-void WriteLongLittleEndian( uint32 *addr, uint32 data );\r
-void WriteShortLittleEndian( uint16 *addr, uint16 data );\r
+ \r
+ucell_t ReadCellBigEndian( const uint8_t *addr );\r
+uint32_t Read32BigEndian( const uint8_t *addr );\r
+uint16_t Read16BigEndian( const uint8_t *addr );\r
+ \r
+ucell_t ReadCellLittleEndian( const uint8_t *addr );\r
+uint32_t Read32LittleEndian( const uint8_t *addr );\r
+uint16_t Read16LittleEndian( const uint8_t *addr );\r
+ \r
+void WriteCellBigEndian( uint8_t *addr, ucell_t data );\r
+void Write32BigEndian( uint8_t *addr, uint32_t data );\r
+void Write16BigEndian( uint8_t *addr, uint16_t data );\r
+ \r
+void WriteCellLittleEndian( uint8_t *addr, ucell_t data );\r
+void Write32LittleEndian( uint8_t *addr, uint32_t data );\r
+void Write16LittleEndian( uint8_t *addr, uint16_t data );\r
\r
#ifdef PF_SUPPORT_FP\r
void WriteFloatBigEndian( PF_FLOAT *addr, PF_FLOAT data );\r
s = "endian-ness of dictionary does not match code"; break;\r
case PF_ERR_FLOAT_CONFLICT & 0xFF:\r
s = "float support mismatch between .dic file and code"; break;\r
+ case PF_ERR_CELL_SIZE_CONFLICT & 0xFF:\r
+ s = "cell size mismatch between .dic file and code"; break;\r
default:\r
s = "unrecognized error code!"; break;\r
}\r
\r
char *ForthStringToC( char *dst, const char *FString )\r
{\r
- int32 Len;\r
+ cell_t Len;\r
\r
- Len = (int32) *FString;\r
+ Len = (cell_t) *FString;\r
pfCopyMemory( dst, FString+1, Len );\r
dst[Len] = '\0';\r
\r
char *CStringToForth( char *dst, const char *CString )\r
{\r
char *s;\r
- int32 i;\r
+ cell_t i;\r
\r
s = dst+1;\r
for( i=0; *CString; i++ )\r
** Compare two test strings, case sensitive.\r
** Return TRUE if they match.\r
*/\r
-int32 ffCompareText( const char *s1, const char *s2, int32 len )\r
+cell_t ffCompareText( const char *s1, const char *s2, cell_t len )\r
{\r
- int32 i, Result;\r
+ cell_t i, Result;\r
\r
Result = TRUE;\r
for( i=0; i<len; i++ )\r
** Compare two test strings, case INsensitive.\r
** Return TRUE if they match.\r
*/\r
-int32 ffCompareTextCaseN( const char *s1, const char *s2, int32 len )\r
+cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )\r
{\r
- int32 i, Result;\r
+ cell_t i, Result;\r
char c1,c2;\r
\r
Result = TRUE;\r
** Compare two strings, case sensitive.\r
** Return zero if they match, -1 if s1<s2, +1 is s1>s2;\r
*/\r
-int32 ffCompare( const char *s1, int32 len1, const char *s2, int32 len2 )\r
+cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 )\r
{\r
- int32 i, result, n, diff;\r
+ cell_t i, result, n, diff;\r
\r
result = 0;\r
n = MIN(len1,len2);\r
/***************************************************************\r
** Convert number to text.\r
*/\r
-#define CNTT_PAD_SIZE ((sizeof(int32)*8)+2) /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */\r
+#define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2) /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */\r
static char cnttPad[CNTT_PAD_SIZE];\r
\r
-char *ConvertNumberToText( int32 Num, int32 Base, int32 IfSigned, int32 MinChars )\r
+char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )\r
{\r
- int32 IfNegative = 0;\r
+ cell_t IfNegative = 0;\r
char *p,c;\r
- uint32 NewNum, Rem, uNum;\r
- int32 i = 0;\r
+ ucell_t NewNum, Rem, uNum;\r
+ cell_t i = 0;\r
\r
uNum = Num;\r
if( IfSigned )\r
/***************************************************************\r
** Diagnostic routine that prints memory in table format.\r
*/\r
-void DumpMemory( void *addr, int32 cnt)\r
+void DumpMemory( void *addr, cell_t cnt)\r
{\r
- int32 ln, cn, nlines;\r
+ cell_t ln, cn, nlines;\r
unsigned char *ptr, *cptr, c;\r
\r
nlines = (cnt + 15) / 16;\r
\r
for (ln=0; ln<nlines; ln++)\r
{\r
- MSG( ConvertNumberToText( (int32) ptr, 16, FALSE, 8 ) );\r
+ MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );\r
MSG(": ");\r
cptr = ptr;\r
for (cn=0; cn<16; cn++)\r
{\r
- MSG( ConvertNumberToText( (int32) *cptr++, 16, FALSE, 2 ) );\r
+ MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );\r
EMIT(' ');\r
}\r
EMIT(' ');\r
void TypeName( const char *Name )\r
{\r
const char *FirstChar;\r
- int32 Len;\r
+ cell_t Len;\r
\r
FirstChar = Name+1;\r
Len = *Name & 0x1F;\r
#define PF_ERR_OUT_OF_RANGE (PF_ERR_BASE | 18)\r
#define PF_ERR_ENDIAN_CONFLICT (PF_ERR_BASE | 19)\r
#define PF_ERR_FLOAT_CONFLICT (PF_ERR_BASE | 20)\r
+#define PF_ERR_CELL_SIZE_CONFLICT (PF_ERR_BASE | 21)\r
/* If you add an error code here, also add a text message in "pf_text.c". */\r
\r
#ifdef __cplusplus\r
char *ForthStringToC( char *dst, const char *FString );\r
char *CStringToForth( char *dst, const char *CString );\r
\r
-int32 ffCompare( const char *s1, int32 len1, const char *s2, int32 len2 );\r
-int32 ffCompareText( const char *s1, const char *s2, int32 len );\r
-int32 ffCompareTextCaseN( const char *s1, const char *s2, int32 len );\r
+cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 );\r
+cell_t ffCompareText( const char *s1, const char *s2, cell_t len );\r
+cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len );\r
\r
-void DumpMemory( void *addr, int32 cnt);\r
-char *ConvertNumberToText( int32 Num, int32 Base, int32 IfSigned, int32 MinChars );\r
+void DumpMemory( void *addr, cell_t cnt);\r
+char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars );\r
void TypeName( const char *Name );\r
\r
#ifdef __cplusplus\r
** Type Declarations\r
***************************************************************/\r
\r
-#ifndef uint32\r
- typedef unsigned long uint32;\r
-#endif\r
-#ifndef int16\r
- typedef signed short int16;\r
-#endif\r
-#ifndef uint16\r
- typedef unsigned short uint16;\r
-#endif\r
-#ifndef int8\r
- typedef signed char int8;\r
-#endif\r
-#ifndef uint8\r
- typedef unsigned char uint8;\r
-#endif\r
#ifndef Err\r
typedef long Err;\r
#endif\r
\r
-typedef int32 cell;\r
-typedef uint32 ucell;\r
-typedef cell *dicptr;\r
+typedef cell_t *dicptr;\r
\r
typedef char ForthString;\r
typedef char *ForthStringPtr;\r
** Print number in current base to output stream.\r
** This version does not handle double precision.\r
*/\r
-void ffDot( int32 n )\r
+void ffDot( cell_t n )\r
{\r
MSG( ConvertNumberToText( n, gVarBase, TRUE, 1 ) );\r
EMIT(' ');\r
** Print number in current base to output stream.\r
** This version does not handle double precision.\r
*/\r
-void ffDotHex( int32 n )\r
+void ffDotHex( cell_t n )\r
{\r
MSG( ConvertNumberToText( n, 16, FALSE, 1 ) );\r
EMIT(' ');\r
/* ( ... --- ... , print stack ) */\r
void ffDotS( void )\r
{\r
- cell *sp;\r
- int32 i, Depth;\r
+ cell_t *sp;\r
+ cell_t i, Depth;\r
\r
MSG("Stack<");\r
MSG( ConvertNumberToText( gVarBase, 10, TRUE, 1 ) ); /* Print base in decimal. */\r
}\r
\r
/* ( addr cnt char -- addr' cnt' , skip leading characters ) */\r
-cell ffSkip( char *AddrIn, cell Cnt, char c, char **AddrOut )\r
+cell_t ffSkip( char *AddrIn, cell_t Cnt, char c, char **AddrOut )\r
{\r
char *s;\r
\r
}\r
\r
/* ( addr cnt char -- addr' cnt' , scan for char ) */\r
-cell ffScan( char *AddrIn, cell Cnt, char c, char **AddrOut )\r
+cell_t ffScan( char *AddrIn, cell_t Cnt, char c, char **AddrOut )\r
{\r
char *s;\r
\r
***************************************************************/\r
\r
/* Convert a single digit to the corresponding hex number. */\r
-static cell HexDigitToNumber( char c )\r
+static cell_t HexDigitToNumber( char c )\r
{ \r
if( (c >= '0') && (c <= '9') )\r
{\r
}\r
\r
/* Convert a string to the corresponding number using BASE. */\r
-cell ffNumberQ( const char *FWord, cell *Num )\r
+cell_t ffNumberQ( const char *FWord, cell_t *Num )\r
{\r
- int32 Len, i, Accum=0, n, Sign=1;\r
+ cell_t Len, i, Accum=0, n, Sign=1;\r
const char *s;\r
\r
/* get count */\r
char * ffWord( char c )\r
{\r
char *s1,*s2,*s3;\r
- int32 n1, n2, n3;\r
- int32 i, nc;\r
+ cell_t n1, n2, n3;\r
+ cell_t i, nc;\r
\r
s1 = gCurrentTask->td_SourcePtr + gCurrentTask->td_IN;\r
n1 = gCurrentTask->td_SourceNum - gCurrentTask->td_IN;\r
extern "C" {\r
#endif\r
\r
-void ffDot( int32 n );\r
-void ffDotHex( int32 n );\r
+void ffDot( cell_t n );\r
+void ffDotHex( cell_t n );\r
void ffDotS( void );\r
-cell ffSkip( char *AddrIn, cell Cnt, char c, char **AddrOut );\r
-cell ffScan( char *AddrIn, cell Cnt, char c, char **AddrOut );\r
+cell_t ffSkip( char *AddrIn, cell_t Cnt, char c, char **AddrOut );\r
+cell_t ffScan( char *AddrIn, cell_t Cnt, char c, char **AddrOut );\r
\r
#ifdef __cplusplus\r
} \r
#include "pfcompil.h"\r
\r
#define ABORT_RETURN_CODE (10)\r
-#define UINT32_MASK ((sizeof(uint32)-1))\r
+#define UINT32_MASK ((sizeof(ucell_t)-1))\r
\r
/***************************************************************/\r
/************** Static Prototypes ******************************/\r
/***************************************************************/\r
\r
static void ffStringColon( const ForthStringPtr FName );\r
-static int32 CheckRedefinition( const ForthStringPtr FName );\r
+static cell_t CheckRedefinition( const ForthStringPtr FName );\r
static void ffUnSmudge( void );\r
-static int32 FindAndCompile( const char *theWord );\r
-static int32 ffCheckDicRoom( void );\r
+static cell_t FindAndCompile( const char *theWord );\r
+static cell_t ffCheckDicRoom( void );\r
\r
#ifndef PF_NO_INIT\r
static void CreateDeferredC( ExecToken DefaultXT, const char *CName );\r
#endif\r
\r
-int32 NotCompiled( const char *FunctionName )\r
+cell_t NotCompiled( const char *FunctionName )\r
{\r
MSG("Function ");\r
MSG(FunctionName);\r
** Create an entry in the Dictionary for the given ExecutionToken.\r
** FName is name in Forth format.\r
*/\r
-void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, uint32 Flags )\r
+void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )\r
{\r
cfNameLinks *cfnl;\r
\r
/* Set link to previous header, if any. */\r
if( gVarContext )\r
{\r
- WRITE_LONG_DIC( &cfnl->cfnl_PreviousName, ABS_TO_NAMEREL( gVarContext ) );\r
+ WRITE_CELL_DIC( &cfnl->cfnl_PreviousName, ABS_TO_NAMEREL( gVarContext ) );\r
}\r
else\r
{\r
}\r
\r
/* Put Execution token in header. */\r
- WRITE_LONG_DIC( &cfnl->cfnl_ExecToken, XT );\r
+ WRITE_CELL_DIC( &cfnl->cfnl_ExecToken, XT );\r
\r
/* Advance Header Dictionary Pointer */\r
gCurrentDictionary->dic_HeaderPtr.Byte += sizeof(cfNameLinks);\r
*gVarContext |= (char) Flags;\r
\r
/* Align to quad byte boundaries with zeroes. */\r
- while( ((uint32) gCurrentDictionary->dic_HeaderPtr.Byte) & UINT32_MASK )\r
+ while( ((ucell_t) gCurrentDictionary->dic_HeaderPtr.Byte) & UINT32_MASK )\r
{\r
*gCurrentDictionary->dic_HeaderPtr.Byte++ = 0;\r
}\r
/***************************************************************\r
** Convert name then create dictionary entry.\r
*/\r
-void CreateDicEntryC( ExecToken XT, const char *CName, uint32 Flags )\r
+void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags )\r
{\r
ForthString FName[40];\r
CStringToForth( FName, CName );\r
*/\r
const ForthString *NameToPrevious( const ForthString *NFA )\r
{\r
- cell RelNamePtr;\r
+ cell_t RelNamePtr;\r
const cfNameLinks *cfnl;\r
\r
-/* DBUG(("\nNameToPrevious: NFA = 0x%x\n", (int32) NFA)); */\r
+/* DBUG(("\nNameToPrevious: NFA = 0x%x\n", (cell_t) NFA)); */\r
cfnl = (const cfNameLinks *) ( ((const char *) NFA) - sizeof(cfNameLinks) );\r
\r
- RelNamePtr = READ_LONG_DIC((const cell *) (&cfnl->cfnl_PreviousName));\r
-/* DBUG(("\nNameToPrevious: RelNamePtr = 0x%x\n", (int32) RelNamePtr )); */\r
+ RelNamePtr = READ_CELL_DIC((const cell_t *) (&cfnl->cfnl_PreviousName));\r
+/* DBUG(("\nNameToPrevious: RelNamePtr = 0x%x\n", (cell_t) RelNamePtr )); */\r
if( RelNamePtr )\r
{\r
return ( NAMEREL_TO_ABS( RelNamePtr ) );\r
/* Convert absolute namefield address to absolute link field address. */\r
cfnl = (const cfNameLinks *) ( ((const char *) NFA) - sizeof(cfNameLinks) );\r
\r
- return READ_LONG_DIC((const cell *) (&cfnl->cfnl_ExecToken));\r
+ return READ_CELL_DIC((const cell_t *) (&cfnl->cfnl_ExecToken));\r
}\r
\r
/***************************************************************\r
** Find XTs needed by compiler.\r
*/\r
-int32 FindSpecialXTs( void )\r
+cell_t FindSpecialXTs( void )\r
{\r
if( ffFindC( "(QUIT)", &gQuitP_XT ) == 0) goto nofind;\r
if( ffFindC( "NUMBER?", &gNumberQ_XT ) == 0) goto nofind;\r
if( ffFindC( "ACCEPT", &gAcceptP_XT ) == 0) goto nofind;\r
-DBUG(("gNumberQ_XT = 0x%x\n", gNumberQ_XT ));\r
+DBUG(("gNumberQ_XT = 0x%x\n", (unsigned int)gNumberQ_XT ));\r
return 0;\r
\r
nofind:\r
** Build a dictionary from scratch.\r
*/\r
#ifndef PF_NO_INIT\r
-PForthDictionary pfBuildDictionary( int32 HeaderSize, int32 CodeSize )\r
+PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )\r
{\r
pfDictionary_t *dic;\r
\r
CreateDicEntryC( ID_BODY_OFFSET, "BODY_OFFSET", 0 );\r
CreateDicEntryC( ID_BYE, "BYE", 0 );\r
CreateDicEntryC( ID_CATCH, "CATCH", 0 );\r
+ CreateDicEntryC( ID_CELL, "CELL", 0 );\r
+ CreateDicEntryC( ID_CELLS, "CELLS", 0 );\r
CreateDicEntryC( ID_CFETCH, "C@", 0 );\r
CreateDicEntryC( ID_CMOVE, "CMOVE", 0 );\r
CreateDicEntryC( ID_CMOVE_UP, "CMOVE>", 0 );\r
** ( xt -- nfa 1 , x 0 , find NFA in dictionary from XT )\r
** 1 for IMMEDIATE values\r
*/\r
-cell ffTokenToName( ExecToken XT, const ForthString **NFAPtr )\r
+cell_t ffTokenToName( ExecToken XT, const ForthString **NFAPtr )\r
{\r
const ForthString *NameField;\r
- int32 Searching = TRUE;\r
- cell Result = 0;\r
+ cell_t Searching = TRUE;\r
+ cell_t Result = 0;\r
ExecToken TempXT;\r
\r
NameField = gVarContext;\r
** ( $name -- $addr 0 | nfa -1 | nfa 1 , find NFA in dictionary )\r
** 1 for IMMEDIATE values\r
*/\r
-cell ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr )\r
+cell_t ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr )\r
{\r
const ForthString *WordChar;\r
- uint8 WordLen;\r
+ uint8_t WordLen;\r
const char *NameField, *NameChar;\r
- int8 NameLen;\r
- int32 Searching = TRUE;\r
- cell Result = 0;\r
+ int8_t NameLen;\r
+ cell_t Searching = TRUE;\r
+ cell_t Result = 0;\r
\r
- WordLen = (uint8) ((uint32)*WordName & 0x1F);\r
+ WordLen = (uint8_t) ((ucell_t)*WordName & 0x1F);\r
WordChar = WordName+1;\r
\r
NameField = gVarContext;\r
DBUG(("\nffFindNFA: gVarContext = 0x%x\n", gVarContext));\r
do\r
{\r
- NameLen = (uint8) ((uint32)(*NameField) & MASK_NAME_SIZE);\r
+ NameLen = (uint8_t) ((ucell_t)(*NameField) & MASK_NAME_SIZE);\r
NameChar = NameField+1;\r
/* DBUG((" %c\n", (*NameField & FLAG_SMUDGE) ? 'S' : 'V' )); */\r
if( ((*NameField & FLAG_SMUDGE) == 0) &&\r
** ( $name -- $name 0 | xt -1 | xt 1 )\r
** 1 for IMMEDIATE values\r
*/\r
-cell ffFind( const ForthString *WordName, ExecToken *pXT )\r
+cell_t ffFind( const ForthString *WordName, ExecToken *pXT )\r
{\r
const ForthString *NFA;\r
- int32 Result;\r
+ cell_t Result;\r
\r
Result = ffFindNFA( WordName, &NFA );\r
DBUG(("ffFind: %8s at 0x%x\n", WordName+1, NFA)); /* WARNING, not NUL terminated. %Q */\r
/****************************************************************\r
** Find name when passed 'C' string.\r
*/\r
-cell ffFindC( const char *WordName, ExecToken *pXT )\r
+cell_t ffFindC( const char *WordName, ExecToken *pXT )\r
{\r
DBUG(("ffFindC: %s\n", WordName ));\r
CStringToForth( gScratch, WordName );\r
/*************************************************************\r
** Check for dictionary overflow. \r
*/\r
-static int32 ffCheckDicRoom( void )\r
+static cell_t ffCheckDicRoom( void )\r
{\r
- int32 RoomLeft;\r
+ cell_t RoomLeft;\r
RoomLeft = gCurrentDictionary->dic_HeaderLimit -\r
gCurrentDictionary->dic_HeaderPtr.Byte;\r
if( RoomLeft < DIC_SAFETY_MARGIN )\r
pfDebugMessage("ffCreateSecondaryHeader: CheckRedefinition()\n");\r
CheckRedefinition( FName );\r
/* Align CODE_HERE */\r
- CODE_HERE = (cell *)( (((uint32)CODE_HERE) + UINT32_MASK) & ~UINT32_MASK);\r
+ CODE_HERE = (cell_t *)( (((ucell_t)CODE_HERE) + UINT32_MASK) & ~UINT32_MASK);\r
CreateDicEntry( (ExecToken) ABS_TO_CODEREL(CODE_HERE), FName, FLAG_SMUDGE );\r
-DBUG(("ffCreateSecondaryHeader, XT = 0x%x, Name = %8s\n"));\r
}\r
\r
/*************************************************************\r
/*************************************************************\r
** Check to see if name is already in dictionary.\r
*/\r
-static int32 CheckRedefinition( const ForthStringPtr FName )\r
+static cell_t CheckRedefinition( const ForthStringPtr FName )\r
{\r
- int32 flag;\r
+ cell_t flag;\r
ExecToken XT;\r
\r
flag = ffFind( FName, &XT);\r
if ( flag && !gVarQuiet)\r
{\r
- ioType( FName+1, (int32) *FName );\r
+ ioType( FName+1, (cell_t) *FName );\r
MSG( " redefined.\n" ); // FIXME - allow user to run off this warning.\r
}\r
return flag;\r
\r
/**************************************************************/\r
/* Used to pull a number from the dictionary to the stack */\r
-void ff2Literal( cell dHi, cell dLo )\r
+void ff2Literal( cell_t dHi, cell_t dLo )\r
{\r
CODE_COMMA( ID_2LITERAL_P );\r
CODE_COMMA( dHi );\r
CODE_COMMA( dLo );\r
}\r
-void ffALiteral( cell Num )\r
+void ffALiteral( cell_t Num )\r
{\r
CODE_COMMA( ID_ALITERAL_P );\r
CODE_COMMA( Num );\r
}\r
-void ffLiteral( cell Num )\r
+void ffLiteral( cell_t Num )\r
{\r
CODE_COMMA( ID_LITERAL_P );\r
CODE_COMMA( Num );\r
* original expression. \r
*/\r
PF_FLOAT *temp;\r
- cell *dicPtr;\r
+ cell_t *dicPtr;\r
\r
/* Make sure that literal float data is float aligned. */\r
dicPtr = CODE_HERE + 1;\r
- while( (((uint32) dicPtr++) & (sizeof(PF_FLOAT) - 1)) != 0)\r
+ while( (((ucell_t) dicPtr++) & (sizeof(PF_FLOAT) - 1)) != 0)\r
{\r
DBUG((" comma NOOP to align FPLiteral\n"));\r
CODE_COMMA( ID_NOOP );\r
temp = (PF_FLOAT *)CODE_HERE;\r
WRITE_FLOAT_DIC(temp,fnum); /* Write to dictionary. */\r
temp++;\r
- CODE_HERE = (cell *) temp;\r
+ CODE_HERE = (cell_t *) temp;\r
}\r
#endif /* PF_SUPPORT_FP */\r
\r
/**************************************************************/\r
ThrowCode FindAndCompile( const char *theWord )\r
{\r
- int32 Flag;\r
+ cell_t Flag;\r
ExecToken XT;\r
- cell Num;\r
+ cell_t Num;\r
ThrowCode exception = 0;\r
\r
Flag = ffFind( theWord, &XT);\r
else /* try to interpret it as a number. */\r
{\r
/* Call deferred NUMBER? */\r
- int32 NumResult;\r
+ cell_t NumResult;\r
\r
DBUG(("FindAndCompile: not found, try number?\n" ));\r
PUSH_DATA_STACK( theWord ); /* Push text of number */\r
*/\r
ThrowCode ffInterpret( void )\r
{\r
- int32 flag;\r
+ cell_t flag;\r
char *theWord;\r
ThrowCode exception = 0;\r
\r
DBUG(("ffInterpret: IN=%d, SourceNum=%d\n", gCurrentTask->td_IN,\r
gCurrentTask->td_SourceNum ) );\r
}\r
- DBUG(("ffInterpret: CHECK_ABORT = %d\n", CHECK_ABORT));\r
error:\r
return exception;\r
}\r
/**************************************************************/\r
ThrowCode ffOK( void )\r
{\r
- int32 exception = 0;\r
+ cell_t exception = 0;\r
/* Check for stack underflow. %Q what about overflows? */\r
if( (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr) < 0 )\r
{\r
***************************************************************/\r
ThrowCode ffOuterInterpreterLoop( void )\r
{\r
- int32 exception = 0;\r
+ cell_t exception = 0;\r
do\r
{\r
exception = ffRefill();\r
***************************************************************/\r
Err ffPushInputStream( FileStream *InputFile )\r
{\r
- cell Result = 0;\r
+ cell_t Result = 0;\r
IncludeFrame *inf;\r
\r
/* Push current input state onto special include stack. */\r
/***************************************************************\r
** Convert file pointer to value consistent with SOURCE-ID.\r
***************************************************************/\r
-cell ffConvertStreamToSourceID( FileStream *Stream )\r
+cell_t ffConvertStreamToSourceID( FileStream *Stream )\r
{\r
- cell Result;\r
+ cell_t Result;\r
if(Stream == PF_STDIN)\r
{\r
Result = 0;\r
}\r
else\r
{\r
- Result = (cell) Stream;\r
+ Result = (cell_t) Stream;\r
}\r
return Result;\r
}\r
/***************************************************************\r
** Convert file pointer to value consistent with SOURCE-ID.\r
***************************************************************/\r
-FileStream * ffConvertSourceIDToStream( cell id )\r
+FileStream * ffConvertSourceIDToStream( cell_t id )\r
{\r
FileStream *stream;\r
\r
** Return length, or -1 for EOF.\r
*/\r
#define BACKSPACE (8)\r
-static cell readLineFromStream( char *buffer, cell maxChars, FileStream *stream )\r
+static cell_t readLineFromStream( char *buffer, cell_t maxChars, FileStream *stream )\r
{\r
int c;\r
int len;\r
** ( -- , fill Source from current stream )\r
** Return 1 if successful, 0 for EOF, or a negative error.\r
*/\r
-cell ffRefill( void )\r
+cell_t ffRefill( void )\r
{\r
- cell Num;\r
- cell Result = 1;\r
+ cell_t Num;\r
+ cell_t Result = 1;\r
\r
/* reset >IN for parser */\r
gCurrentTask->td_IN = 0;\r
\r
Err ffPushInputStream( FileStream *InputFile );\r
ExecToken NameToToken( const ForthString *NFA );\r
-FileStream * ffConvertSourceIDToStream( cell id );\r
+FileStream * ffConvertSourceIDToStream( cell_t id );\r
FileStream *ffPopInputStream( void );\r
-cell ffConvertStreamToSourceID( FileStream *Stream );\r
-cell ffFind( const ForthString *WordName, ExecToken *pXT );\r
-cell ffFindC( const char *WordName, ExecToken *pXT );\r
-cell ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr );\r
-cell ffNumberQ( const char *FWord, cell *Num );\r
-cell ffRefill( void );\r
-cell ffTokenToName( ExecToken XT, const ForthString **NFAPtr );\r
-cell *NameToCode( ForthString *NFA );\r
-PForthDictionary pfBuildDictionary( int32 HeaderSize, int32 CodeSize );\r
+cell_t ffConvertStreamToSourceID( FileStream *Stream );\r
+cell_t ffFind( const ForthString *WordName, ExecToken *pXT );\r
+cell_t ffFindC( const char *WordName, ExecToken *pXT );\r
+cell_t ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr );\r
+cell_t ffNumberQ( const char *FWord, cell_t *Num );\r
+cell_t ffRefill( void );\r
+cell_t ffTokenToName( ExecToken XT, const ForthString **NFAPtr );\r
+cell_t *NameToCode( ForthString *NFA );\r
+PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize );\r
char *ffWord( char c );\r
const ForthString *NameToPrevious( const ForthString *NFA );\r
-int32 FindSpecialCFAs( void );\r
-int32 FindSpecialXTs( void );\r
-int32 NotCompiled( const char *FunctionName );\r
-void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, uint32 Flags );\r
-void CreateDicEntryC( ExecToken XT, const char *CName, uint32 Flags );\r
-void ff2Literal( cell dHi, cell dLo );\r
-void ffALiteral( cell Num );\r
+cell_t FindSpecialCFAs( void );\r
+cell_t FindSpecialXTs( void );\r
+cell_t NotCompiled( const char *FunctionName );\r
+void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags );\r
+void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags );\r
+void ff2Literal( cell_t dHi, cell_t dLo );\r
+void ffALiteral( cell_t Num );\r
void ffColon( void );\r
void ffCreate( void );\r
void ffCreateSecondaryHeader( const ForthStringPtr FName);\r
void ffDefer( void );\r
void ffFinishSecondary( void );\r
-void ffLiteral( cell Num );\r
+void ffLiteral( cell_t Num );\r
void ffStringCreate( ForthStringPtr FName);\r
void ffStringDefer( const ForthStringPtr FName, ExecToken DefaultXT );\r
void pfHandleIncludeError( void );\r
\r
#include "pf_all.h"\r
\r
-static int32 CTest0( int32 Val );\r
-static void CTest1( int32 Val1, cell Val2 );\r
+static cell_t CTest0( cell_t Val );\r
+static void CTest1( cell_t Val1, cell_t Val2 );\r
\r
/****************************************************************\r
** Step 1: Put your own special glue routines here\r
** or link them in from another file or library.\r
****************************************************************/\r
-static int32 CTest0( int32 Val )\r
+static cell_t CTest0( cell_t Val )\r
{\r
MSG_NUM_D("CTest0: Val = ", Val);\r
return Val+1;\r
}\r
\r
-static void CTest1( int32 Val1, cell Val2 )\r
+static void CTest1( cell_t Val1, cell_t Val2 )\r
{\r
\r
MSG("CTest1: Val1 = "); ffDot(Val1);\r
#define RELCONTEXT (0x00003D5C)
#define CODEPTR (0x000093E8)
#define IF_LITTLE_ENDIAN (0x00000001)
-static const uint8 MinDicNames[] = {
+static const uint8_t MinDicNames[] = {
/* 0x00000000: */ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x04,0x45,0x58,0x49,0x54,0x00,0x00,0x00,
/* 0x00000010: */ 0x08,0x00,0x00,0x00,0x01,0x00,0x00,0x00,0x02,0x31,0x2D,0x00,0x18,0x00,0x00,0x00,
/* 0x00000020: */ 0x02,0x00,0x00,0x00,0x02,0x31,0x2B,0x00,0x24,0x00,0x00,0x00,0x0A,0x00,0x00,0x00,
/* 0x00003D60: */ 0x3B,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,
};
-static const uint8 MinDicCode[] = {
+static const uint8_t MinDicCode[] = {
/* 0x00000000: */ 0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,
/* 0x00000010: */ 0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,
/* 0x00000020: */ 0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,0x5A,
{\r
fpTemp = ((PF_FLOAT) TOS); /* dhi */\r
fpTemp *= FP_DHI1;\r
- fpScratch = ( (PF_FLOAT) ((uint32)Scratch) ); /* Convert TOS and push on FP stack. */\r
+ fpScratch = ( (PF_FLOAT) ((ucell_t)Scratch) ); /* Convert TOS and push on FP stack. */\r
FP_TOS = fpTemp + fpScratch;\r
} \r
M_DROP;\r
case ID_FP_F_TO_D: /* ( -- dlo dhi) ( F: r -- ) */\r
/* printf("f2d = %g\n", FP_TOS); */\r
{\r
- uint32 dlo;\r
- int32 dhi;\r
+ ucell_t dlo;\r
+ cell_t dhi;\r
int ifNeg;\r
/* Convert absolute value, then negate D if negative. */\r
PUSH_TOS; /* Save old TOS */\r
}\r
fpScratch = fpTemp / FP_DHI1;\r
/* printf("f2d - fpScratch = %g\n", fpScratch); */\r
- dhi = (int32) fpScratch; /* dhi */\r
+ dhi = (cell_t) fpScratch; /* dhi */\r
fpScratch = ((PF_FLOAT) dhi) * FP_DHI1;\r
/* printf("f2d - , dhi = 0x%x, fpScratch = %g\n", dhi, fpScratch); */\r
\r
fpTemp = fpTemp - fpScratch; /* Remainder */\r
- dlo = (uint32) fpTemp;\r
+ dlo = (ucell_t) fpTemp;\r
/* printf("f2d - , dlo = 0x%x, fpTemp = %g\n", dlo, fpTemp); */\r
if( ifNeg )\r
{\r
PF_FLOAT *fptr;\r
fptr = (PF_FLOAT *)InsPtr;\r
FP_TOS = READ_FLOAT_DIC( fptr++ );\r
- InsPtr = (cell *) fptr;\r
+ InsPtr = (cell_t *) fptr;\r
}\r
#endif\r
endcase;\r
typedef void *PForthTask;\r
typedef void *PForthDictionary;\r
\r
-typedef unsigned long ExecToken; /* Execution Token */\r
-typedef long ThrowCode;\r
+#include <stdint.h>\r
+/* Integer types for Forth cells, signed and unsigned: */\r
+typedef intptr_t cell_t;\r
+typedef uintptr_t ucell_t;\r
\r
-#ifndef int32\r
- typedef long int32;\r
-#endif\r
+typedef ucell_t ExecToken; /* Execution Token */\r
+typedef cell_t ThrowCode;\r
\r
#ifdef __cplusplus\r
extern "C" {\r
#endif\r
\r
/* Main entry point to pForth. */\r
-int32 pfDoForth( const char *DicName, const char *SourceName, int32 IfInit );\r
+cell_t pfDoForth( const char *DicName, const char *SourceName, cell_t IfInit );\r
\r
/* Turn off messages. */\r
-void pfSetQuiet( int32 IfQuiet );\r
+void pfSetQuiet( cell_t IfQuiet );\r
\r
/* Query message status. */\r
-int32 pfQueryQuiet( void );\r
+cell_t pfQueryQuiet( void );\r
\r
/* Send a message using low level I/O of pForth */\r
void pfMessage( const char *CString );\r
\r
/* Create a task used to maintain context of execution. */\r
-PForthTask pfCreateTask( int32 UserStackDepth, int32 ReturnStackDepth );\r
+PForthTask pfCreateTask( cell_t UserStackDepth, cell_t ReturnStackDepth );\r
\r
/* Establish this task as the current task. */\r
void pfSetCurrentTask( PForthTask task );\r
void pfDeleteTask( PForthTask task );\r
\r
/* Build a dictionary with all the basic kernel words. */\r
-PForthDictionary pfBuildDictionary( int32 HeaderSize, int32 CodeSize );\r
+PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize );\r
\r
/* Create an empty dictionary. */\r
-PForthDictionary pfCreateDictionary( int32 HeaderSize, int32 CodeSize );\r
+PForthDictionary pfCreateDictionary( cell_t HeaderSize, cell_t CodeSize );\r
\r
/* Load dictionary from a file. */\r
PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr );\r
\r
: >> rshift ;\r
: << lshift ;\r
-: CELL* ( n -- n*cell ) 2 lshift ;\r
\r
: (WARNING") ( flag $message -- )\r
swap\r
c" IF_LITTLE_ENDIAN" IS.LITTLE.ENDIAN? IF 1 ELSE 0 THEN sdad.define\r
\r
." Saving Names" cr\r
- s" static const uint8 MinDicNames[] = {" sdad.type\r
+ s" static const uint8_t MinDicNames[] = {" sdad.type\r
namebase headers-ptr @ SDAD_NAMES_EXTRA sdad.dump.data\r
EOL sdad.emit\r
c" };" $sdad.line\r
\r
." Saving Code" cr\r
- s" static const uint8 MinDicCode[] = {" sdad.type\r
+ s" static const uint8_t MinDicCode[] = {" sdad.type\r
codebase here SDAD_CODE_EXTRA sdad.dump.data\r
EOL sdad.emit\r
c" };" $sdad.line\r
2+ * even-up allot\r
DOES> ( index -- $addr )\r
dup @ ( get #chars )\r
- rot * + 4 +\r
+ rot * + cell+\r
;\r
\r
\ Compare two strings\r
: \ ( <line> -- , comment out rest of line )\r
EOL word drop\r
; immediate\r
-
-\ 1 echo ! \ Uncomment this line to echo Forth code while compiling.
+\r
+\ 1 echo ! \ Uncomment this line to echo Forth code while compiling.\r
\r
\ *********************************************************************\r
\ This is another style of comment that is common in Forth.\r
0 swap !\r
;\r
\r
-\ size of data items\r
-\ FIXME - move these into 'C' code for portability ????\r
-: CELL ( -- size_of_stack_item ) 4 ;\r
-\r
: CELL+ ( n -- n+cell ) cell + ;\r
: CELL- ( n -- n+cell ) cell - ;\r
-: CELLS ( n -- n*cell ) 2 lshift ;\r
+: CELL* ( n -- n*cell ) cells ;
\r
: CHAR+ ( n -- n+size_of_char ) 1+ ;\r
: CHARS ( n -- n*size_of_char , don't do anything) ; immediate\r
;\r
\r
: N>LINK ( nfa -- lfa )\r
- 8 -\r
+ 2 CELLS -\r
;\r
\r
: >BODY ( xt -- pfa )\r
;\r
\r
: D2* ( d -- d*2 )\r
- 2* over 31 rshift or swap\r
+ 2* over
+ cell 8 * 1- rshift or swap\r
2* swap\r
;\r
\r
\r
.( Dictionary compiled, save in "pforth.dic".) cr\r
c" pforth.dic" save-forth\r
-
+\r
\ Save the dictionary in "pfdicdat.h" file so pForth can be compiled for standalone mode.\r
SDAD\r
\r
Documentation for pForth at http://www.softsynth.com/pforth/\r
\r
-V?? \r
- - Added -m32 to Makefile so we get 32 bit longs on Snow Leopard.
- - Added "-x c" to Makefile CCOPTS to prevent confusion with C++
+V25 5/19/2010
+ - Added 64-bit CELL support contributed by Aleksej Saushev. Thanks Aleksej!
+ - Added "-x c" to Makefile CCOPTS to prevent confusion with C++
- Allow space after -d command line option.\r
- Restore normal tty mode if pForth dictionary loading fails.\r
\r
- Fixed float evaluation in EVALUATE in "quit.fth".\r
- Flush register cache for ffColon and ffSemiColon to prevent stack warnings from ;\r
\r
-V21 - 9/16/98\r
+V21 - 9/16/1998\r
- Fixed some compiler warnings.\r
\r
V20\r
started with "-i" option. It used to always consider numeric input as HEX.\r
Initial BASE is decimal. \r
\r
-V19 4/98\r
+V19 4/1998\r
\r
- Warn if local var name matches dictionary, : foo { count -- } ;\r
- TO -> and +-> now parse input stream. No longer use to-flag.\r
projects / pforth / commitdiff