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 gVarContext; /* Points to last name field. */\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
gCurrentDictionary = NULL;\r
gNumPrimitives = 0;\r
gLocalCompiler_XT = 0;\r
- gVarContext = NULL; /* Points to last name field. */\r
+ gVarContext = (cell_t)NULL; /* Points to last name field. */\r
gVarState = 0; /* 1 if compiling. */\r
gVarEcho = 0; /* Echo input. */\r
gVarTraceLevel = 0; /* Trace Level for Inner Interpreter. */\r
gVarTraceFlags = 0; /* Enable various internal debug messages. */\r
- gVarQuiet = 0; /* Suppress unnecessary messages, OK, etc. */\r
gVarReturnCode = 0; /* Returned to caller of Forth, eg. UNIX shell. */\r
gIncludeIndex = 0;\r
\r
/* non-zero */\r
gVarBase = 10; /* Numeric Base. */\r
gDepthAtColon = DEPTH_AT_COLON_INVALID;\r
- gVarTraceStack = 1; \r
+ gVarTraceStack = 1;\r
\r
pfInitMemoryAllocator();\r
ioInit();\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
+ if( NAME_BASE != (cell_t)NULL)\r
{\r
ExecToken XT;\r
if( ffFindC( CString, &XT ) )\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) ((((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 = (ucell_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( (char *) dic->dic_HeaderBase, 0xA5, (ucell_t) HeaderSize);\r
dic->dic_HeaderLimit = dic->dic_HeaderBase + HeaderSize;\r
- dic->dic_HeaderPtr.Byte = dic->dic_HeaderBase;\r
+ dic->dic_HeaderPtr = dic->dic_HeaderBase;\r
}\r
else\r
{\r
- dic->dic_HeaderBase = NULL;\r
+ dic->dic_HeaderBase = 0;\r
}\r
\r
/* Allocate memory for code. */\r
- dic->dic_CodeBaseUnaligned = ( uint8 * ) pfAllocMem( (uint32) CodeSize + DIC_ALIGNMENT_SIZE );\r
+ dic->dic_CodeBaseUnaligned = (ucell_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( (char *) 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
+ dic->dic_CodePtr.Byte = ((uint8_t *) (dic->dic_CodeBase + QUADUP(NUM_PRIMITIVES))); \r
\r
return (PForthDictionary) dic;\r
nomem:\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
- Result = ffIncludeFile( fid );\r
+ Result = ffIncludeFile( fid ); /* Also close the file. */\r
\r
/* Create a dictionary word named ;;;; for FILE? */\r
CreateDicEntryC( ID_NOOP, ";;;;", 0 );\r
\r
- sdCloseFile(fid);\r
return Result;\r
}\r
\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 fo pForth\r
+** Main entry point for pForth.\r
*/\r
-int32 pfDoForth( const char *DicName, 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
\r
#ifdef PF_USER_INIT\r
Result = PF_USER_INIT;\r
- if( Result < 0 ) goto error;\r
+ if( Result < 0 ) goto error1;\r
#endif\r
\r
pfInit();\r
{\r
pfSetCurrentTask( cftd );\r
\r
- if( !pfQueryQuiet() )\r
+ if( !gVarQuiet )\r
{\r
MSG( "PForth V"PFORTH_VERSION );\r
if( IsHostLittleEndian() ) MSG("-LE");\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
\r
\r
#ifdef PF_NO_GLOBAL_INIT\r
- if( LoadCustomFunctionTable() < 0 ) goto error; /* Init custom 'C' call array. */\r
+ if( LoadCustomFunctionTable() < 0 ) goto error2; /* Init custom 'C' call array. */\r
#endif\r
\r
#if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))\r
TOUCH(IfInit);\r
#endif /* !PF_NO_INIT && !PF_NO_SHELL*/\r
{\r
- if( DicName )\r
+ if( DicFileName )\r
{\r
- pfDebugMessage("DicName = "); pfDebugMessage(DicName); pfDebugMessage("\n");\r
- EMIT_CR;\r
- dic = pfLoadDictionary( DicName, &EntryPoint );\r
+ pfDebugMessage("DicFileName = "); pfDebugMessage(DicFileName); pfDebugMessage("\n");\r
+ if( !gVarQuiet )\r
+ {\r
+ EMIT_CR;\r
+ }\r
+ dic = pfLoadDictionary( DicFileName, &EntryPoint );\r
}\r
else\r
{\r
- MSG(" (static)");\r
- EMIT_CR;\r
+ if( !gVarQuiet )\r
+ {\r
+ MSG(" (static)");\r
+ EMIT_CR;\r
+ }\r
dic = pfLoadStaticDictionary(); \r
}\r
}\r
- if( dic == NULL ) goto error;\r
- EMIT_CR;\r
-\r
+ if( dic == NULL ) goto error2;\r
+ \r
+ if( !gVarQuiet )\r
+ {\r
+ EMIT_CR;\r
+ }\r
+ \r
pfDebugMessage("pfDoForth: try AUTO.INIT\n");\r
Result = pfExecIfDefined("AUTO.INIT");\r
if( Result != 0 )\r
{\r
MSG("Error in AUTO.INIT");\r
- goto error;\r
+ goto error2;\r
}\r
-\r
+ \r
if( EntryPoint != 0 )\r
{\r
Result = pfCatch( EntryPoint );\r
\r
return Result;\r
\r
-error:\r
+error2:\r
MSG("pfDoForth: Error occured.\n");\r
pfDeleteTask( cftd );\r
+ /* Terminate so we restore normal shell tty mode. */\r
+ pfTerm();\r
+\r
+#ifdef PF_USER_INIT\r
+error1:\r
+#endif\r
+\r
return -1;\r
}\r
+\r
+\r
+#ifdef PF_UNIT_TEST\r
+cell_t pfUnitTest( void )\r
+{\r
+ cell_t numErrors = 0;\r
+ numErrors += pfUnitTestText();\r
+ return numErrors;\r
+}\r
+#endif\r