X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/b3ad2602f4c6a2236081ed2d913d4e03892182a6..e2531e837774276f6ffb3b284703c594644761f8:/csrc/pfcompil.c

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 025eebf..bc4c585 100644
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -77,8 +77,8 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 	gCurrentDictionary->dic_HeaderPtr += sizeof(cfNameLinks);
 
 /* Laydown name. */
-	gVarContext = (char *) gCurrentDictionary->dic_HeaderPtr;
-	pfCopyMemory( (char *)gCurrentDictionary->dic_HeaderPtr, FName, (*FName)+1 );
+	gVarContext = gCurrentDictionary->dic_HeaderPtr;
+	pfCopyMemory( (uint8_t *) gCurrentDictionary->dic_HeaderPtr, FName, (*FName)+1 );
 	gCurrentDictionary->dic_HeaderPtr += (*FName)+1;
 
 /* Set flags. */
@@ -97,7 +97,7 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags )
 {
 	ForthString FName[40];
-	CStringToForth( FName, CName );
+	CStringToForth( FName, CName, sizeof(FName) );
 	CreateDicEntry( XT, FName, Flags );
 }
 
@@ -117,7 +117,7 @@ const ForthString *NameToPrevious( const ForthString *NFA )
 /* DBUG(("\nNameToPrevious: RelNamePtr = 0x%x\n", (cell_t) RelNamePtr )); */
 	if( RelNamePtr )
 	{
-		return ( NAMEREL_TO_ABS( RelNamePtr ) );
+		return ( (ForthString *) NAMEREL_TO_ABS( RelNamePtr ) );
 	}
 	else
 	{
@@ -250,6 +250,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
 	CreateDicEntryC( ID_FILL, "FILL", 0 );
 	CreateDicEntryC( ID_FIND, "FIND",  0 );
 	CreateDicEntryC( ID_FILE_CREATE, "CREATE-FILE",  0 );
+	CreateDicEntryC( ID_FILE_DELETE, "DELETE-FILE",  0 );
 	CreateDicEntryC( ID_FILE_OPEN, "OPEN-FILE",  0 );
 	CreateDicEntryC( ID_FILE_CLOSE, "CLOSE-FILE",  0 );
 	CreateDicEntryC( ID_FILE_READ, "READ-FILE",  0 );
@@ -407,7 +408,7 @@ cell_t ffTokenToName( ExecToken XT, const ForthString **NFAPtr )
 	cell_t Result = 0;
 	ExecToken TempXT;
 	
-	NameField = gVarContext;
+	NameField = (ForthString *) gVarContext;
 DBUGX(("\ffCodeToName: gVarContext = 0x%x\n", gVarContext));
 
 	do
@@ -451,7 +452,7 @@ cell_t ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr )
 	WordLen = (uint8_t) ((ucell_t)*WordName & 0x1F);
 	WordChar = WordName+1;
 	
-	NameField = gVarContext;
+	NameField = (ForthString *) gVarContext;
 DBUG(("\nffFindNFA: WordLen = %d, WordName = %*s\n", WordLen, WordLen, WordChar ));
 DBUG(("\nffFindNFA: gVarContext = 0x%x\n", gVarContext));
 	do
@@ -512,7 +513,7 @@ DBUG(("ffFind: %8s at 0x%x\n", WordName+1, NFA)); /* WARNING, not NUL terminated
 cell_t ffFindC( const char *WordName, ExecToken *pXT )
 {
 DBUG(("ffFindC: %s\n", WordName ));
-	CStringToForth( gScratch, WordName );
+	CStringToForth( gScratch, WordName, sizeof(gScratch) );
 	return ffFind( gScratch, pXT );
 }
 
@@ -599,7 +600,7 @@ static cell_t CheckRedefinition( const ForthStringPtr FName )
 	if ( flag && !gVarQuiet)
 	{
 		ioType( FName+1, (cell_t) *FName );
-		MSG( " redefined.\n" ); // FIXME - allow user to run off this warning.
+		MSG( " redefined.\n" ); /* FIXME - allow user to run off this warning. */
 	}
 	return flag;
 }
@@ -642,7 +643,7 @@ void ffStringDefer( const ForthStringPtr FName, ExecToken DefaultXT )
 static void CreateDeferredC( ExecToken DefaultXT, const char *CName )
 {
 	char FName[40];
-	CStringToForth( FName, CName );
+	CStringToForth( FName, CName, sizeof(FName) );
 	ffStringDefer( FName, DefaultXT );
 }
 #endif
@@ -926,7 +927,7 @@ ThrowCode ffOuterInterpreterLoop( void )
 }
 
 /***************************************************************
-** Include a file
+** Include then close a file
 ***************************************************************/
 
 ThrowCode ffIncludeFile( FileStream *InputFile )
@@ -962,6 +963,9 @@ ThrowCode ffIncludeFile( FileStream *InputFile )
 /* Pop file stream. */
 	ffPopInputStream();
 	
+/* ANSI spec specifies that this should also close the file. */
+	sdCloseFile(InputFile);
+
 	return exception;
 }