-/* @(#) pf_save.c 98/01/26 1.3 */\r
-/***************************************************************\r
-** Save and Load Dictionary\r
-** for PForth based on 'C'\r
-**\r
-** Compile file based version or static data based version\r
-** depending on PF_NO_FILEIO switch.\r
-**\r
-** Author: Phil Burk\r
-** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom\r
-**\r
-** The pForth software code is dedicated to the public domain,\r
-** and any third party may reproduce, distribute and modify\r
-** the pForth software code or any derivative works thereof\r
-** without any compensation or license. The pForth software\r
-** code is provided on an "as is" basis without any warranty\r
-** of any kind, including, without limitation, the implied\r
-** warranties of merchantability and fitness for a particular\r
-** purpose and their equivalents under the laws of any jurisdiction.\r
-**\r
-****************************************************************\r
-** 940225 PLB Fixed CodePtr save, was using NAMEREL instead of CODEREL\r
-** This would only work if the relative location\r
-** of names and code was the same when saved and reloaded.\r
-** 940228 PLB Added PF_NO_FILEIO version\r
-** 961204 PLB Added PF_STATIC_DIC\r
-** 000623 PLB Cast chars as ucell_t before shifting for 16 bit systems.\r
-***************************************************************/\r
-\r
-#include <assert.h>\r
-\r
-#include "pf_all.h"\r
-\r
-/* If no File I/O, then force static dictionary. */\r
-#ifdef PF_NO_FILEIO\r
- #ifndef PF_STATIC_DIC\r
- #define PF_STATIC_DIC\r
- #endif\r
-#endif\r
-\r
-#ifdef PF_STATIC_DIC\r
- #include "pfdicdat.h"\r
-#endif\r
-\r
-/*\r
-Dictionary File Format based on IFF standard.\r
-The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.\r
-The dictionaries may be big or little endian.\r
- 'FORM'\r
- size\r
- 'P4TH' - Form Identifier\r
-\r
-Chunks\r
- 'P4DI'\r
- size\r
- struct DictionaryInfoChunk\r
-\r
- 'P4NM'\r
- size\r
- Name and Header portion of dictionary. (Big or Little Endian) (Optional)\r
-\r
- 'P4CD'\r
- size\r
- Code portion of dictionary. (Big or Little Endian) \r
-*/\r
-\r
-\r
-/***************************************************************/\r
-/* Endian-ness tools. */\r
-ucell_t ReadCellBigEndian( const uint8_t *addr )\r
-{\r
- ucell_t temp = (ucell_t)addr[0];\r
- temp = (temp << 8) | ((ucell_t)addr[1]);\r
- temp = (temp << 8) | ((ucell_t)addr[2]);\r
- temp = (temp << 8) | ((ucell_t)addr[3]);\r
- if( sizeof(ucell_t) == 8 )\r
- {\r
- temp = (temp << 8) | ((ucell_t)addr[4]);\r
- temp = (temp << 8) | ((ucell_t)addr[5]);\r
- temp = (temp << 8) | ((ucell_t)addr[6]);\r
- temp = (temp << 8) | ((ucell_t)addr[7]);\r
- }\r
- \r
- return temp;\r
-}\r
-/***************************************************************/\r
-/* Endian-ness tools. */\r
-uint32_t Read32BigEndian( const uint8_t *addr )\r
-{\r
- uint32_t temp = (uint32_t)addr[0];\r
- temp = (temp << 8) | ((uint32_t)addr[1]);\r
- temp = (temp << 8) | ((uint32_t)addr[2]);\r
- temp = (temp << 8) | ((uint32_t)addr[3]);\r
- return temp;\r
-}\r
-\r
-/***************************************************************/\r
-uint16_t Read16BigEndian( const uint8_t *addr )\r
-{\r
- return (uint16_t) ((addr[0]<<8) | addr[1]);\r
-}\r
-\r
-/***************************************************************/\r
-ucell_t ReadCellLittleEndian( const uint8_t *addr )\r
-{\r
- ucell_t temp = 0;\r
- if( sizeof(ucell_t) == 8 )\r
- {\r
- temp = (temp << 8) | ((uint32_t)addr[7]);\r
- temp = (temp << 8) | ((uint32_t)addr[6]);\r
- temp = (temp << 8) | ((uint32_t)addr[5]);\r
- temp = (temp << 8) | ((uint32_t)addr[4]);\r
- }\r
- temp = (temp << 8) | ((uint32_t)addr[3]);\r
- temp = (temp << 8) | ((uint32_t)addr[2]);\r
- temp = (temp << 8) | ((uint32_t)addr[1]);\r
- temp = (temp << 8) | ((uint32_t)addr[0]);\r
- return temp;\r
-}\r
-\r
-/***************************************************************/\r
-uint32_t Read32LittleEndian( const uint8_t *addr )\r
-{\r
- uint32_t temp = (uint32_t)addr[3];\r
- temp = (temp << 8) | ((uint32_t)addr[2]);\r
- temp = (temp << 8) | ((uint32_t)addr[1]);\r
- temp = (temp << 8) | ((uint32_t)addr[0]);\r
- return temp;\r
-}\r
-\r
-/***************************************************************/\r
-uint16_t Read16LittleEndian( const uint8_t *addr )\r
-{\r
- const unsigned char *bp = (const unsigned char *) addr;\r
- return (uint16_t) ((bp[1]<<8) | bp[0]);\r
-}\r
-\r
-#ifdef PF_SUPPORT_FP\r
-\r
-/***************************************************************/\r
-static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );\r
-\r
-static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst )\r
-{\r
- int i;\r
- unsigned char *d = (unsigned char *) dst;\r
- const unsigned char *s = (const unsigned char *) src;\r
-\r
- for( i=0; i<sizeof(PF_FLOAT); i++ )\r
- {\r
- d[i] = s[sizeof(PF_FLOAT) - 1 - i];\r
- }\r
-}\r
-\r
-/***************************************************************/\r
-void WriteFloatBigEndian( PF_FLOAT *addr, PF_FLOAT data )\r
-{\r
- if( IsHostLittleEndian() )\r
- {\r
- ReverseCopyFloat( &data, addr );\r
- }\r
- else\r
- {\r
- *addr = data;\r
- }\r
-}\r
-\r
-/***************************************************************/\r
-PF_FLOAT ReadFloatBigEndian( const PF_FLOAT *addr )\r
-{\r
- PF_FLOAT data;\r
- if( IsHostLittleEndian() )\r
- {\r
- ReverseCopyFloat( addr, &data );\r
- return data;\r
- }\r
- else\r
- {\r
- return *addr;\r
- }\r
-}\r
-\r
-/***************************************************************/\r
-void WriteFloatLittleEndian( PF_FLOAT *addr, PF_FLOAT data )\r
-{\r
- if( IsHostLittleEndian() )\r
- {\r
- *addr = data;\r
- }\r
- else\r
- {\r
- ReverseCopyFloat( &data, addr );\r
- }\r
-}\r
-\r
-/***************************************************************/\r
-PF_FLOAT ReadFloatLittleEndian( const PF_FLOAT *addr )\r
-{\r
- PF_FLOAT data;\r
- if( IsHostLittleEndian() )\r
- {\r
- return *addr;\r
- }\r
- else\r
- {\r
- ReverseCopyFloat( addr, &data );\r
- return data;\r
- }\r
-}\r
-\r
-#endif /* PF_SUPPORT_FP */\r
-\r
-/***************************************************************/\r
-void WriteCellBigEndian( uint8_t *addr, ucell_t data )\r
-{\r
- // Write should be in order of increasing address\r
- // to optimize for burst writes to DRAM.\r
- if( sizeof(ucell_t) == 8 )\r
- {\r
- *addr++ = (uint8_t) (data>>56);\r
- *addr++ = (uint8_t) (data>>48);\r
- *addr++ = (uint8_t) (data>>40);\r
- *addr++ = (uint8_t) (data>>32);\r
- }\r
- *addr++ = (uint8_t) (data>>24);\r
- *addr++ = (uint8_t) (data>>16);\r
- *addr++ = (uint8_t) (data>>8);\r
- *addr = (uint8_t) (data);\r
-}\r
-\r
-/***************************************************************/\r
-void Write32BigEndian( uint8_t *addr, uint32_t data )\r
-{\r
- *addr++ = (uint8_t) (data>>24);\r
- *addr++ = (uint8_t) (data>>16);\r
- *addr++ = (uint8_t) (data>>8);\r
- *addr = (uint8_t) (data);\r
-}\r
-\r
-/***************************************************************/\r
-void Write16BigEndian( uint8_t *addr, uint16_t data )\r
-{\r
- *addr++ = (uint8_t) (data>>8);\r
- *addr = (uint8_t) (data);\r
-}\r
-\r
-/***************************************************************/\r
-void WriteCellLittleEndian( uint8_t *addr, ucell_t data )\r
-{\r
- // Write should be in order of increasing address\r
- // to optimize for burst writes to DRAM.\r
- if( sizeof(ucell_t) == 8 )\r
- {\r
- *addr++ = (uint8_t) data; // LSB at near end\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- }\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr = (uint8_t) data;\r
-}\r
-/***************************************************************/\r
-void Write32LittleEndian( uint8_t *addr, uint32_t data )\r
-{\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr = (uint8_t) data;\r
-}\r
-\r
-/***************************************************************/\r
-void Write16LittleEndian( uint8_t *addr, uint16_t data )\r
-{\r
- *addr++ = (uint8_t) data;\r
- data = data >> 8;\r
- *addr = (uint8_t) data;\r
-}\r
-\r
-/***************************************************************/\r
-/* Return 1 if host CPU is Little Endian */\r
-int IsHostLittleEndian( void )\r
-{\r
- static int gEndianCheck = 1;\r
- unsigned char *bp = (unsigned char *) &gEndianCheck;\r
- return (int) (*bp); /* Return byte pointed to by address. If LSB then == 1 */\r
-}\r
-\r
-#if defined(PF_NO_FILEIO) || defined(PF_NO_SHELL)\r
-\r
-cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
-{\r
- TOUCH(FileName);\r
- TOUCH(EntryPoint);\r
- TOUCH(NameSize);\r
- TOUCH(CodeSize);\r
-\r
- pfReportError("ffSaveForth", PF_ERR_NOT_SUPPORTED);\r
- return -1;\r
-}\r
-\r
-#else /* PF_NO_FILEIO or PF_NO_SHELL */\r
-\r
-/***************************************************************/\r
-static int Write32ToFile( FileStream *fid, uint32_t Val )\r
-{\r
- int numw;\r
- uint8_t pad[4];\r
-\r
- Write32BigEndian(pad,Val);\r
- numw = sdWriteFile( pad, 1, sizeof(pad), fid );\r
- if( numw != sizeof(pad) ) return -1;\r
- return 0;\r
-}\r
-\r
-/***************************************************************/\r
-static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t NumBytes )\r
-{\r
- cell_t numw;\r
- cell_t EvenNumW;\r
-\r
- EvenNumW = EVENUP(NumBytes);\r
-\r
- if( Write32ToFile( fid, ID ) < 0 ) goto error;\r
- if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error;\r
-\r
- numw = sdWriteFile( Data, 1, EvenNumW, fid );\r
- if( numw != EvenNumW ) goto error;\r
- return 0;\r
-error:\r
- pfReportError("WriteChunkToFile", PF_ERR_WRITE_FILE);\r
- return -1;\r
-}\r
-\r
-/****************************************************************\r
-** Save Dictionary in File.\r
-** If EntryPoint is NULL, save as development environment.\r
-** If EntryPoint is non-NULL, save as turnKey environment with no names.\r
-*/\r
-cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
-{\r
- FileStream *fid;\r
- DictionaryInfoChunk SD;\r
- uint32_t FormSize;\r
- uint32_t NameChunkSize = 0;\r
- uint32_t CodeChunkSize;\r
- uint32_t relativeCodePtr;\r
- int i;\r
-\r
- fid = sdOpenFile( FileName, "wb" );\r
- if( fid == NULL )\r
- {\r
- pfReportError("pfSaveDictionary", PF_ERR_OPEN_FILE);\r
- return -1;\r
- }\r
-\r
-/* Save in uninitialized form. */\r
- pfExecIfDefined("AUTO.TERM");\r
-\r
-/* Write FORM Header ---------------------------- */\r
- if( Write32ToFile( fid, ID_FORM ) < 0 ) goto error;\r
- if( Write32ToFile( fid, 0 ) < 0 ) goto error;\r
- if( Write32ToFile( fid, ID_P4TH ) < 0 ) goto error;\r
-\r
-/* Write P4DI Dictionary Info ------------------ */\r
- SD.sd_Version = PF_FILE_VERSION;\r
-\r
- relativeCodePtr = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */\r
- SD.sd_RelCodePtr = relativeCodePtr; \r
- SD.sd_UserStackSize = sizeof(cell_t) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);\r
- SD.sd_ReturnStackSize = sizeof(cell_t) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);\r
- SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */\r
-\r
-#ifdef PF_SUPPORT_FP\r
- SD.sd_FloatSize = sizeof(PF_FLOAT); /* Must match compiled dictionary. */\r
-#else\r
- SD.sd_FloatSize = 0;\r
-#endif\r
-\r
- SD.sd_CellSize = sizeof(cell_t);\r
-\r
-/* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */\r
- {\r
-#if defined(PF_BIG_ENDIAN_DIC)\r
- int eflag = SD_F_BIG_ENDIAN_DIC;\r
-#elif defined(PF_LITTLE_ENDIAN_DIC)\r
- int eflag = 0;\r
-#else\r
- int eflag = IsHostLittleEndian() ? 0 : SD_F_BIG_ENDIAN_DIC;\r
-#endif\r
- SD.sd_Flags = eflag;\r
- }\r
-\r
- if( EntryPoint )\r
- {\r
- SD.sd_EntryPoint = EntryPoint; /* Turnkey! */\r
- }\r
- else\r
- {\r
- SD.sd_EntryPoint = 0;\r
- }\r
-\r
-/* Do we save names? */\r
- if( NameSize == 0 )\r
- {\r
- SD.sd_RelContext = 0;\r
- SD.sd_RelHeaderPtr = 0;\r
- SD.sd_NameSize = 0;\r
- }\r
- else\r
- {\r
- uint32_t relativeHeaderPtr;\r
-/* Development mode. */\r
- SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);\r
- relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr.Byte);\r
- SD.sd_RelHeaderPtr = relativeHeaderPtr;\r
-\r
-/* How much real name space is there? */\r
- NameChunkSize = QUADUP(relativeHeaderPtr); /* Align */\r
-\r
-/* NameSize must be 0 or greater than NameChunkSize + 1K */\r
- NameSize = QUADUP(NameSize); /* Align */\r
- if( NameSize > 0 )\r
- {\r
- NameSize = MAX( NameSize, (NameChunkSize + 1024) );\r
- }\r
- SD.sd_NameSize = NameSize;\r
- }\r
-\r
-/* How much real code is there? */\r
- CodeChunkSize = QUADUP(relativeCodePtr);\r
- CodeSize = QUADUP(CodeSize); /* Align */\r
- CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );\r
- SD.sd_CodeSize = CodeSize;\r
-\r
- \r
-/* Convert all fields in DictionaryInfoChunk from Native to BigEndian. \r
- * This assumes they are all 32-bit integers.\r
- */\r
- {\r
- uint32_t *p = (uint32_t *) &SD;\r
- for( i=0; i<((int)(sizeof(SD)/sizeof(uint32_t))); i++ )\r
- {\r
- Write32BigEndian( (uint8_t *)&p[i], p[i] );\r
- }\r
- }\r
-\r
- if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
-\r
-/* Write Name Fields if NameSize non-zero ------- */\r
- if( NameSize > 0 )\r
- {\r
- if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,\r
- NameChunkSize ) < 0 ) goto error;\r
- }\r
-\r
-/* Write Code Fields ---------------------------- */\r
- if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,\r
- CodeChunkSize ) < 0 ) goto error;\r
-\r
- FormSize = sdTellFile( fid ) - 8;\r
- sdSeekFile( fid, 4, PF_SEEK_SET );\r
- if( Write32ToFile( fid, FormSize ) < 0 ) goto error;\r
-\r
- sdCloseFile( fid );\r
-\r
-/* Restore initialization. */\r
- pfExecIfDefined("AUTO.INIT");\r
- return 0;\r
-\r
-error:\r
- sdSeekFile( fid, 0, PF_SEEK_SET );\r
- Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */\r
- sdCloseFile( fid );\r
-\r
-/* Restore initialization. */\r
- pfExecIfDefined("AUTO.INIT");\r
-\r
- return -1;\r
-}\r
-\r
-#endif /* !PF_NO_FILEIO and !PF_NO_SHELL */\r
-\r
-\r
-#ifndef PF_NO_FILEIO\r
-\r
-/***************************************************************/\r
-static uint32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )\r
-{\r
- int32_t numr;\r
- uint8_t pad[4];\r
- numr = sdReadFile( pad, 1, sizeof(pad), fid );\r
- if( numr != sizeof(pad) ) return -1;\r
- *ValPtr = Read32BigEndian( pad );\r
- return 0;\r
-}\r
-\r
-/***************************************************************/\r
-PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
-{\r
- pfDictionary_t *dic = NULL;\r
- FileStream *fid;\r
- DictionaryInfoChunk *sd;\r
- uint32_t ChunkID;\r
- uint32_t ChunkSize;\r
- uint32_t FormSize;\r
- uint32_t BytesLeft;\r
- uint32_t numr;\r
- int i;\r
- int isDicBigEndian;\r
-\r
-DBUG(("pfLoadDictionary( %s )\n", FileName ));\r
-\r
-/* Open file. */\r
- fid = sdOpenFile( FileName, "rb" );\r
- if( fid == NULL )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_OPEN_FILE);\r
- goto xt_error;\r
- }\r
-\r
-/* Read FORM, Size, ID */\r
- if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
- if( ChunkID != ID_FORM )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);\r
- goto error;\r
- }\r
-\r
- if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;\r
- BytesLeft = FormSize;\r
-\r
- if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
- BytesLeft -= 4;\r
- if( ChunkID != ID_P4TH )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE);\r
- goto error;\r
- }\r
-\r
-/* Scan and parse all chunks in file. */\r
- while( BytesLeft > 0 )\r
- {\r
- if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
- if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;\r
- BytesLeft -= 8;\r
-\r
- DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));\r
-\r
- switch( ChunkID )\r
- {\r
- case ID_P4DI:\r
- sd = (DictionaryInfoChunk *) pfAllocMem( ChunkSize );\r
- if( sd == NULL ) goto nomem_error;\r
-\r
- numr = sdReadFile( sd, 1, ChunkSize, fid );\r
- if( numr != ChunkSize ) goto read_error;\r
- BytesLeft -= ChunkSize;\r
- \r
-/* Convert all fields in structure from BigEndian to Native. */\r
- {\r
- uint32_t *p = (uint32_t *) sd;\r
- for( i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++ )\r
- {\r
- p[i] = Read32BigEndian( (uint8_t *)&p[i] );\r
- }\r
- }\r
- \r
- isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;\r
-\r
- if( !gVarQuiet )\r
- {\r
- MSG("pForth loading dictionary from file "); MSG(FileName);\r
- EMIT_CR;\r
- MSG_NUM_D(" File format version is ", sd->sd_Version );\r
- MSG_NUM_D(" Name space size = ", sd->sd_NameSize );\r
- MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );\r
- MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );\r
- MSG_NUM_D(" Cell Size = ", sd->sd_CellSize );\r
- MSG( (isDicBigEndian ? " Big Endian Dictionary" :\r
- " Little Endian Dictionary") );\r
- if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");\r
- EMIT_CR;\r
- }\r
-\r
- if( sd->sd_Version > PF_FILE_VERSION )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_VERSION_FUTURE );\r
- goto error;\r
- }\r
- if( sd->sd_Version < PF_EARLIEST_FILE_VERSION )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );\r
- goto error;\r
- }\r
- if( sd->sd_CellSize != sizeof(cell_t) )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_CELL_SIZE_CONFLICT );\r
- goto error;\r
- }\r
- if( sd->sd_NumPrimitives > NUM_PRIMITIVES )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );\r
- goto error;\r
- }\r
-\r
-/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
-#if defined(PF_BIG_ENDIAN_DIC)\r
- if(isDicBigEndian == 0)\r
-#elif defined(PF_LITTLE_ENDIAN_DIC)\r
- if(isDicBigEndian == 1)\r
-#else\r
- if( isDicBigEndian == IsHostLittleEndian() )\r
-#endif\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );\r
- goto error;\r
- }\r
-\r
-/* Check for compatible float size. */\r
-#ifdef PF_SUPPORT_FP\r
- if( sd->sd_FloatSize != sizeof(PF_FLOAT) )\r
-#else\r
- if( sd->sd_FloatSize != 0 )\r
-#endif\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_FLOAT_CONFLICT );\r
- goto error;\r
- }\r
-\r
- dic = pfCreateDictionary( sd->sd_NameSize, sd->sd_CodeSize );\r
- if( dic == NULL ) goto nomem_error;\r
- gCurrentDictionary = dic;\r
- if( sd->sd_NameSize > 0 )\r
- {\r
- gVarContext = (char *) NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */\r
- gCurrentDictionary->dic_HeaderPtr.Byte = (uint8_t *)\r
- NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);\r
- }\r
- else\r
- {\r
- gVarContext = 0;\r
- gCurrentDictionary->dic_HeaderPtr.Byte = NULL;\r
- }\r
- gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
- gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */\r
-/* Pass EntryPoint back to caller. */\r
- if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;\r
- pfFreeMem(sd);\r
- break;\r
-\r
- case ID_P4NM:\r
-#ifdef PF_NO_SHELL\r
- pfReportError("pfLoadDictionary", PF_ERR_NO_SHELL );\r
- goto error;\r
-#else\r
- if( NAME_BASE == NULL )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_NO_NAMES );\r
- goto error;\r
- }\r
- if( gCurrentDictionary == NULL )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
- goto error;\r
- }\r
- if( ChunkSize > NAME_SIZE )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
- goto error;\r
- }\r
- numr = sdReadFile( NAME_BASE, 1, ChunkSize, fid );\r
- if( numr != ChunkSize ) goto read_error;\r
- BytesLeft -= ChunkSize;\r
-#endif /* PF_NO_SHELL */\r
- break;\r
-\r
- case ID_P4CD:\r
- if( gCurrentDictionary == NULL )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
- goto error;\r
- }\r
- if( ChunkSize > CODE_SIZE )\r
- {\r
- pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
- goto error;\r
- }\r
- numr = sdReadFile( CODE_BASE, 1, ChunkSize, fid );\r
- if( numr != ChunkSize ) goto read_error;\r
- BytesLeft -= ChunkSize;\r
- break;\r
-\r
- default:\r
- pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
- sdSeekFile( fid, ChunkSize, PF_SEEK_CUR );\r
- break;\r
- }\r
- }\r
-\r
- sdCloseFile( fid );\r
-\r
- if( NAME_BASE != NULL)\r
- {\r
- cell_t Result;\r
-/* Find special words in dictionary for global XTs. */\r
- if( (Result = FindSpecialXTs()) < 0 )\r
- {\r
- pfReportError("pfLoadDictionary: FindSpecialXTs", Result);\r
- goto error;\r
- }\r
- }\r
-\r
-DBUG(("pfLoadDictionary: return %p\n", dic));\r
- return (PForthDictionary) dic;\r
-\r
-nomem_error:\r
- pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);\r
- sdCloseFile( fid );\r
- return NULL;\r
-\r
-read_error:\r
- pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);\r
-error:\r
- sdCloseFile( fid );\r
-xt_error:\r
- return NULL;\r
-}\r
-\r
-#else\r
-\r
-PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
-{\r
- (void) FileName;\r
- (void) EntryPointPtr;\r
- return NULL;\r
-}\r
-#endif /* !PF_NO_FILEIO */\r
-\r
-\r
-\r
-/***************************************************************/\r
-PForthDictionary pfLoadStaticDictionary( void )\r
-{\r
-#ifdef PF_STATIC_DIC\r
- cell_t Result;\r
- pfDictionary_t *dic;\r
- cell_t NewNameSize, NewCodeSize;\r
- \r
- if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
- {\r
- MSG( (IF_LITTLE_ENDIAN ?\r
- "Little Endian Dictionary on " :\r
- "Big Endian Dictionary on ") );\r
- MSG( (IsHostLittleEndian() ?\r
- "Little Endian CPU" :\r
- "Big Endian CPU") );\r
- EMIT_CR;\r
- }\r
- \r
-/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
-#if defined(PF_BIG_ENDIAN_DIC)\r
- if(IF_LITTLE_ENDIAN == 1)\r
-#elif defined(PF_LITTLE_ENDIAN_DIC)\r
- if(IF_LITTLE_ENDIAN == 0)\r
-#else /* Code is native endian! */\r
- if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
-#endif\r
- {\r
- pfReportError("pfLoadStaticDictionary", PF_ERR_ENDIAN_CONFLICT );\r
- goto error;\r
- }\r
-\r
-\r
-#ifndef PF_EXTRA_HEADERS\r
- #define PF_EXTRA_HEADERS (20000)\r
-#endif\r
-#ifndef PF_EXTRA_CODE\r
- #define PF_EXTRA_CODE (40000)\r
-#endif\r
-\r
-/* Copy static const data to allocated dictionaries. */\r
- NewNameSize = sizeof(MinDicNames) + PF_EXTRA_HEADERS;\r
- NewCodeSize = sizeof(MinDicCode) + PF_EXTRA_CODE;\r
-\r
- DBUG_NUM_D( "static dic name size = ", NewNameSize );\r
- DBUG_NUM_D( "static dic code size = ", NewCodeSize );\r
- \r
- gCurrentDictionary = dic = pfCreateDictionary( NewNameSize, NewCodeSize );\r
- if( !dic ) goto nomem_error;\r
-\r
- pfCopyMemory( dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );\r
- pfCopyMemory( dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );\r
- DBUG(("Static data copied to newly allocated dictionaries.\n"));\r
-\r
- dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);\r
- gNumPrimitives = NUM_PRIMITIVES;\r
-\r
- if( NAME_BASE != NULL)\r
- {\r
-/* Setup name space. */\r
- dic->dic_HeaderPtr.Byte = (uint8_t *) NAMEREL_TO_ABS(HEADERPTR);\r
- gVarContext = (char *) NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */\r
-\r
-/* Find special words in dictionary for global XTs. */\r
- if( (Result = FindSpecialXTs()) < 0 )\r
- {\r
- pfReportError("pfLoadStaticDictionary: FindSpecialXTs", Result);\r
- goto error;\r
- }\r
- }\r
-\r
- return (PForthDictionary) dic;\r
-\r
-error:\r
- return NULL;\r
-\r
-nomem_error:\r
- pfReportError("pfLoadStaticDictionary", PF_ERR_NO_MEM);\r
-#endif /* PF_STATIC_DIC */\r
-\r
- return NULL;\r
-}\r
-\r
+/* @(#) pf_save.c 98/01/26 1.3 */
+/***************************************************************
+** Save and Load Dictionary
+** for PForth based on 'C'
+**
+** Compile file based version or static data based version
+** depending on PF_NO_FILEIO switch.
+**
+** Author: Phil Burk
+** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
+**
+** The pForth software code is dedicated to the public domain,
+** and any third party may reproduce, distribute and modify
+** the pForth software code or any derivative works thereof
+** without any compensation or license. The pForth software
+** code is provided on an "as is" basis without any warranty
+** of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular
+** purpose and their equivalents under the laws of any jurisdiction.
+**
+****************************************************************
+** 940225 PLB Fixed CodePtr save, was using NAMEREL instead of CODEREL
+** This would only work if the relative location
+** of names and code was the same when saved and reloaded.
+** 940228 PLB Added PF_NO_FILEIO version
+** 961204 PLB Added PF_STATIC_DIC
+** 000623 PLB Cast chars as ucell_t before shifting for 16 bit systems.
+***************************************************************/
+
+#include <assert.h>
+
+#include "pf_all.h"
+
+/* If no File I/O, then force static dictionary. */
+#ifdef PF_NO_FILEIO
+ #ifndef PF_STATIC_DIC
+ #define PF_STATIC_DIC
+ #endif
+#endif
+
+#ifdef PF_STATIC_DIC
+ #include "pfdicdat.h"
+#endif
+
+/*
+Dictionary File Format based on IFF standard.
+The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.
+The dictionaries may be big or little endian.
+ 'FORM'
+ size
+ 'P4TH' - Form Identifier
+
+Chunks
+ 'P4DI'
+ size
+ struct DictionaryInfoChunk
+
+ 'P4NM'
+ size
+ Name and Header portion of dictionary. (Big or Little Endian) (Optional)
+
+ 'P4CD'
+ size
+ Code portion of dictionary. (Big or Little Endian)
+*/
+
+
+/***************************************************************/
+/* Endian-ness tools. */
+ucell_t ReadCellBigEndian( const uint8_t *addr )
+{
+ ucell_t temp = (ucell_t)addr[0];
+ temp = (temp << 8) | ((ucell_t)addr[1]);
+ temp = (temp << 8) | ((ucell_t)addr[2]);
+ temp = (temp << 8) | ((ucell_t)addr[3]);
+ if( sizeof(ucell_t) == 8 )
+ {
+ temp = (temp << 8) | ((ucell_t)addr[4]);
+ temp = (temp << 8) | ((ucell_t)addr[5]);
+ temp = (temp << 8) | ((ucell_t)addr[6]);
+ temp = (temp << 8) | ((ucell_t)addr[7]);
+ }
+
+ return temp;
+}
+/***************************************************************/
+/* Endian-ness tools. */
+uint32_t Read32BigEndian( const uint8_t *addr )
+{
+ uint32_t temp = (uint32_t)addr[0];
+ temp = (temp << 8) | ((uint32_t)addr[1]);
+ temp = (temp << 8) | ((uint32_t)addr[2]);
+ temp = (temp << 8) | ((uint32_t)addr[3]);
+ return temp;
+}
+
+/***************************************************************/
+uint16_t Read16BigEndian( const uint8_t *addr )
+{
+ return (uint16_t) ((addr[0]<<8) | addr[1]);
+}
+
+/***************************************************************/
+ucell_t ReadCellLittleEndian( const uint8_t *addr )
+{
+ ucell_t temp = 0;
+ if( sizeof(ucell_t) == 8 )
+ {
+ temp = (temp << 8) | ((uint32_t)addr[7]);
+ temp = (temp << 8) | ((uint32_t)addr[6]);
+ temp = (temp << 8) | ((uint32_t)addr[5]);
+ temp = (temp << 8) | ((uint32_t)addr[4]);
+ }
+ temp = (temp << 8) | ((uint32_t)addr[3]);
+ temp = (temp << 8) | ((uint32_t)addr[2]);
+ temp = (temp << 8) | ((uint32_t)addr[1]);
+ temp = (temp << 8) | ((uint32_t)addr[0]);
+ return temp;
+}
+
+/***************************************************************/
+uint32_t Read32LittleEndian( const uint8_t *addr )
+{
+ uint32_t temp = (uint32_t)addr[3];
+ temp = (temp << 8) | ((uint32_t)addr[2]);
+ temp = (temp << 8) | ((uint32_t)addr[1]);
+ temp = (temp << 8) | ((uint32_t)addr[0]);
+ return temp;
+}
+
+/***************************************************************/
+uint16_t Read16LittleEndian( const uint8_t *addr )
+{
+ const unsigned char *bp = (const unsigned char *) addr;
+ return (uint16_t) ((bp[1]<<8) | bp[0]);
+}
+
+#ifdef PF_SUPPORT_FP
+
+/***************************************************************/
+static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );
+
+static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst )
+{
+ int i;
+ unsigned char *d = (unsigned char *) dst;
+ const unsigned char *s = (const unsigned char *) src;
+
+ for( i=0; i<sizeof(PF_FLOAT); i++ )
+ {
+ d[i] = s[sizeof(PF_FLOAT) - 1 - i];
+ }
+}
+
+/***************************************************************/
+void WriteFloatBigEndian( PF_FLOAT *addr, PF_FLOAT data )
+{
+ if( IsHostLittleEndian() )
+ {
+ ReverseCopyFloat( &data, addr );
+ }
+ else
+ {
+ *addr = data;
+ }
+}
+
+/***************************************************************/
+PF_FLOAT ReadFloatBigEndian( const PF_FLOAT *addr )
+{
+ PF_FLOAT data;
+ if( IsHostLittleEndian() )
+ {
+ ReverseCopyFloat( addr, &data );
+ return data;
+ }
+ else
+ {
+ return *addr;
+ }
+}
+
+/***************************************************************/
+void WriteFloatLittleEndian( PF_FLOAT *addr, PF_FLOAT data )
+{
+ if( IsHostLittleEndian() )
+ {
+ *addr = data;
+ }
+ else
+ {
+ ReverseCopyFloat( &data, addr );
+ }
+}
+
+/***************************************************************/
+PF_FLOAT ReadFloatLittleEndian( const PF_FLOAT *addr )
+{
+ PF_FLOAT data;
+ if( IsHostLittleEndian() )
+ {
+ return *addr;
+ }
+ else
+ {
+ ReverseCopyFloat( addr, &data );
+ return data;
+ }
+}
+
+#endif /* PF_SUPPORT_FP */
+
+/***************************************************************/
+void WriteCellBigEndian( uint8_t *addr, ucell_t data )
+{
+ /* Write should be in order of increasing address
+ * to optimize for burst writes to DRAM. */
+ if( sizeof(ucell_t) == 8 )
+ {
+ *addr++ = (uint8_t) (data>>56);
+ *addr++ = (uint8_t) (data>>48);
+ *addr++ = (uint8_t) (data>>40);
+ *addr++ = (uint8_t) (data>>32);
+ }
+ *addr++ = (uint8_t) (data>>24);
+ *addr++ = (uint8_t) (data>>16);
+ *addr++ = (uint8_t) (data>>8);
+ *addr = (uint8_t) (data);
+}
+
+/***************************************************************/
+void Write32BigEndian( uint8_t *addr, uint32_t data )
+{
+ *addr++ = (uint8_t) (data>>24);
+ *addr++ = (uint8_t) (data>>16);
+ *addr++ = (uint8_t) (data>>8);
+ *addr = (uint8_t) (data);
+}
+
+/***************************************************************/
+void Write16BigEndian( uint8_t *addr, uint16_t data )
+{
+ *addr++ = (uint8_t) (data>>8);
+ *addr = (uint8_t) (data);
+}
+
+/***************************************************************/
+void WriteCellLittleEndian( uint8_t *addr, ucell_t data )
+{
+ /* Write should be in order of increasing address
+ * to optimize for burst writes to DRAM. */
+ if( sizeof(ucell_t) == 8 )
+ {
+ *addr++ = (uint8_t) data; /* LSB at near end */
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ }
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr = (uint8_t) data;
+}
+/***************************************************************/
+void Write32LittleEndian( uint8_t *addr, uint32_t data )
+{
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr = (uint8_t) data;
+}
+
+/***************************************************************/
+void Write16LittleEndian( uint8_t *addr, uint16_t data )
+{
+ *addr++ = (uint8_t) data;
+ data = data >> 8;
+ *addr = (uint8_t) data;
+}
+
+/***************************************************************/
+/* Return 1 if host CPU is Little Endian */
+int IsHostLittleEndian( void )
+{
+ static int gEndianCheck = 1;
+ unsigned char *bp = (unsigned char *) &gEndianCheck;
+ return (int) (*bp); /* Return byte pointed to by address. If LSB then == 1 */
+}
+
+#if defined(PF_NO_FILEIO) || defined(PF_NO_SHELL)
+
+cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)
+{
+ TOUCH(FileName);
+ TOUCH(EntryPoint);
+ TOUCH(NameSize);
+ TOUCH(CodeSize);
+
+ pfReportError("ffSaveForth", PF_ERR_NOT_SUPPORTED);
+ return -1;
+}
+
+#else /* PF_NO_FILEIO or PF_NO_SHELL */
+
+/***************************************************************/
+static int Write32ToFile( FileStream *fid, uint32_t Val )
+{
+ int numw;
+ uint8_t pad[4];
+
+ Write32BigEndian(pad,Val);
+ numw = sdWriteFile( pad, 1, sizeof(pad), fid );
+ if( numw != sizeof(pad) ) return -1;
+ return 0;
+}
+
+/***************************************************************/
+static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t NumBytes )
+{
+ cell_t numw;
+ cell_t EvenNumW;
+
+ EvenNumW = EVENUP(NumBytes);
+
+ if( Write32ToFile( fid, ID ) < 0 ) goto error;
+ if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error;
+
+ numw = sdWriteFile( Data, 1, EvenNumW, fid );
+ if( numw != EvenNumW ) goto error;
+ return 0;
+error:
+ pfReportError("WriteChunkToFile", PF_ERR_WRITE_FILE);
+ return -1;
+}
+
+/* Convert dictionary info chunk between native and on-disk (big-endian). */
+static void
+convertDictionaryInfoWrite (DictionaryInfoChunk *sd)
+{
+/* Convert all fields in DictionaryInfoChunk from Native to BigEndian.
+ * This assumes they are all 32-bit integers.
+ */
+ int i;
+ uint32_t *p = (uint32_t *) sd;
+ for (i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++)
+ {
+ Write32BigEndian( (uint8_t *)&p[i], p[i] );
+ }
+}
+
+static void
+convertDictionaryInfoRead (DictionaryInfoChunk *sd)
+{
+/* Convert all fields in structure from BigEndian to Native. */
+ int i;
+ uint32_t *p = (uint32_t *) sd;
+ for (i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++)
+ {
+ p[i] = Read32BigEndian( (uint8_t *)&p[i] );
+ }
+}
+
+/****************************************************************
+** Save Dictionary in File.
+** If EntryPoint is NULL, save as development environment.
+** If EntryPoint is non-NULL, save as turnKey environment with no names.
+*/
+cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)
+{
+ FileStream *fid;
+ DictionaryInfoChunk SD;
+ uint32_t FormSize;
+ uint32_t NameChunkSize = 0;
+ uint32_t CodeChunkSize;
+ uint32_t relativeCodePtr;
+
+ fid = sdOpenFile( FileName, "wb" );
+ if( fid == NULL )
+ {
+ pfReportError("pfSaveDictionary", PF_ERR_OPEN_FILE);
+ return -1;
+ }
+
+/* Save in uninitialized form. */
+ pfExecIfDefined("AUTO.TERM");
+
+/* Write FORM Header ---------------------------- */
+ if( Write32ToFile( fid, ID_FORM ) < 0 ) goto error;
+ if( Write32ToFile( fid, 0 ) < 0 ) goto error;
+ if( Write32ToFile( fid, ID_P4TH ) < 0 ) goto error;
+
+/* Write P4DI Dictionary Info ------------------ */
+ SD.sd_Version = PF_FILE_VERSION;
+
+ relativeCodePtr = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */
+ SD.sd_RelCodePtr = relativeCodePtr;
+ SD.sd_UserStackSize = sizeof(cell_t) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);
+ SD.sd_ReturnStackSize = sizeof(cell_t) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);
+ SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */
+
+#ifdef PF_SUPPORT_FP
+ SD.sd_FloatSize = sizeof(PF_FLOAT); /* Must match compiled dictionary. */
+#else
+ SD.sd_FloatSize = 0;
+#endif
+
+ SD.sd_CellSize = sizeof(cell_t);
+
+/* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */
+ {
+#if defined(PF_BIG_ENDIAN_DIC)
+ int eflag = SD_F_BIG_ENDIAN_DIC;
+#elif defined(PF_LITTLE_ENDIAN_DIC)
+ int eflag = 0;
+#else
+ int eflag = IsHostLittleEndian() ? 0 : SD_F_BIG_ENDIAN_DIC;
+#endif
+ SD.sd_Flags = eflag;
+ }
+
+ if( EntryPoint )
+ {
+ SD.sd_EntryPoint = EntryPoint; /* Turnkey! */
+ }
+ else
+ {
+ SD.sd_EntryPoint = 0;
+ }
+
+/* Do we save names? */
+ if( NameSize == 0 )
+ {
+ SD.sd_RelContext = 0;
+ SD.sd_RelHeaderPtr = 0;
+ SD.sd_NameSize = 0;
+ }
+ else
+ {
+ uint32_t relativeHeaderPtr;
+/* Development mode. */
+ SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);
+ relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr);
+ SD.sd_RelHeaderPtr = relativeHeaderPtr;
+
+/* How much real name space is there? */
+ NameChunkSize = QUADUP(relativeHeaderPtr); /* Align */
+
+/* NameSize must be 0 or greater than NameChunkSize + 1K */
+ NameSize = QUADUP(NameSize); /* Align */
+ if( NameSize > 0 )
+ {
+ NameSize = MAX( NameSize, (NameChunkSize + 1024) );
+ }
+ SD.sd_NameSize = NameSize;
+ }
+
+/* How much real code is there? */
+ CodeChunkSize = QUADUP(relativeCodePtr);
+ CodeSize = QUADUP(CodeSize); /* Align */
+ CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );
+ SD.sd_CodeSize = CodeSize;
+
+
+ convertDictionaryInfoWrite (&SD);
+
+ if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;
+
+/* Write Name Fields if NameSize non-zero ------- */
+ if( NameSize > 0 )
+ {
+ if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,
+ NameChunkSize ) < 0 ) goto error;
+ }
+
+/* Write Code Fields ---------------------------- */
+ if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,
+ CodeChunkSize ) < 0 ) goto error;
+
+ FormSize = (uint32_t) sdTellFile( fid ) - 8;
+ sdSeekFile( fid, 4, PF_SEEK_SET );
+ if( Write32ToFile( fid, FormSize ) < 0 ) goto error;
+
+ sdCloseFile( fid );
+
+/* Restore initialization. */
+ pfExecIfDefined("AUTO.INIT");
+ return 0;
+
+error:
+ sdSeekFile( fid, 0, PF_SEEK_SET );
+ Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */
+ sdCloseFile( fid );
+
+/* Restore initialization. */
+ pfExecIfDefined("AUTO.INIT");
+
+ return -1;
+}
+
+#endif /* !PF_NO_FILEIO and !PF_NO_SHELL */
+
+
+#ifndef PF_NO_FILEIO
+
+/***************************************************************/
+static int32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )
+{
+ int32_t numr;
+ uint8_t pad[4];
+ numr = sdReadFile( pad, 1, sizeof(pad), fid );
+ if( numr != sizeof(pad) ) return -1;
+ *ValPtr = Read32BigEndian( pad );
+ return 0;
+}
+
+/***************************************************************/
+PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )
+{
+ pfDictionary_t *dic = NULL;
+ FileStream *fid;
+ DictionaryInfoChunk *sd;
+ uint32_t ChunkID;
+ uint32_t ChunkSize;
+ uint32_t FormSize;
+ uint32_t BytesLeft;
+ uint32_t numr;
+ int isDicBigEndian;
+
+DBUG(("pfLoadDictionary( %s )\n", FileName ));
+
+/* Open file. */
+ fid = sdOpenFile( FileName, "rb" );
+ if( fid == NULL )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_OPEN_FILE);
+ goto xt_error;
+ }
+
+/* Read FORM, Size, ID */
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;
+ if( ChunkID != ID_FORM )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);
+ goto error;
+ }
+
+ if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;
+ BytesLeft = FormSize;
+
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;
+ BytesLeft -= 4;
+ if( ChunkID != ID_P4TH )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE);
+ goto error;
+ }
+
+/* Scan and parse all chunks in file. */
+ while( BytesLeft > 0 )
+ {
+ if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;
+ if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;
+ BytesLeft -= 8;
+
+ DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));
+
+ switch( ChunkID )
+ {
+ case ID_P4DI:
+ sd = (DictionaryInfoChunk *) pfAllocMem( ChunkSize );
+ if( sd == NULL ) goto nomem_error;
+
+ numr = sdReadFile( sd, 1, ChunkSize, fid );
+ if( numr != ChunkSize ) goto read_error;
+ BytesLeft -= ChunkSize;
+
+ convertDictionaryInfoRead (sd);
+
+ isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;
+
+ if( !gVarQuiet )
+ {
+ MSG("pForth loading dictionary from file "); MSG(FileName);
+ EMIT_CR;
+ MSG_NUM_D(" File format version is ", sd->sd_Version );
+ MSG_NUM_D(" Name space size = ", sd->sd_NameSize );
+ MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );
+ MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );
+ MSG_NUM_D(" Cell Size = ", sd->sd_CellSize );
+ MSG( (isDicBigEndian ? " Big Endian Dictionary" :
+ " Little Endian Dictionary") );
+ if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");
+ EMIT_CR;
+ }
+
+ if( sd->sd_Version > PF_FILE_VERSION )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_VERSION_FUTURE );
+ goto error;
+ }
+ if( sd->sd_Version < PF_EARLIEST_FILE_VERSION )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );
+ goto error;
+ }
+ if( sd->sd_CellSize != sizeof(cell_t) )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_CELL_SIZE_CONFLICT );
+ goto error;
+ }
+ if( sd->sd_NumPrimitives > NUM_PRIMITIVES )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );
+ goto error;
+ }
+
+/* Check to make sure that EndianNess of dictionary matches mode of pForth. */
+#if defined(PF_BIG_ENDIAN_DIC)
+ if(isDicBigEndian == 0)
+#elif defined(PF_LITTLE_ENDIAN_DIC)
+ if(isDicBigEndian == 1)
+#else
+ if( isDicBigEndian == IsHostLittleEndian() )
+#endif
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );
+ goto error;
+ }
+
+/* Check for compatible float size. */
+#ifdef PF_SUPPORT_FP
+ if( sd->sd_FloatSize != sizeof(PF_FLOAT) )
+#else
+ if( sd->sd_FloatSize != 0 )
+#endif
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_FLOAT_CONFLICT );
+ goto error;
+ }
+
+ dic = pfCreateDictionary( sd->sd_NameSize, sd->sd_CodeSize );
+ if( dic == NULL ) goto nomem_error;
+ gCurrentDictionary = dic;
+ if( sd->sd_NameSize > 0 )
+ {
+ gVarContext = NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */
+ gCurrentDictionary->dic_HeaderPtr = (ucell_t)(uint8_t *)
+ NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);
+ }
+ else
+ {
+ gVarContext = 0;
+ gCurrentDictionary->dic_HeaderPtr = (ucell_t)NULL;
+ }
+ gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);
+ gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */
+/* Pass EntryPoint back to caller. */
+ if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;
+ pfFreeMem(sd);
+ break;
+
+ case ID_P4NM:
+#ifdef PF_NO_SHELL
+ pfReportError("pfLoadDictionary", PF_ERR_NO_SHELL );
+ goto error;
+#else
+ if( NAME_BASE == 0 )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_NO_NAMES );
+ goto error;
+ }
+ if( gCurrentDictionary == NULL )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
+ goto error;
+ }
+ if( ChunkSize > NAME_SIZE )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);
+ goto error;
+ }
+ numr = sdReadFile( (char *) NAME_BASE, 1, ChunkSize, fid );
+ if( numr != ChunkSize ) goto read_error;
+ BytesLeft -= ChunkSize;
+#endif /* PF_NO_SHELL */
+ break;
+
+ case ID_P4CD:
+ if( gCurrentDictionary == NULL )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
+ goto error;
+ }
+ if( ChunkSize > CODE_SIZE )
+ {
+ pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);
+ goto error;
+ }
+ numr = sdReadFile( (uint8_t *) CODE_BASE, 1, ChunkSize, fid );
+ if( numr != ChunkSize ) goto read_error;
+ BytesLeft -= ChunkSize;
+ break;
+
+ default:
+ pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
+ sdSeekFile( fid, ChunkSize, PF_SEEK_CUR );
+ break;
+ }
+ }
+
+ sdCloseFile( fid );
+
+ if( NAME_BASE != 0)
+ {
+ cell_t Result;
+/* Find special words in dictionary for global XTs. */
+ if( (Result = FindSpecialXTs()) < 0 )
+ {
+ pfReportError("pfLoadDictionary: FindSpecialXTs", Result);
+ goto error;
+ }
+ }
+
+DBUG(("pfLoadDictionary: return %p\n", dic));
+ return (PForthDictionary) dic;
+
+nomem_error:
+ pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);
+ sdCloseFile( fid );
+ return NULL;
+
+read_error:
+ pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);
+error:
+ sdCloseFile( fid );
+xt_error:
+ return NULL;
+}
+
+#else
+
+PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )
+{
+ (void) FileName;
+ (void) EntryPointPtr;
+ return NULL;
+}
+#endif /* !PF_NO_FILEIO */
+
+
+
+/***************************************************************/
+PForthDictionary pfLoadStaticDictionary( void )
+{
+#ifdef PF_STATIC_DIC
+ cell_t Result;
+ pfDictionary_t *dic;
+ cell_t NewNameSize, NewCodeSize;
+
+ if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )
+ {
+ MSG( (IF_LITTLE_ENDIAN ?
+ "Little Endian Dictionary on " :
+ "Big Endian Dictionary on ") );
+ MSG( (IsHostLittleEndian() ?
+ "Little Endian CPU" :
+ "Big Endian CPU") );
+ EMIT_CR;
+ }
+
+/* Check to make sure that EndianNess of dictionary matches mode of pForth. */
+#if defined(PF_BIG_ENDIAN_DIC)
+ if(IF_LITTLE_ENDIAN == 1)
+#elif defined(PF_LITTLE_ENDIAN_DIC)
+ if(IF_LITTLE_ENDIAN == 0)
+#else /* Code is native endian! */
+ if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )
+#endif
+ {
+ pfReportError("pfLoadStaticDictionary", PF_ERR_ENDIAN_CONFLICT );
+ goto error;
+ }
+
+
+#ifndef PF_EXTRA_HEADERS
+ #define PF_EXTRA_HEADERS (20000)
+#endif
+#ifndef PF_EXTRA_CODE
+ #define PF_EXTRA_CODE (40000)
+#endif
+
+/* Copy static const data to allocated dictionaries. */
+ NewNameSize = sizeof(MinDicNames) + PF_EXTRA_HEADERS;
+ NewCodeSize = sizeof(MinDicCode) + PF_EXTRA_CODE;
+
+ DBUG_NUM_D( "static dic name size = ", NewNameSize );
+ DBUG_NUM_D( "static dic code size = ", NewCodeSize );
+
+ gCurrentDictionary = dic = pfCreateDictionary( NewNameSize, NewCodeSize );
+ if( !dic ) goto nomem_error;
+
+ pfCopyMemory( (uint8_t *) dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );
+ pfCopyMemory( (uint8_t *) dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );
+ DBUG(("Static data copied to newly allocated dictionaries.\n"));
+
+ dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);
+ gNumPrimitives = NUM_PRIMITIVES;
+
+ if( NAME_BASE != 0)
+ {
+/* Setup name space. */
+ dic->dic_HeaderPtr = (ucell_t)(uint8_t *) NAMEREL_TO_ABS(HEADERPTR);
+ gVarContext = NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */
+
+/* Find special words in dictionary for global XTs. */
+ if( (Result = FindSpecialXTs()) < 0 )
+ {
+ pfReportError("pfLoadStaticDictionary: FindSpecialXTs", Result);
+ goto error;
+ }
+ }
+
+ return (PForthDictionary) dic;
+
+error:
+ return NULL;
+
+nomem_error:
+ pfReportError("pfLoadStaticDictionary", PF_ERR_NO_MEM);
+#endif /* PF_STATIC_DIC */
+
+ return NULL;
+}
+