Add support for WATCOMC

[pforth] / csrc / pfcompil.c

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 025eebf..bc4c585 100644 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -77,8 +77,8 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
        gCurrentDictionary->dic_HeaderPtr += sizeof(cfNameLinks);\r
 \r
 /* Laydown name. */\r
        gCurrentDictionary->dic_HeaderPtr += sizeof(cfNameLinks);\r
 \r
 /* Laydown name. */\r

-       gVarContext = (char *) gCurrentDictionary->dic_HeaderPtr;\r
-       pfCopyMemory( (char *)gCurrentDictionary->dic_HeaderPtr, FName, (*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
        gCurrentDictionary->dic_HeaderPtr += (*FName)+1;\r
 \r
 /* Set flags. */\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


@@ -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


@@ -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