X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/54b27a8713239cf47e1ed2ee7cdb3b14de22e663..f53726febc36028ff9d524cda6e3ea7b90140c85:/csrc/pf_inner.c diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c index 11c5dce..dc9c719 100644 --- a/csrc/pf_inner.c +++ b/csrc/pf_inner.c @@ -26,9 +26,11 @@ ** ***************************************************************/ +#include + #include "pf_all.h" -#ifdef WIN32 +#if defined(WIN32) && !defined(__MINGW32__) #include #endif @@ -278,7 +280,7 @@ int pfCatch( ExecToken XT ) char *CharPtr; cell_t *CellPtr; FileStream *FileID; - uint8_t *CodeBase = CODE_BASE; + uint8_t *CodeBase = (uint8_t *) CODE_BASE; ThrowCode ExceptionReturnCode = 0; /* FIXME @@ -962,6 +964,23 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql )); } endcase; + case ID_FILE_DELETE: /* ( c-addr u -- ior ) */ +/* Build NUL terminated name string. */ + Temp = M_POP; /* caddr */ + if( TOS < TIB_SIZE-2 ) + { + pfCopyMemory( gScratch, (char *) Temp, (ucell_t) TOS ); + gScratch[TOS] = '\0'; + DBUG(("Delete file = %s\n", gScratch )); + TOS = sdDeleteFile( gScratch ); + } + else + { + ERR("Filename too large for name buffer.\n"); + TOS = -2; + } + endcase; + case ID_FILE_OPEN: /* ( c-addr u fam -- fid ior ) */ /* Build NUL terminated name string. */ Scratch = M_POP; /* u */ @@ -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 ) */ /* Determine file size by seeking to end and returning position. */ FileID = (FileStream *) TOS; - Scratch = sdTellFile( FileID ); - sdSeekFile( FileID, 0, PF_SEEK_END ); - M_PUSH( sdTellFile( FileID )); - sdSeekFile( FileID, Scratch, PF_SEEK_SET ); - TOS = (Scratch < 0) ? -4 : 0 ; /* !!! err num */ + { + off_t endposition, offsetHi; + off_t original = sdTellFile( FileID ); + sdSeekFile( FileID, 0, PF_SEEK_END ); + endposition = sdTellFile( FileID ); + M_PUSH(endposition); + /* Just use a 0 if they are the same size. */ + offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (endposition >> (8*sizeof(cell_t))) : 0 ; + M_PUSH(offsetHi); + sdSeekFile( FileID, original, PF_SEEK_SET ); + TOS = (original < 0) ? -4 : 0 ; /* !!! err num */ + } endcase; case ID_FILE_WRITE: /* ( addr len fid -- ior ) */ @@ -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; endcase; - case ID_FILE_REPOSITION: /* ( pos fid -- ior ) */ - FileID = (FileStream *) TOS; - Scratch = M_POP; - TOS = sdSeekFile( FileID, Scratch, PF_SEEK_SET ); + case ID_FILE_REPOSITION: /* ( ud fid -- ior ) */ + { + off_t offset; + FileID = (FileStream *) TOS; + offset = M_POP; + /* Avoid compiler warnings on Mac. */ + offset = (sizeof(off_t) > sizeof(cell_t)) ? (offset << 8*sizeof(cell_t)) : 0 ; + offset += M_POP; + TOS = sdSeekFile( FileID, offset, PF_SEEK_SET ); + } endcase; - case ID_FILE_POSITION: /* ( pos fid -- ior ) */ - M_PUSH( sdTellFile( (FileStream *) TOS )); - TOS = 0; + case ID_FILE_POSITION: /* ( fid -- ud ior ) */ + { + off_t position; + off_t offsetHi; + FileID = (FileStream *) TOS; + position = sdTellFile( FileID ); + M_PUSH(position); + /* Just use a 0 if they are the same size. */ + offsetHi = (sizeof(off_t) > sizeof(cell_t)) ? (position >> (8*sizeof(cell_t))) : 0 ; + M_PUSH(offsetHi); + TOS = (position < 0) ? -4 : 0 ; /* !!! err num */ + } endcase; case ID_FILE_RO: /* ( -- fam ) */ @@ -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 ) { SAVE_REGISTERS; - Scratch = ffIncludeFile( FileID ); + Scratch = ffIncludeFile( FileID ); /* Also closes the file. */ LOAD_REGISTERS; - sdCloseFile( FileID ); if( Scratch ) M_THROW(Scratch); } else @@ -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 ) */ { cell_t *Addr1 = (cell_t *) M_POP; - // Point to validator below users address. + /* Point to validator below users address. */ cell_t *FreePtr = Addr1 - 1; if( ((ucell_t)*FreePtr) != ((ucell_t)FreePtr ^ PF_MEMORY_VALIDATOR)) { - // 090218 - Fixed bug, was returning zero. + /* 090218 - Fixed bug, was returning zero. */ M_PUSH( Addr1 ); TOS = -3; } @@ -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. */ pfCopyMemory( (char *) CellPtr, (char *) FreePtr, TOS + sizeof(cell_t) ); *CellPtr = (cell_t)(((ucell_t)CellPtr) ^ (ucell_t)PF_MEMORY_VALIDATOR); - // 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub. - // Increment past validator to user address. + /* 090218 - Fixed bug that was incrementing the address twice. Thanks Reinhold Straub. */ + /* Increment past validator to user address. */ M_PUSH( (cell_t) (CellPtr + 1) ); - TOS = 0; // Result code. - // Mark old cell as dead so we can't free it twice. + TOS = 0; /* Result code. */ + /* Mark old cell as dead so we can't free it twice. */ FreePtr[0] = 0xDeadBeef; pfFreeMem((char *) FreePtr); } else { - // 090218 - Fixed bug, was returning zero. + /* 090218 - Fixed bug, was returning zero. */ M_PUSH( Addr1 ); TOS = -4; /* FIXME Fix error code. */ } @@ -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; NameSize = M_POP; EntryPoint = M_POP; - ForthStringToC( gScratch, (char *) M_POP ); + ForthStringToC( gScratch, (char *) M_POP, sizeof(gScratch) ); TOS = ffSaveForth( gScratch, EntryPoint, NameSize, CodeSize ); } endcase; @@ -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)) if( IN_DICS( TOS ) ) { - WRITE_CELL_DIC(TOS,M_POP); + WRITE_CELL_DIC((cell_t *)TOS,M_POP); } else { @@ -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; case ID_VAR_HEADERS_BASE: DO_VAR(gCurrentDictionary->dic_HeaderBase); endcase; case ID_VAR_HEADERS_LIMIT: DO_VAR(gCurrentDictionary->dic_HeaderLimit); endcase; - case ID_VAR_HEADERS_PTR: DO_VAR(gCurrentDictionary->dic_HeaderPtr.Cell); endcase; + case ID_VAR_HEADERS_PTR: DO_VAR(gCurrentDictionary->dic_HeaderPtr); endcase; case ID_VAR_NUM_TIB: DO_VAR(gCurrentTask->td_SourceNum); endcase; case ID_VAR_OUT: DO_VAR(gCurrentTask->td_OUT); endcase; case ID_VAR_STATE: DO_VAR(gVarState); endcase; @@ -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)) if( IN_DICS( TOS ) ) { - TOS = (uint16_t) READ_SHORT_DIC((uint8_t *)TOS); + TOS = (uint16_t) READ_SHORT_DIC((uint16_t *)TOS); } else { @@ -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)) if( IN_DICS( TOS ) ) { - WRITE_SHORT_DIC(TOS,M_POP); + WRITE_SHORT_DIC((uint16_t *)TOS,(uint16_t)M_POP); } else {