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

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 3613b33..bc4c585 100644
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -58,7 +58,7 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 {
 	cfNameLinks *cfnl;
 
-	cfnl = (cfNameLinks *) gCurrentDictionary->dic_HeaderPtr.Byte;
+	cfnl = (cfNameLinks *) gCurrentDictionary->dic_HeaderPtr;
 
 /* Set link to previous header, if any. */
 	if( gVarContext )
@@ -74,20 +74,20 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 	WRITE_CELL_DIC( &cfnl->cfnl_ExecToken, XT );
 
 /* Advance Header Dictionary Pointer */
-	gCurrentDictionary->dic_HeaderPtr.Byte += sizeof(cfNameLinks);
+	gCurrentDictionary->dic_HeaderPtr += sizeof(cfNameLinks);
 
 /* Laydown name. */
-	gVarContext = (char *) gCurrentDictionary->dic_HeaderPtr.Byte;
-	pfCopyMemory( gCurrentDictionary->dic_HeaderPtr.Byte, FName, (*FName)+1 );
-	gCurrentDictionary->dic_HeaderPtr.Byte += (*FName)+1;
+	gVarContext = gCurrentDictionary->dic_HeaderPtr;
+	pfCopyMemory( (uint8_t *) gCurrentDictionary->dic_HeaderPtr, FName, (*FName)+1 );
+	gCurrentDictionary->dic_HeaderPtr += (*FName)+1;
 
 /* Set flags. */
-	*gVarContext |= (char) Flags;
+	*(char*)gVarContext |= (char) Flags;
 	
 /* Align to quad byte boundaries with zeroes. */
-	while( ((ucell_t) gCurrentDictionary->dic_HeaderPtr.Byte) & UINT32_MASK )
+	while( gCurrentDictionary->dic_HeaderPtr & UINT32_MASK )
 	{
-		*gCurrentDictionary->dic_HeaderPtr.Byte++ = 0;
+		*(char*)(gCurrentDictionary->dic_HeaderPtr++) = 0;
 	}
 }
 
@@ -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 );
 }
 
@@ -528,16 +529,16 @@ DBUG(("ffFindC: %s\n", WordName ));
 static cell_t ffCheckDicRoom( void )
 {
 	cell_t RoomLeft;
-	RoomLeft = gCurrentDictionary->dic_HeaderLimit -
-	           gCurrentDictionary->dic_HeaderPtr.Byte;
+	RoomLeft = (char *)gCurrentDictionary->dic_HeaderLimit -
+		   (char *)gCurrentDictionary->dic_HeaderPtr;
 	if( RoomLeft < DIC_SAFETY_MARGIN )
 	{
 		pfReportError("ffCheckDicRoom", PF_ERR_HEADER_ROOM);
 		return PF_ERR_HEADER_ROOM;
 	}
 
-	RoomLeft = gCurrentDictionary->dic_CodeLimit -
-	           gCurrentDictionary->dic_CodePtr.Byte;
+	RoomLeft = (char *)gCurrentDictionary->dic_CodeLimit -
+	           (char *)gCurrentDictionary->dic_CodePtr.Byte;
 	if( RoomLeft < DIC_SAFETY_MARGIN )
 	{
 		pfReportError("ffCheckDicRoom", PF_ERR_CODE_ROOM);
@@ -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
@@ -662,7 +663,7 @@ void ffDefer( void )
 /* Unsmudge the word to make it visible. */
 void ffUnSmudge( void )
 {
-	*gVarContext &= ~FLAG_SMUDGE;
+	*(char*)gVarContext &= ~FLAG_SMUDGE;
 }
 
 /* Implement ; */
@@ -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;
 }