Fix cell increment error in RESIZE
[pforth] / csrc / pf_inner.c
index d7f1239..15f764f 100644 (file)
 ***************************************************************/\r
 \r
 #include "pf_all.h"\r
 ***************************************************************/\r
 \r
 #include "pf_all.h"\r
+\r
+#ifdef WIN32\r
 #include <crtdbg.h>\r
 #include <crtdbg.h>\r
+#endif\r
 \r
 #define SYSTEM_LOAD_FILE "system.fth"\r
 \r
 \r
 #define SYSTEM_LOAD_FILE "system.fth"\r
 \r
@@ -190,10 +193,38 @@ static void TraceNames( ExecToken Token, int32 Level )
 /* Use local copy of CODE_BASE for speed. */\r
 #define LOCAL_CODEREL_TO_ABS( a ) ((cell *) (((int32) a) + CodeBase))\r
 \r
 /* Use local copy of CODE_BASE for speed. */\r
 #define LOCAL_CODEREL_TO_ABS( a ) ((cell *) (((int32) a) + CodeBase))\r
 \r
+static const char *pfSelectFileModeCreate( int fam );\r
+static const char *pfSelectFileModeOpen( int fam );\r
+\r
+/**************************************************************/\r
+static const char *pfSelectFileModeCreate( int fam )\r
+{\r
+       const char *famText = NULL;\r
+       switch( fam )\r
+       {\r
+       case (PF_FAM_WRITE_ONLY + PF_FAM_BINARY_FLAG):\r
+               famText = PF_FAM_BIN_CREATE_WO;\r
+               break;\r
+       case (PF_FAM_READ_WRITE + PF_FAM_BINARY_FLAG):\r
+               famText = PF_FAM_BIN_CREATE_RW;\r
+               break;\r
+       case PF_FAM_WRITE_ONLY:\r
+               famText = PF_FAM_CREATE_WO;\r
+               break;\r
+       case PF_FAM_READ_WRITE:\r
+               famText = PF_FAM_CREATE_RW;\r
+               break;\r
+       default:\r
+               famText = "illegal";\r
+               break;\r
+       }\r
+       return famText;\r
+}\r
+\r
 /**************************************************************/\r
 /**************************************************************/\r
-const char *pfSelectFileMode( int fam )\r
+static const char *pfSelectFileModeOpen( int fam )\r
 {\r
 {\r
-       char *famText = NULL;\r
+       const char *famText = NULL;\r
        switch( fam )\r
        {\r
        case (PF_FAM_READ_ONLY + PF_FAM_BINARY_FLAG):\r
        switch( fam )\r
        {\r
        case (PF_FAM_READ_ONLY + PF_FAM_BINARY_FLAG):\r
@@ -890,10 +921,10 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                        Temp = M_POP;    /* caddr */\r
                        if( Scratch < TIB_SIZE-2 )\r
                        {\r
                        Temp = M_POP;    /* caddr */\r
                        if( Scratch < TIB_SIZE-2 )\r
                        {\r
-                               const char *famText = pfSelectFileMode( TOS );\r
+                               const char *famText = pfSelectFileModeCreate( TOS );\r
                                pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
                                gScratch[Scratch] = '\0';\r
                                pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
                                gScratch[Scratch] = '\0';\r
-                               DBUG(("Create file = %s\n", gScratch ));\r
+                               DBUG(("Create file = %s with famTxt %s\n", gScratch, famText ));\r
                                FileID = sdOpenFile( gScratch, famText );\r
                                TOS = ( FileID == NULL ) ? -1 : 0 ;\r
                                M_PUSH( (cell) FileID );\r
                                FileID = sdOpenFile( gScratch, famText );\r
                                TOS = ( FileID == NULL ) ? -1 : 0 ;\r
                                M_PUSH( (cell) FileID );\r
@@ -912,7 +943,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
                        Temp = M_POP;    /* caddr */\r
                        if( Scratch < TIB_SIZE-2 )\r
                        {\r
                        Temp = M_POP;    /* caddr */\r
                        if( Scratch < TIB_SIZE-2 )\r
                        {\r
-                               const char *famText = pfSelectFileMode( TOS );\r
+                               const char *famText = pfSelectFileModeOpen( TOS );\r
                                pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
                                gScratch[Scratch] = '\0';\r
                                DBUG(("Open file = %s\n", gScratch ));\r
                                pfCopyMemory( gScratch, (char *) Temp, (uint32) Scratch );\r
                                gScratch[Scratch] = '\0';\r
                                DBUG(("Open file = %s\n", gScratch ));\r
@@ -1366,12 +1397,13 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
 /* Resize memory allocated by ALLOCATE. */\r
                case ID_RESIZE:  /* ( addr1 u -- addr2 result ) */\r
                        {\r
 /* Resize memory allocated by ALLOCATE. */\r
                case ID_RESIZE:  /* ( addr1 u -- addr2 result ) */\r
                        {\r
-                               cell *FreePtr;\r
-                               \r
-                               FreePtr = (cell *) ( M_POP - sizeof(cell) );\r
+                               cell *Addr1 = (cell *) M_POP;\r
+                               // Point to validator below users address.\r
+                               cell *FreePtr = Addr1 - 1;\r
                                if( ((uint32)*FreePtr) != ((uint32)FreePtr ^ PF_MEMORY_VALIDATOR))\r
                                {\r
                                if( ((uint32)*FreePtr) != ((uint32)FreePtr ^ PF_MEMORY_VALIDATOR))\r
                                {\r
-                                       M_PUSH( 0 );\r
+                                       // 090218 - Fixed bug, was returning zero.\r
+                                       M_PUSH( Addr1 );\r
                                        TOS = -3;\r
                                }\r
                                else\r
                                        TOS = -3;\r
                                }\r
                                else\r
@@ -1383,15 +1415,18 @@ 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) );\r
                                                *CellPtr = (cell)(((uint32)CellPtr) ^ (uint32)PF_MEMORY_VALIDATOR);\r
                                                /* Copy memory including validation. */\r
                                                pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell) );\r
                                                *CellPtr = (cell)(((uint32)CellPtr) ^ (uint32)PF_MEMORY_VALIDATOR);\r
-                                               CellPtr++;\r
-                                   M_PUSH( (cell) ++CellPtr );\r
-                                               TOS = 0;\r
+                                               // 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub.\r
+                                               // Increment past validator to user address.\r
+                                   M_PUSH( (cell) (CellPtr + 1) );\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
-                                               M_PUSH( 0 );\r
+                                               // 090218 - Fixed bug, was returning zero.\r
+                                               M_PUSH( Addr1 );\r
                                                TOS = -4;  /* FIXME Fix error code. */\r
                                        }\r
                                }\r
                                                TOS = -4;  /* FIXME Fix error code. */\r
                                        }\r
                                }\r