V25 with 64-bit support

[pforth] / csrc / pf_guts.h

diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h
index b3814ad..0e34581 100644 (file)
--- a/csrc/pf_guts.h
+++ b/csrc/pf_guts.h
@@ -23,7 +23,7 @@
 ** PFORTH_VERSION changes when PForth is modified and released.\r
 ** See README file for version info.\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
 \r
 /*\r
 ** PFORTH_FILE_VERSION changes when incompatible changes are made\r


@@ -35,9 +35,10 @@
 ** 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
 ** 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
 */\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
 \r
 /***************************************************************\r
 ** Sizes and other constants\r


@@ -72,7 +73,7 @@
 #define NUM_TYPE_DOUBLE (2)\r
 #define NUM_TYPE_FLOAT  (3)\r
 \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
 \r
 /***************************************************************\r
 ** Primitive Token IDS\r


@@ -275,6 +276,9 @@ enum cforth_primitive_ids
        ID_INTERPRET,\r
        ID_FILE_WO,\r
        ID_FILE_BIN,\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
 /* 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


@@ -294,8 +298,6 @@ enum cforth_primitive_ids
        ID_RESERVED12,\r
        ID_RESERVED13,\r
        ID_RESERVED14,\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
        ID_FP_D_TO_F,\r
        ID_FP_FSTORE,\r
        ID_FP_FTIMES,\r


@@ -377,26 +379,26 @@ enum cforth_primitive_ids
 \r
 typedef struct pfTaskData_s\r
 {\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
 #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
        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
        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
 } pfTaskData_t;\r
 \r
 typedef struct pfNode\r


@@ -408,7 +410,7 @@ typedef struct pfNode
 /* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/\r
 typedef struct cfNameLinks\r
 {\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
        ExecToken  cfnl_ExecToken;      /* Execution token for word. */\r
 /* Followed by variable length name field. */\r
 } cfNameLinks;\r


@@ -417,38 +419,38 @@ typedef struct cfNameLinks
 typedef struct pfDictionary_s\r
 {\r
        pfNode  dic_Node;\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
 /* Headers contain pointers to names and dictionary. */\r
 \r

-       uint8   *dic_HeaderBaseUnaligned;\r
+       uint8_t *dic_HeaderBaseUnaligned;\r

 \r
 \r

-       uint8   *dic_HeaderBase;\r
+       uint8_t *dic_HeaderBase;\r

        union\r
        {\r
        union\r
        {\r

-               cell    *Cell;\r
-               uint8   *Byte;\r
+               cell_t  *Cell;\r
+               uint8_t *Byte;\r

        } dic_HeaderPtr;\r
        } dic_HeaderPtr;\r

-       uint8   *dic_HeaderLimit;\r
+       uint8_t *dic_HeaderLimit;\r

 /* Code segment contains tokenized code and data. */\r
 \r
 /* Code segment contains tokenized code and data. */\r
 \r

-       uint8   *dic_CodeBaseUnaligned;\r
+       uint8_t *dic_CodeBaseUnaligned;\r

 \r
 \r

-       uint8   *dic_CodeBase;\r
+       uint8_t *dic_CodeBase;\r

        union\r
        {\r
        union\r
        {\r

-               cell    *Cell;\r
-               uint8   *Byte;\r
+               cell_t  *Cell;\r
+               uint8_t *Byte;\r

        } dic_CodePtr;\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
 } 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
        char          inf_SaveTIB[TIB_SIZE];\r
 } IncludeFrame;\r
 \r


@@ -474,7 +476,7 @@ int pfCatch( ExecToken XT );
 extern pfTaskData_t *gCurrentTask;\r
 extern pfDictionary_t *gCurrentDictionary;\r
 extern char          gScratch[TIB_SIZE];\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
 \r
 extern ExecToken     gLocalCompiler_XT;      /* CFA of (LOCAL) compiler. */\r
 extern ExecToken     gNumberQ_XT;         /* XT of NUMBER? */\r


@@ -482,22 +484,22 @@ extern ExecToken     gQuitP_XT;           /* XT of (QUIT) */
 extern ExecToken     gAcceptP_XT;         /* XT of ACCEPT */\r
 \r
 #define DEPTH_AT_COLON_INVALID (-100)\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
 \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
 \r
 extern IncludeFrame  gIncludeStack[MAX_INCLUDE_DEPTH];\r

-extern int32         gIncludeIndex;\r
+extern cell_t         gIncludeIndex;\r

 /***************************************************************\r
 ** Macros\r
 ***************************************************************/\r
 /***************************************************************\r
 ** Macros\r
 ***************************************************************/\r


@@ -512,51 +514,51 @@ extern int32         gIncludeIndex;
 #if defined(PF_BIG_ENDIAN_DIC)\r
 \r
 #define WRITE_FLOAT_DIC             WriteFloatBigEndian\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_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
 \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_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
 \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_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
 \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 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
 \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 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
 \r
 /* The check for >0 is only needed for CLONE testing. !!! */\r
 #define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))\r


@@ -566,7 +568,7 @@ extern int32         gIncludeIndex;
 #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 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
 \r
 /* Force Quad alignment. */\r
 #define QUADUP(x) (((x)+3)&~3)\r


@@ -592,9 +594,9 @@ extern int32         gIncludeIndex;
 #define DBUG(x)  /* PRT(x) */\r
 #define DBUGX(x) /* DBUG(x) */\r
 \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
 \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
 #endif  /* _pf_guts_h */\r