Fix REPOSITION-FILE, HISTORY, locked file handle and other problems.

[pforth] / csrc / pfcompil.c

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 3613b33..84546c4 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 = (char *) gCurrentDictionary->dic_HeaderPtr;\r
+       pfCopyMemory( (char *)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


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


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


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