X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/54b27a8713239cf47e1ed2ee7cdb3b14de22e663..90975d261c7ab39186c75d8700261faab3427de7:/csrc/pf_inner.c

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 11c5dce..0149da0 100644
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -278,7 +278,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 +962,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 +1018,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 +1040,28 @@ 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 ) */				
+			{
+				FileID = (FileStream *) TOS;
+				off_t 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 offsetHi;
+				FileID = (FileStream *) TOS;
+				off_t 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 +1289,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
@@ -1536,7 +1572,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 +1702,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 +1720,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 +1736,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
 			{