Add MINGW suport.

[pforth] / csrc / pf_inner.c

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 11c5dce..dc9c719 100644 (file)
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -26,9 +26,11 @@
 **\r
 ***************************************************************/\r
 \r
 **\r
 ***************************************************************/\r
 \r

+#include <sys/types.h>\r
+\r

 #include "pf_all.h"\r
 \r
 #include "pf_all.h"\r
 \r

-#ifdef WIN32\r
+#if defined(WIN32) && !defined(__MINGW32__)\r

 #include <crtdbg.h>\r
 #endif\r
 \r
 #include <crtdbg.h>\r
 #endif\r
 \r


@@ -278,7 +280,7 @@ int pfCatch( ExecToken XT )
        char          *CharPtr;\r
        cell_t        *CellPtr;\r
        FileStream    *FileID;\r
        char          *CharPtr;\r
        cell_t        *CellPtr;\r
        FileStream    *FileID;\r

-       uint8_t         *CodeBase = CODE_BASE;\r
+       uint8_t       *CodeBase = (uint8_t *) CODE_BASE;\r

        ThrowCode      ExceptionReturnCode = 0;\r
        \r
 /* FIXME\r
        ThrowCode      ExceptionReturnCode = 0;\r
        \r
 /* FIXME\r


@@ -962,6 +964,23 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                        }\r
                        endcase;\r
 \r
                        }\r
                        endcase;\r
 \r

+               case ID_FILE_DELETE: /* ( c-addr u -- ior ) */\r
+/* Build NUL terminated name string. */\r
+                       Temp = M_POP;    /* caddr */\r
+                       if( TOS < TIB_SIZE-2 )\r
+                       {\r
+                               pfCopyMemory( gScratch, (char *) Temp, (ucell_t) TOS );\r
+                               gScratch[TOS] = '\0';\r
+                               DBUG(("Delete file = %s\n", gScratch ));\r
+                               TOS = sdDeleteFile( gScratch );\r
+                       }\r
+                       else\r
+                       {\r
+                               ERR("Filename too large for name buffer.\n");\r
+                               TOS = -2;\r
+                       }\r
+                       endcase;\r
+\r

                case ID_FILE_OPEN: /* ( c-addr u fam -- fid ior ) */\r
 /* Build NUL terminated name string. */\r
                        Scratch = M_POP; /* u */\r
                case ID_FILE_OPEN: /* ( c-addr u fam -- fid ior ) */\r
 /* Build NUL terminated name string. */\r
                        Scratch = M_POP; /* u */\r


@@ -1001,11 +1020,18 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                case ID_FILE_SIZE: /* ( fid -- ud ior ) */\r
 /* Determine file size by seeking to end and returning position. */\r
                        FileID = (FileStream *) TOS;\r
                case ID_FILE_SIZE: /* ( fid -- ud ior ) */\r
 /* Determine file size by seeking to end and returning position. */\r
                        FileID = (FileStream *) TOS;\r

-                       Scratch = sdTellFile( FileID );\r
-                       sdSeekFile( FileID, 0, PF_SEEK_END );\r
-                       M_PUSH( sdTellFile( FileID ));\r
-                       sdSeekFile( FileID, Scratch, PF_SEEK_SET );\r
-                       TOS = (Scratch < 0) ? -4 : 0 ; /* !!! err num */\r
+                       {\r
+                               off_t endposition, offsetHi;\r
+                               off_t original = sdTellFile( FileID );\r
+                               sdSeekFile( FileID, 0, PF_SEEK_END );\r
+                               endposition = sdTellFile( FileID );\r
+                               M_PUSH(endposition);\r
+                               /* Just use a 0 if they are the same size. */\r
+                               offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (endposition >> (8*sizeof(cell_t))) : 0 ;\r
+                               M_PUSH(offsetHi);\r
+                               sdSeekFile( FileID, original, PF_SEEK_SET );\r
+                               TOS = (original < 0) ? -4 : 0 ; /* !!! err num */\r
+                       }\r

                        endcase;\r
 \r
                case ID_FILE_WRITE: /* ( addr len fid -- ior ) */\r
                        endcase;\r
 \r
                case ID_FILE_WRITE: /* ( addr len fid -- ior ) */\r


@@ -1016,15 +1042,30 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                        TOS = (Temp != Scratch) ? -3 : 0;\r
                        endcase;\r
 \r
                        TOS = (Temp != Scratch) ? -3 : 0;\r
                        endcase;\r
 \r

-               case ID_FILE_REPOSITION: /* ( pos fid -- ior ) */\r
-                       FileID = (FileStream *) TOS;\r
-                       Scratch = M_POP;\r
-                       TOS = sdSeekFile( FileID, Scratch, PF_SEEK_SET );\r
+               case ID_FILE_REPOSITION: /* ( ud fid -- ior ) */                                \r
+                       {\r
+                               off_t offset;\r
+                               FileID = (FileStream *) TOS;\r
+                               offset = M_POP;\r
+                               /* Avoid compiler warnings on Mac. */\r
+                               offset = (sizeof(off_t) > sizeof(cell_t)) ? (offset << 8*sizeof(cell_t)) : 0 ;\r
+                               offset += M_POP;\r
+                               TOS = sdSeekFile( FileID, offset, PF_SEEK_SET );\r
+                       }\r

                        endcase;\r
 \r
                        endcase;\r
 \r

-               case ID_FILE_POSITION: /* ( pos fid -- ior ) */\r
-                       M_PUSH( sdTellFile( (FileStream *) TOS ));\r
-                       TOS = 0;\r
+               case ID_FILE_POSITION: /* ( fid -- ud ior ) */\r
+                       {\r
+                               off_t position;\r
+                               off_t offsetHi;\r
+                               FileID = (FileStream *) TOS;\r
+                               position = sdTellFile( FileID );\r
+                               M_PUSH(position);\r
+                               /* Just use a 0 if they are the same size. */\r
+                               offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (position >> (8*sizeof(cell_t))) : 0 ;\r
+                               M_PUSH(offsetHi);\r
+                               TOS = (position < 0) ? -4 : 0 ; /* !!! err num */\r
+                       }\r

                        endcase;\r
 \r
                case ID_FILE_RO: /* (  -- fam ) */\r
                        endcase;\r
 \r
                case ID_FILE_RO: /* (  -- fam ) */\r


@@ -1252,9 +1293,8 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                        if( FileID )\r
                        {\r
                                SAVE_REGISTERS;\r
                        if( FileID )\r
                        {\r
                                SAVE_REGISTERS;\r

-                               Scratch = ffIncludeFile( FileID );\r
+                               Scratch = ffIncludeFile( FileID ); /* Also closes the file. */\r

                                LOAD_REGISTERS;\r
                                LOAD_REGISTERS;\r

-                               sdCloseFile( FileID );\r

                                if( Scratch ) M_THROW(Scratch);\r
                        }\r
                        else\r
                                if( Scratch ) M_THROW(Scratch);\r
                        }\r
                        else\r


@@ -1423,11 +1463,11 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                case ID_RESIZE:  /* ( addr1 u -- addr2 result ) */\r
                        {\r
                                cell_t *Addr1 = (cell_t *) M_POP;\r
                case ID_RESIZE:  /* ( addr1 u -- addr2 result ) */\r
                        {\r
                                cell_t *Addr1 = (cell_t *) M_POP;\r

-                               // Point to validator below users address.\r
+                               /* Point to validator below users address. */\r

                                cell_t *FreePtr = Addr1 - 1;\r
                                if( ((ucell_t)*FreePtr) != ((ucell_t)FreePtr ^ PF_MEMORY_VALIDATOR))\r
                                {\r
                                cell_t *FreePtr = Addr1 - 1;\r
                                if( ((ucell_t)*FreePtr) != ((ucell_t)FreePtr ^ PF_MEMORY_VALIDATOR))\r
                                {\r

-                                       // 090218 - Fixed bug, was returning zero.\r
+                                       /* 090218 - Fixed bug, was returning zero. */\r

                                        M_PUSH( Addr1 );\r
                                        TOS = -3;\r
                                }\r
                                        M_PUSH( Addr1 );\r
                                        TOS = -3;\r
                                }\r


@@ -1440,17 +1480,17 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                                                /* Copy memory including validation. */\r
                                                pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell_t) );\r
                                                *CellPtr = (cell_t)(((ucell_t)CellPtr) ^ (ucell_t)PF_MEMORY_VALIDATOR);\r
                                                /* Copy memory including validation. */\r
                                                pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell_t) );\r
                                                *CellPtr = (cell_t)(((ucell_t)CellPtr) ^ (ucell_t)PF_MEMORY_VALIDATOR);\r

-                                               // 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub.\r
-                                               // Increment past validator to user address.\r
+                                               /* 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub. */\r
+                                               /* Increment past validator to user address. */\r

                                    M_PUSH( (cell_t) (CellPtr + 1) );\r
                                    M_PUSH( (cell_t) (CellPtr + 1) );\r

-                                               TOS = 0; // Result code.\r
-                                               // Mark old cell as dead so we can't free it twice.\r
+                                               TOS = 0; /* Result code. */\r
+                                               /* Mark old cell as dead so we can't free it twice. */\r

                                                FreePtr[0] = 0xDeadBeef;\r
                                                pfFreeMem((char *) FreePtr);\r
                                        }\r
                                        else\r
                                        {\r
                                                FreePtr[0] = 0xDeadBeef;\r
                                                pfFreeMem((char *) FreePtr);\r
                                        }\r
                                        else\r
                                        {\r

-                                               // 090218 - Fixed bug, was returning zero.\r
+                                               /* 090218 - Fixed bug, was returning zero. */\r

                                                M_PUSH( Addr1 );\r
                                                TOS = -4;  /* FIXME Fix error code. */\r
                                        }\r
                                                M_PUSH( Addr1 );\r
                                                TOS = -4;  /* FIXME Fix error code. */\r
                                        }\r


@@ -1506,7 +1546,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                                CodeSize = TOS;\r
                                NameSize = M_POP;\r
                                EntryPoint = M_POP;\r
                                CodeSize = TOS;\r
                                NameSize = M_POP;\r
                                EntryPoint = M_POP;\r

-                               ForthStringToC( gScratch, (char *) M_POP );\r
+                               ForthStringToC( gScratch, (char *) M_POP, sizeof(gScratch) );\r

                                TOS =  ffSaveForth( gScratch, EntryPoint, NameSize, CodeSize );\r
                        }\r
                        endcase;\r
                                TOS =  ffSaveForth( gScratch, EntryPoint, NameSize, CodeSize );\r
                        }\r
                        endcase;\r


@@ -1536,7 +1576,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r

-                               WRITE_CELL_DIC(TOS,M_POP);\r
+                               WRITE_CELL_DIC((cell_t *)TOS,M_POP);\r

                        }\r
                        else\r
                        {\r
                        }\r
                        else\r
                        {\r


@@ -1666,7 +1706,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                case ID_VAR_ECHO: DO_VAR(gVarEcho); endcase;\r
                case ID_VAR_HEADERS_BASE: DO_VAR(gCurrentDictionary->dic_HeaderBase); endcase;\r
                case ID_VAR_HEADERS_LIMIT: DO_VAR(gCurrentDictionary->dic_HeaderLimit); endcase;\r
                case ID_VAR_ECHO: DO_VAR(gVarEcho); endcase;\r
                case ID_VAR_HEADERS_BASE: DO_VAR(gCurrentDictionary->dic_HeaderBase); endcase;\r
                case ID_VAR_HEADERS_LIMIT: DO_VAR(gCurrentDictionary->dic_HeaderLimit); endcase;\r

-               case ID_VAR_HEADERS_PTR: DO_VAR(gCurrentDictionary->dic_HeaderPtr.Cell); endcase;\r
+               case ID_VAR_HEADERS_PTR: DO_VAR(gCurrentDictionary->dic_HeaderPtr); endcase;\r

                case ID_VAR_NUM_TIB: DO_VAR(gCurrentTask->td_SourceNum); endcase;\r
                case ID_VAR_OUT: DO_VAR(gCurrentTask->td_OUT); endcase;\r
                case ID_VAR_STATE: DO_VAR(gVarState); endcase;\r
                case ID_VAR_NUM_TIB: DO_VAR(gCurrentTask->td_SourceNum); endcase;\r
                case ID_VAR_OUT: DO_VAR(gCurrentTask->td_OUT); endcase;\r
                case ID_VAR_STATE: DO_VAR(gVarState); endcase;\r


@@ -1684,7 +1724,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r

-                               TOS = (uint16_t) READ_SHORT_DIC((uint8_t *)TOS);\r
+                               TOS = (uint16_t) READ_SHORT_DIC((uint16_t *)TOS);\r

                        }\r
                        else\r
                        {\r
                        }\r
                        else\r
                        {\r


@@ -1700,7 +1740,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r
 #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC))\r
                        if( IN_DICS( TOS ) )\r
                        {\r

-                               WRITE_SHORT_DIC(TOS,M_POP);\r
+                               WRITE_SHORT_DIC((uint16_t *)TOS,(uint16_t)M_POP);\r

                        }\r
                        else\r
                        {\r
                        }\r
                        else\r
                        {\r