Remove trailing white space.
[pforth] / csrc / pf_core.c
index 497b7e0..00149f4 100644 (file)
@@ -42,7 +42,7 @@
 char          gScratch[TIB_SIZE];\r
 pfTaskData_t   *gCurrentTask = NULL;\r
 pfDictionary_t *gCurrentDictionary;\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
 \r
 ExecToken     gLocalCompiler_XT;   /* custom compiler for local variables */\r
 ExecToken     gNumberQ_XT;         /* XT of NUMBER? */\r
@@ -50,22 +50,22 @@ ExecToken     gQuitP_XT;           /* XT of (QUIT) */
 ExecToken     gAcceptP_XT;         /* XT of ACCEPT */\r
 \r
 /* Depth of data stack when colon called. */\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
 \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
 \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
 static void pfResetForthTask( void );\r
 static void pfInit( void );\r
@@ -87,19 +87,18 @@ static void pfInit( void )
        gCurrentDictionary = NULL;\r
        gNumPrimitives = 0;\r
        gLocalCompiler_XT = 0;\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
        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
        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
        pfInitMemoryAllocator();\r
        ioInit();\r
@@ -123,7 +122,7 @@ void pfDeleteTask( PForthTask task )
 \r
 /* Allocate some extra cells to protect against mild stack underflows. */\r
 #define STACK_SAFETY  (8)\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
 {\r
        pfTaskData_t *cftd;\r
 \r
@@ -132,14 +131,14 @@ PForthTask pfCreateTask( int32 UserStackDepth, int32 ReturnStackDepth )
        pfSetMemory( cftd, 0, sizeof( pfTaskData_t ));\r
 \r
 /* Allocate User Stack */\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
                                (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
        if( !cftd->td_ReturnLimit ) goto nomem;\r
        cftd->td_ReturnBase = cftd->td_ReturnLimit + ReturnStackDepth;\r
        cftd->td_ReturnPtr = cftd->td_ReturnBase;\r
@@ -147,7 +146,7 @@ PForthTask pfCreateTask( int32 UserStackDepth, int32 ReturnStackDepth )
 /* Allocate Float Stack */\r
 #ifdef PF_SUPPORT_FP\r
 /* Allocate room for as many Floats as we do regular data. */\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
                                (UserStackDepth + STACK_SAFETY)));\r
        if( !cftd->td_FloatStackLimit ) goto nomem;\r
        cftd->td_FloatStackBase = cftd->td_FloatStackLimit + UserStackDepth;\r
@@ -171,10 +170,10 @@ nomem:
 ** Dictionary Management\r
 ***************************************************************/\r
 \r
 ** Dictionary Management\r
 ***************************************************************/\r
 \r
-int32 pfExecIfDefined( const char *CString )\r
+cell_t pfExecIfDefined( const char *CString )\r
 {\r
        int result = 0;\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
        {\r
                ExecToken  XT;\r
                if( ffFindC( CString, &XT ) )\r
@@ -208,7 +207,7 @@ void pfDeleteDictionary( PForthDictionary dictionary )
 ** Delete using pfDeleteDictionary().\r
 ** Return pointer to dictionary management structure.\r
 */\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
 /* Allocate memory for initial dictionary. */\r
        pfDictionary_t *dic;\r
@@ -221,35 +220,35 @@ PForthDictionary pfCreateDictionary( int32 HeaderSize, int32 CodeSize )
 \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
 \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
  */\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
 \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
                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_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
        }\r
        else\r
        {\r
-               dic->dic_HeaderBase = NULL;\r
+               dic->dic_HeaderBase = 0;\r
        }\r
 \r
 /* Allocate memory for code. */\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
        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
 \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
        \r
        return (PForthDictionary) dic;\r
 nomem:\r
@@ -291,16 +290,16 @@ void pfSetCurrentTask( PForthTask task )
 ** Set Quiet Flag.\r
 ***************************************************************/\r
 \r
 ** Set Quiet Flag.\r
 ***************************************************************/\r
 \r
-void pfSetQuiet( int32 IfQuiet )\r
+void pfSetQuiet( cell_t IfQuiet )\r
 {      \r
 {      \r
-       gVarQuiet = (cell) IfQuiet;\r
+       gVarQuiet = (cell_t) IfQuiet;\r
 }\r
 \r
 /***************************************************************\r
 ** Query message status.\r
 ***************************************************************/\r
 \r
 }\r
 \r
 /***************************************************************\r
 ** Query message status.\r
 ***************************************************************/\r
 \r
-int32  pfQueryQuiet( void )\r
+cell_t  pfQueryQuiet( void )\r
 {      \r
        return gVarQuiet;\r
 }\r
 {      \r
        return gVarQuiet;\r
 }\r
@@ -347,12 +346,12 @@ ThrowCode pfQuit( void )
 ** Include file based on 'C' name.\r
 ***************************************************************/\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
 {\r
        FileStream *fid;\r
-       int32 Result;\r
+       cell_t Result;\r
        char  buffer[32];\r
        char  buffer[32];\r
-       int32 numChars, len;\r
+       cell_t numChars, len;\r
        \r
 /* Open file. */\r
        fid = sdOpenFile( FileName, "r" );\r
        \r
 /* Open file. */\r
        fid = sdOpenFile( FileName, "r" );\r
@@ -366,17 +365,16 @@ int32 pfIncludeFile( const char *FileName )
        \r
 /* Create a dictionary word named ::::FileName for FILE? */\r
        pfCopyMemory( &buffer[0], "::::", 4);\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
        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
        \r
 /* Create a dictionary word named ;;;; for FILE? */\r
        CreateDicEntryC( ID_NOOP, ";;;;", 0 );\r
        \r
-       sdCloseFile(fid);\r
        return Result;\r
 }\r
 \r
        return Result;\r
 }\r
 \r
@@ -423,19 +421,18 @@ void pfDebugPrintDecimalNumber( int n )
 ***************************************************************/\r
 void pfMessage( const char *CString )\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
 }\r
 \r
 /**************************************************************************\r
-** Main entry point for pForth\r
+** Main entry point for pForth.\r
 */\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
 {\r
        pfTaskData_t *cftd;\r
        pfDictionary_t *dic = NULL;\r
-       int32 Result = 0;\r
+       cell_t Result = 0;\r
        ExecToken  EntryPoint = 0;\r
        ExecToken  EntryPoint = 0;\r
-       \r
 \r
 #ifdef PF_USER_INIT\r
        Result = PF_USER_INIT;\r
 \r
 #ifdef PF_USER_INIT\r
        Result = PF_USER_INIT;\r
@@ -452,7 +449,7 @@ int32 pfDoForth( const char *DicFileName, const char *SourceName, int32 IfInit )
        {\r
                pfSetCurrentTask( cftd );\r
                \r
        {\r
                pfSetCurrentTask( cftd );\r
                \r
-               if( !pfQueryQuiet() )\r
+               if( !gVarQuiet )\r
                {\r
                        MSG( "PForth V"PFORTH_VERSION );\r
                        if( IsHostLittleEndian() ) MSG("-LE");\r
                {\r
                        MSG( "PForth V"PFORTH_VERSION );\r
                        if( IsHostLittleEndian() ) MSG("-LE");\r
@@ -462,6 +459,15 @@ int32 pfDoForth( const char *DicFileName, const char *SourceName, int32 IfInit )
 #elif PF_LITTLE_ENDIAN_DIC\r
             MSG("/LE");\r
 #endif\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
                        MSG( ", built "__DATE__" "__TIME__ );\r
                }\r
 \r
@@ -490,19 +496,29 @@ int32 pfDoForth( const char *DicFileName, const char *SourceName, int32 IfInit )
                        if( DicFileName )\r
                        {\r
                                pfDebugMessage("DicFileName = "); pfDebugMessage(DicFileName); pfDebugMessage("\n");\r
                        if( DicFileName )\r
                        {\r
                                pfDebugMessage("DicFileName = "); pfDebugMessage(DicFileName); pfDebugMessage("\n");\r
-                               EMIT_CR;\r
+                               if( !gVarQuiet )\r
+                               {\r
+                                       EMIT_CR;\r
+                               }\r
                                dic = pfLoadDictionary( DicFileName, &EntryPoint );\r
                        }\r
                        else\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 error2;\r
                                dic = pfLoadStaticDictionary();                 \r
                        }\r
                }\r
                if( dic == NULL ) goto error2;\r
-               EMIT_CR;\r
-\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
                pfDebugMessage("pfDoForth: try AUTO.INIT\n");\r
                Result = pfExecIfDefined("AUTO.INIT");\r
                if( Result != 0 )\r
@@ -553,7 +569,7 @@ int32 pfDoForth( const char *DicFileName, const char *SourceName, int32 IfInit )
 error2:\r
        MSG("pfDoForth: Error occured.\n");\r
        pfDeleteTask( cftd );\r
 error2:\r
        MSG("pfDoForth: Error occured.\n");\r
        pfDeleteTask( cftd );\r
-       // Terminate so we restore normal shell tty mode.\r
+       /* Terminate so we restore normal shell tty mode. */\r
        pfTerm();\r
 \r
 #ifdef PF_USER_INIT\r
        pfTerm();\r
 \r
 #ifdef PF_USER_INIT\r
@@ -562,3 +578,13 @@ error1:
 \r
        return -1;\r
 }\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