projects / pforth / blobdiff
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add support for WATCOMC
[pforth] / csrc / pfcompil.c
diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 3613b33..bc4c585 100644 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -58,7 +58,7 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 {\r
        cfNameLinks *cfnl;\r
 \r
 {\r
        cfNameLinks *cfnl;\r
 \r
-       cfnl = (cfNameLinks *) gCurrentDictionary->dic_HeaderPtr.Byte;\r
+       cfnl = (cfNameLinks *) gCurrentDictionary->dic_HeaderPtr;\r
 \r
 /* Set link to previous header, if any. */\r
        if( gVarContext )\r
 \r
 /* Set link to previous header, if any. */\r
        if( gVarContext )\r
@@ -74,20 +74,20 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
        WRITE_CELL_DIC( &cfnl->cfnl_ExecToken, XT );\r
 \r
 /* Advance Header Dictionary Pointer */\r
        WRITE_CELL_DIC( &cfnl->cfnl_ExecToken, XT );\r
 \r
 /* Advance Header Dictionary Pointer */\r
-       gCurrentDictionary->dic_HeaderPtr.Byte += sizeof(cfNameLinks);\r
+       gCurrentDictionary->dic_HeaderPtr += sizeof(cfNameLinks);\r
 \r
 /* Laydown name. */\r
 \r
 /* Laydown name. */\r
-       gVarContext = (char *) gCurrentDictionary->dic_HeaderPtr.Byte;\r
-       pfCopyMemory( gCurrentDictionary->dic_HeaderPtr.Byte, FName, (*FName)+1 );\r
-       gCurrentDictionary->dic_HeaderPtr.Byte += (*FName)+1;\r
+       gVarContext = gCurrentDictionary->dic_HeaderPtr;\r
+       pfCopyMemory( (uint8_t *) gCurrentDictionary->dic_HeaderPtr, FName, (*FName)+1 );\r
+       gCurrentDictionary->dic_HeaderPtr += (*FName)+1;\r
 \r
 /* Set flags. */\r
 \r
 /* Set flags. */\r
-       *gVarContext |= (char) Flags;\r
+       *(char*)gVarContext |= (char) Flags;\r
        \r
 /* Align to quad byte boundaries with zeroes. */\r
        \r
 /* Align to quad byte boundaries with zeroes. */\r
-       while( ((ucell_t) gCurrentDictionary->dic_HeaderPtr.Byte) & UINT32_MASK )\r
+       while( gCurrentDictionary->dic_HeaderPtr & UINT32_MASK )\r
        {\r
        {\r
-               *gCurrentDictionary->dic_HeaderPtr.Byte++ = 0;\r
+               *(char*)(gCurrentDictionary->dic_HeaderPtr++) = 0;\r
        }\r
 }\r
 \r
        }\r
 }\r
 \r
@@ -97,7 +97,7 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags )\r
 {\r
        ForthString FName[40];\r
 void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags )\r
 {\r
        ForthString FName[40];\r
-       CStringToForth( FName, CName );\r
+       CStringToForth( FName, CName, sizeof(FName) );\r
        CreateDicEntry( XT, FName, Flags );\r
 }\r
 \r
        CreateDicEntry( XT, FName, Flags );\r
 }\r
 \r
@@ -117,7 +117,7 @@ const ForthString *NameToPrevious( const ForthString *NFA )
 /* DBUG(("\nNameToPrevious: RelNamePtr = 0x%x\n", (cell_t) RelNamePtr )); */\r
        if( RelNamePtr )\r
        {\r
 /* DBUG(("\nNameToPrevious: RelNamePtr = 0x%x\n", (cell_t) RelNamePtr )); */\r
        if( RelNamePtr )\r
        {\r
-               return ( NAMEREL_TO_ABS( RelNamePtr ) );\r
+               return ( (ForthString *) NAMEREL_TO_ABS( RelNamePtr ) );\r
        }\r
        else\r
        {\r
        }\r
        else\r
        {\r
@@ -250,6 +250,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
        CreateDicEntryC( ID_FILL, "FILL", 0 );\r
        CreateDicEntryC( ID_FIND, "FIND",  0 );\r
        CreateDicEntryC( ID_FILE_CREATE, "CREATE-FILE",  0 );\r
        CreateDicEntryC( ID_FILL, "FILL", 0 );\r
        CreateDicEntryC( ID_FIND, "FIND",  0 );\r
        CreateDicEntryC( ID_FILE_CREATE, "CREATE-FILE",  0 );\r
+       CreateDicEntryC( ID_FILE_DELETE, "DELETE-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_OPEN, "OPEN-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_CLOSE, "CLOSE-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_READ, "READ-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_OPEN, "OPEN-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_CLOSE, "CLOSE-FILE",  0 );\r
        CreateDicEntryC( ID_FILE_READ, "READ-FILE",  0 );\r
@@ -407,7 +408,7 @@ cell_t ffTokenToName( ExecToken XT, const ForthString **NFAPtr )
        cell_t Result = 0;\r
        ExecToken TempXT;\r
        \r
        cell_t Result = 0;\r
        ExecToken TempXT;\r
        \r
-       NameField = gVarContext;\r
+       NameField = (ForthString *) gVarContext;\r
 DBUGX(("\ffCodeToName: gVarContext = 0x%x\n", gVarContext));\r
 \r
        do\r
 DBUGX(("\ffCodeToName: gVarContext = 0x%x\n", gVarContext));\r
 \r
        do\r
@@ -451,7 +452,7 @@ cell_t ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr )
        WordLen = (uint8_t) ((ucell_t)*WordName & 0x1F);\r
        WordChar = WordName+1;\r
        \r
        WordLen = (uint8_t) ((ucell_t)*WordName & 0x1F);\r
        WordChar = WordName+1;\r
        \r
-       NameField = gVarContext;\r
+       NameField = (ForthString *) gVarContext;\r
 DBUG(("\nffFindNFA: WordLen = %d, WordName = %*s\n", WordLen, WordLen, WordChar ));\r
 DBUG(("\nffFindNFA: gVarContext = 0x%x\n", gVarContext));\r
        do\r
 DBUG(("\nffFindNFA: WordLen = %d, WordName = %*s\n", WordLen, WordLen, WordChar ));\r
 DBUG(("\nffFindNFA: gVarContext = 0x%x\n", gVarContext));\r
        do\r
@@ -512,7 +513,7 @@ DBUG(("ffFind: %8s at 0x%x\n", WordName+1, NFA)); /* WARNING, not NUL terminated
 cell_t ffFindC( const char *WordName, ExecToken *pXT )\r
 {\r
 DBUG(("ffFindC: %s\n", WordName ));\r
 cell_t ffFindC( const char *WordName, ExecToken *pXT )\r
 {\r
 DBUG(("ffFindC: %s\n", WordName ));\r
-       CStringToForth( gScratch, WordName );\r
+       CStringToForth( gScratch, WordName, sizeof(gScratch) );\r
        return ffFind( gScratch, pXT );\r
 }\r
 \r
        return ffFind( gScratch, pXT );\r
 }\r
 \r
@@ -528,16 +529,16 @@ DBUG(("ffFindC: %s\n", WordName ));
 static cell_t ffCheckDicRoom( void )\r
 {\r
        cell_t RoomLeft;\r
 static cell_t ffCheckDicRoom( void )\r
 {\r
        cell_t RoomLeft;\r
-       RoomLeft = gCurrentDictionary->dic_HeaderLimit -\r
-                  gCurrentDictionary->dic_HeaderPtr.Byte;\r
+       RoomLeft = (char *)gCurrentDictionary->dic_HeaderLimit -\r
+                  (char *)gCurrentDictionary->dic_HeaderPtr;\r
        if( RoomLeft < DIC_SAFETY_MARGIN )\r
        {\r
                pfReportError("ffCheckDicRoom", PF_ERR_HEADER_ROOM);\r
                return PF_ERR_HEADER_ROOM;\r
        }\r
 \r
        if( RoomLeft < DIC_SAFETY_MARGIN )\r
        {\r
                pfReportError("ffCheckDicRoom", PF_ERR_HEADER_ROOM);\r
                return PF_ERR_HEADER_ROOM;\r
        }\r
 \r
-       RoomLeft = gCurrentDictionary->dic_CodeLimit -\r
-                  gCurrentDictionary->dic_CodePtr.Byte;\r
+       RoomLeft = (char *)gCurrentDictionary->dic_CodeLimit -\r
+                  (char *)gCurrentDictionary->dic_CodePtr.Byte;\r
        if( RoomLeft < DIC_SAFETY_MARGIN )\r
        {\r
                pfReportError("ffCheckDicRoom", PF_ERR_CODE_ROOM);\r
        if( RoomLeft < DIC_SAFETY_MARGIN )\r
        {\r
                pfReportError("ffCheckDicRoom", PF_ERR_CODE_ROOM);\r
@@ -599,7 +600,7 @@ static cell_t CheckRedefinition( const ForthStringPtr FName )
        if ( flag && !gVarQuiet)\r
        {\r
                ioType( FName+1, (cell_t) *FName );\r
        if ( flag && !gVarQuiet)\r
        {\r
                ioType( FName+1, (cell_t) *FName );\r
-               MSG( " redefined.\n" ); // FIXME - allow user to run off this warning.\r
+               MSG( " redefined.\n" ); /* FIXME - allow user to run off this warning. */\r
        }\r
        return flag;\r
 }\r
        }\r
        return flag;\r
 }\r
@@ -642,7 +643,7 @@ void ffStringDefer( const ForthStringPtr FName, ExecToken DefaultXT )
 static void CreateDeferredC( ExecToken DefaultXT, const char *CName )\r
 {\r
        char FName[40];\r
 static void CreateDeferredC( ExecToken DefaultXT, const char *CName )\r
 {\r
        char FName[40];\r
-       CStringToForth( FName, CName );\r
+       CStringToForth( FName, CName, sizeof(FName) );\r
        ffStringDefer( FName, DefaultXT );\r
 }\r
 #endif\r
        ffStringDefer( FName, DefaultXT );\r
 }\r
 #endif\r
@@ -662,7 +663,7 @@ void ffDefer( void )
 /* Unsmudge the word to make it visible. */\r
 void ffUnSmudge( void )\r
 {\r
 /* Unsmudge the word to make it visible. */\r
 void ffUnSmudge( void )\r
 {\r
-       *gVarContext &= ~FLAG_SMUDGE;\r
+       *(char*)gVarContext &= ~FLAG_SMUDGE;\r
 }\r
 \r
 /* Implement ; */\r
 }\r
 \r
 /* Implement ; */\r
@@ -926,7 +927,7 @@ ThrowCode ffOuterInterpreterLoop( void )
 }\r
 \r
 /***************************************************************\r
 }\r
 \r
 /***************************************************************\r
-** Include a file\r
+** Include then close a file\r
 ***************************************************************/\r
 \r
 ThrowCode ffIncludeFile( FileStream *InputFile )\r
 ***************************************************************/\r
 \r
 ThrowCode ffIncludeFile( FileStream *InputFile )\r
@@ -962,6 +963,9 @@ ThrowCode ffIncludeFile( FileStream *InputFile )
 /* Pop file stream. */\r
        ffPopInputStream();\r
        \r
 /* Pop file stream. */\r
        ffPopInputStream();\r
        \r
+/* ANSI spec specifies that this should also close the file. */\r
+       sdCloseFile(InputFile);\r
+\r
        return exception;\r
 }\r
 \r
        return exception;\r
 }\r
 \r
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.