V25 with 64-bit support

[pforth] / csrc / pf_core.c

diff --git a/csrc/pf_core.c b/csrc/pf_core.c
index 740d942..7abe8c1 100644 (file)
--- a/csrc/pf_core.c
+++ b/csrc/pf_core.c
@@ -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
 char         *gVarContext;      /* Points to last name field. */\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
 \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


@@ -123,7 +123,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 +132,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 +147,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,7 +171,7 @@ 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
        if( NAME_BASE != NULL)\r
 {\r
        int result = 0;\r
        if( NAME_BASE != NULL)\r


@@ -208,7 +208,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,19 +221,19 @@ 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)  ((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
 \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
                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
                dic->dic_HeaderLimit = dic->dic_HeaderBase + HeaderSize;\r
                dic->dic_HeaderPtr.Byte = dic->dic_HeaderBase;\r
        }\r


@@ -243,10 +243,10 @@ PForthDictionary pfCreateDictionary( int32 HeaderSize, int32 CodeSize )
        }\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 = ( 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
        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
 \r
        dic->dic_CodeLimit = dic->dic_CodeBase + CodeSize;\r
        dic->dic_CodePtr.Byte = dic->dic_CodeBase + QUADUP(NUM_PRIMITIVES); \r


@@ -291,16 +291,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 +347,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,7 +366,7 @@ 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
        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


@@ -423,17 +423,17 @@ 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.
+** 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
 \r
 #ifdef PF_USER_INIT\r
        ExecToken  EntryPoint = 0;\r
 \r
 #ifdef PF_USER_INIT\r


@@ -461,6 +461,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