projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix REPOSITION-FILE, HISTORY, locked file handle and other problems.
[pforth] / csrc / pf_save.c
CommitLineData
bb6b2dcd 1/* @(#) pf_save.c 98/01/26 1.3 */\r
2/***************************************************************\r
3** Save and Load Dictionary\r
4** for PForth based on 'C'\r
5**\r
6** Compile file based version or static data based version\r
7** depending on PF_NO_FILEIO switch.\r
8**\r
9** Author: Phil Burk\r
10** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom\r
11**\r
12** The pForth software code is dedicated to the public domain,\r
13** and any third party may reproduce, distribute and modify\r
14** the pForth software code or any derivative works thereof\r
15** without any compensation or license. The pForth software\r
16** code is provided on an "as is" basis without any warranty\r
17** of any kind, including, without limitation, the implied\r
18** warranties of merchantability and fitness for a particular\r
19** purpose and their equivalents under the laws of any jurisdiction.\r
20**\r
21****************************************************************\r
22** 940225 PLB Fixed CodePtr save, was using NAMEREL instead of CODEREL\r
23** This would only work if the relative location\r
24** of names and code was the same when saved and reloaded.\r
25** 940228 PLB Added PF_NO_FILEIO version\r
26** 961204 PLB Added PF_STATIC_DIC\r
1cb310e6 27** 000623 PLB Cast chars as ucell_t before shifting for 16 bit systems.\r
bb6b2dcd 28***************************************************************/\r
29\r
1cb310e6 30#include <assert.h>\r
31\r
bb6b2dcd 32#include "pf_all.h"\r
33\r
34/* If no File I/O, then force static dictionary. */\r
35#ifdef PF_NO_FILEIO\r
36 #ifndef PF_STATIC_DIC\r
37 #define PF_STATIC_DIC\r
38 #endif\r
39#endif\r
40\r
41#ifdef PF_STATIC_DIC\r
42 #include "pfdicdat.h"\r
43#endif\r
44\r
45/*\r
46Dictionary File Format based on IFF standard.\r
47The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.\r
48The dictionaries may be big or little endian.\r
49 'FORM'\r
50 size\r
51 'P4TH' - Form Identifier\r
52\r
53Chunks\r
54 'P4DI'\r
55 size\r
56 struct DictionaryInfoChunk\r
57\r
58 'P4NM'\r
59 size\r
60 Name and Header portion of dictionary. (Big or Little Endian) (Optional)\r
61\r
62 'P4CD'\r
63 size\r
64 Code portion of dictionary. (Big or Little Endian) \r
65*/\r
66\r
67\r
68/***************************************************************/\r
69/* Endian-ness tools. */\r
1cb310e6 70ucell_t ReadCellBigEndian( const uint8_t *addr )\r
bb6b2dcd 71{\r
1cb310e6 72 ucell_t temp = (ucell_t)addr[0];\r
73 temp = (temp << 8) | ((ucell_t)addr[1]);\r
74 temp = (temp << 8) | ((ucell_t)addr[2]);\r
75 temp = (temp << 8) | ((ucell_t)addr[3]);\r
76 if( sizeof(ucell_t) == 8 )\r
77 {\r
78 temp = (temp << 8) | ((ucell_t)addr[4]);\r
79 temp = (temp << 8) | ((ucell_t)addr[5]);\r
80 temp = (temp << 8) | ((ucell_t)addr[6]);\r
81 temp = (temp << 8) | ((ucell_t)addr[7]);\r
82 }\r
83 \r
bb6b2dcd 84 return temp;\r
85}\r
86/***************************************************************/\r
1cb310e6 87/* Endian-ness tools. */\r
88uint32_t Read32BigEndian( const uint8_t *addr )\r
bb6b2dcd 89{\r
1cb310e6 90 uint32_t temp = (uint32_t)addr[0];\r
91 temp = (temp << 8) | ((uint32_t)addr[1]);\r
92 temp = (temp << 8) | ((uint32_t)addr[2]);\r
93 temp = (temp << 8) | ((uint32_t)addr[3]);\r
94 return temp;\r
bb6b2dcd 95}\r
96\r
97/***************************************************************/\r
1cb310e6 98uint16_t Read16BigEndian( const uint8_t *addr )\r
bb6b2dcd 99{\r
1cb310e6 100 return (uint16_t) ((addr[0]<<8) | addr[1]);\r
101}\r
102\r
103/***************************************************************/\r
104ucell_t ReadCellLittleEndian( const uint8_t *addr )\r
105{\r
106 ucell_t temp = 0;\r
107 if( sizeof(ucell_t) == 8 )\r
108 {\r
109 temp = (temp << 8) | ((uint32_t)addr[7]);\r
110 temp = (temp << 8) | ((uint32_t)addr[6]);\r
111 temp = (temp << 8) | ((uint32_t)addr[5]);\r
112 temp = (temp << 8) | ((uint32_t)addr[4]);\r
113 }\r
114 temp = (temp << 8) | ((uint32_t)addr[3]);\r
115 temp = (temp << 8) | ((uint32_t)addr[2]);\r
116 temp = (temp << 8) | ((uint32_t)addr[1]);\r
117 temp = (temp << 8) | ((uint32_t)addr[0]);\r
bb6b2dcd 118 return temp;\r
119}\r
1cb310e6 120\r
bb6b2dcd 121/***************************************************************/\r
1cb310e6 122uint32_t Read32LittleEndian( const uint8_t *addr )\r
123{\r
124 uint32_t temp = (uint32_t)addr[3];\r
125 temp = (temp << 8) | ((uint32_t)addr[2]);\r
126 temp = (temp << 8) | ((uint32_t)addr[1]);\r
127 temp = (temp << 8) | ((uint32_t)addr[0]);\r
128 return temp;\r
129}\r
130\r
131/***************************************************************/\r
132uint16_t Read16LittleEndian( const uint8_t *addr )\r
bb6b2dcd 133{\r
134 const unsigned char *bp = (const unsigned char *) addr;\r
1cb310e6 135 return (uint16_t) ((bp[1]<<8) | bp[0]);\r
bb6b2dcd 136}\r
137\r
138#ifdef PF_SUPPORT_FP\r
139\r
140/***************************************************************/\r
141static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );\r
142\r
143static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst )\r
144{\r
145 int i;\r
146 unsigned char *d = (unsigned char *) dst;\r
147 const unsigned char *s = (const unsigned char *) src;\r
148\r
149 for( i=0; i<sizeof(PF_FLOAT); i++ )\r
150 {\r
151 d[i] = s[sizeof(PF_FLOAT) - 1 - i];\r
152 }\r
153}\r
154\r
155/***************************************************************/\r
156void WriteFloatBigEndian( PF_FLOAT *addr, PF_FLOAT data )\r
157{\r
158 if( IsHostLittleEndian() )\r
159 {\r
160 ReverseCopyFloat( &data, addr );\r
161 }\r
162 else\r
163 {\r
164 *addr = data;\r
165 }\r
166}\r
167\r
168/***************************************************************/\r
169PF_FLOAT ReadFloatBigEndian( const PF_FLOAT *addr )\r
170{\r
171 PF_FLOAT data;\r
172 if( IsHostLittleEndian() )\r
173 {\r
174 ReverseCopyFloat( addr, &data );\r
175 return data;\r
176 }\r
177 else\r
178 {\r
179 return *addr;\r
180 }\r
181}\r
182\r
183/***************************************************************/\r
184void WriteFloatLittleEndian( PF_FLOAT *addr, PF_FLOAT data )\r
185{\r
186 if( IsHostLittleEndian() )\r
187 {\r
188 *addr = data;\r
189 }\r
190 else\r
191 {\r
192 ReverseCopyFloat( &data, addr );\r
193 }\r
194}\r
195\r
196/***************************************************************/\r
197PF_FLOAT ReadFloatLittleEndian( const PF_FLOAT *addr )\r
198{\r
199 PF_FLOAT data;\r
200 if( IsHostLittleEndian() )\r
201 {\r
202 return *addr;\r
203 }\r
204 else\r
205 {\r
206 ReverseCopyFloat( addr, &data );\r
207 return data;\r
208 }\r
209}\r
210\r
211#endif /* PF_SUPPORT_FP */\r
212\r
213/***************************************************************/\r
1cb310e6 214void WriteCellBigEndian( uint8_t *addr, ucell_t data )\r
bb6b2dcd 215{\r
1cb310e6 216 // Write should be in order of increasing address\r
217 // to optimize for burst writes to DRAM.\r
218 if( sizeof(ucell_t) == 8 )\r
219 {\r
220 *addr++ = (uint8_t) (data>>56);\r
221 *addr++ = (uint8_t) (data>>48);\r
222 *addr++ = (uint8_t) (data>>40);\r
223 *addr++ = (uint8_t) (data>>32);\r
224 }\r
225 *addr++ = (uint8_t) (data>>24);\r
226 *addr++ = (uint8_t) (data>>16);\r
227 *addr++ = (uint8_t) (data>>8);\r
228 *addr = (uint8_t) (data);\r
bb6b2dcd 229}\r
230\r
231/***************************************************************/\r
1cb310e6 232void Write32BigEndian( uint8_t *addr, uint32_t data )\r
bb6b2dcd 233{\r
1cb310e6 234 *addr++ = (uint8_t) (data>>24);\r
235 *addr++ = (uint8_t) (data>>16);\r
236 *addr++ = (uint8_t) (data>>8);\r
237 *addr = (uint8_t) (data);\r
bb6b2dcd 238}\r
239\r
240/***************************************************************/\r
1cb310e6 241void Write16BigEndian( uint8_t *addr, uint16_t data )\r
bb6b2dcd 242{\r
1cb310e6 243 *addr++ = (uint8_t) (data>>8);\r
244 *addr = (uint8_t) (data);\r
245}\r
bb6b2dcd 246\r
1cb310e6 247/***************************************************************/\r
248void WriteCellLittleEndian( uint8_t *addr, ucell_t data )\r
249{\r
250 // Write should be in order of increasing address\r
251 // to optimize for burst writes to DRAM.\r
252 if( sizeof(ucell_t) == 8 )\r
253 {\r
254 *addr++ = (uint8_t) data; // LSB at near end\r
255 data = data >> 8;\r
256 *addr++ = (uint8_t) data;\r
257 data = data >> 8;\r
258 *addr++ = (uint8_t) data;\r
259 data = data >> 8;\r
260 *addr++ = (uint8_t) data;\r
261 data = data >> 8;\r
262 }\r
263 *addr++ = (uint8_t) data;\r
264 data = data >> 8;\r
265 *addr++ = (uint8_t) data;\r
266 data = data >> 8;\r
267 *addr++ = (uint8_t) data;\r
268 data = data >> 8;\r
269 *addr = (uint8_t) data;\r
bb6b2dcd 270}\r
271/***************************************************************/\r
1cb310e6 272void Write32LittleEndian( uint8_t *addr, uint32_t data )\r
bb6b2dcd 273{\r
1cb310e6 274 *addr++ = (uint8_t) data;\r
275 data = data >> 8;\r
276 *addr++ = (uint8_t) data;\r
277 data = data >> 8;\r
278 *addr++ = (uint8_t) data;\r
279 data = data >> 8;\r
280 *addr = (uint8_t) data;\r
281}\r
bb6b2dcd 282\r
1cb310e6 283/***************************************************************/\r
284void Write16LittleEndian( uint8_t *addr, uint16_t data )\r
285{\r
286 *addr++ = (uint8_t) data;\r
287 data = data >> 8;\r
288 *addr = (uint8_t) data;\r
bb6b2dcd 289}\r
290\r
291/***************************************************************/\r
292/* Return 1 if host CPU is Little Endian */\r
293int IsHostLittleEndian( void )\r
294{\r
295 static int gEndianCheck = 1;\r
296 unsigned char *bp = (unsigned char *) &gEndianCheck;\r
297 return (int) (*bp); /* Return byte pointed to by address. If LSB then == 1 */\r
298}\r
299\r
300#if defined(PF_NO_FILEIO) || defined(PF_NO_SHELL)\r
301\r
1cb310e6 302cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
bb6b2dcd 303{\r
304 TOUCH(FileName);\r
305 TOUCH(EntryPoint);\r
306 TOUCH(NameSize);\r
307 TOUCH(CodeSize);\r
308\r
309 pfReportError("ffSaveForth", PF_ERR_NOT_SUPPORTED);\r
310 return -1;\r
311}\r
312\r
313#else /* PF_NO_FILEIO or PF_NO_SHELL */\r
314\r
315/***************************************************************/\r
1cb310e6 316static int Write32ToFile( FileStream *fid, uint32_t Val )\r
bb6b2dcd 317{\r
1cb310e6 318 int numw;\r
319 uint8_t pad[4];\r
bb6b2dcd 320\r
1cb310e6 321 Write32BigEndian(pad,Val);\r
322 numw = sdWriteFile( pad, 1, sizeof(pad), fid );\r
323 if( numw != sizeof(pad) ) return -1;\r
bb6b2dcd 324 return 0;\r
325}\r
326\r
327/***************************************************************/\r
1cb310e6 328static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t NumBytes )\r
bb6b2dcd 329{\r
1cb310e6 330 cell_t numw;\r
331 cell_t EvenNumW;\r
bb6b2dcd 332\r
333 EvenNumW = EVENUP(NumBytes);\r
334\r
1cb310e6 335 if( Write32ToFile( fid, ID ) < 0 ) goto error;\r
336 if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error;\r
bb6b2dcd 337\r
338 numw = sdWriteFile( Data, 1, EvenNumW, fid );\r
339 if( numw != EvenNumW ) goto error;\r
340 return 0;\r
341error:\r
1cb310e6 342 pfReportError("WriteChunkToFile", PF_ERR_WRITE_FILE);\r
bb6b2dcd 343 return -1;\r
344}\r
345\r
90975d26 346/* Convert dictionary info chunk between native and on-disk (big-endian). */\r
347static void\r
348convertDictionaryInfoWrite (DictionaryInfoChunk *sd)\r
349{\r
350/* Convert all fields in DictionaryInfoChunk from Native to BigEndian. \r
351 * This assumes they are all 32-bit integers.\r
352 */\r
353 int i;\r
354 uint32_t *p = (uint32_t *) sd;\r
355 for (i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++)\r
356 {\r
357 Write32BigEndian( (uint8_t *)&p[i], p[i] );\r
358 }\r
359}\r
360\r
361static void\r
362convertDictionaryInfoRead (DictionaryInfoChunk *sd)\r
363{\r
364/* Convert all fields in structure from BigEndian to Native. */\r
365 int i;\r
366 uint32_t *p = (uint32_t *) sd;\r
367 for (i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++)\r
368 {\r
369 p[i] = Read32BigEndian( (uint8_t *)&p[i] );\r
370 }\r
371}\r
372\r
bb6b2dcd 373/****************************************************************\r
374** Save Dictionary in File.\r
375** If EntryPoint is NULL, save as development environment.\r
376** If EntryPoint is non-NULL, save as turnKey environment with no names.\r
377*/\r
1cb310e6 378cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
bb6b2dcd 379{\r
380 FileStream *fid;\r
381 DictionaryInfoChunk SD;\r
1cb310e6 382 uint32_t FormSize;\r
383 uint32_t NameChunkSize = 0;\r
384 uint32_t CodeChunkSize;\r
385 uint32_t relativeCodePtr;\r
bb6b2dcd 386\r
387 fid = sdOpenFile( FileName, "wb" );\r
388 if( fid == NULL )\r
389 {\r
390 pfReportError("pfSaveDictionary", PF_ERR_OPEN_FILE);\r
391 return -1;\r
392 }\r
393\r
394/* Save in uninitialized form. */\r
395 pfExecIfDefined("AUTO.TERM");\r
396\r
397/* Write FORM Header ---------------------------- */\r
1cb310e6 398 if( Write32ToFile( fid, ID_FORM ) < 0 ) goto error;\r
399 if( Write32ToFile( fid, 0 ) < 0 ) goto error;\r
400 if( Write32ToFile( fid, ID_P4TH ) < 0 ) goto error;\r
bb6b2dcd 401\r
402/* Write P4DI Dictionary Info ------------------ */\r
403 SD.sd_Version = PF_FILE_VERSION;\r
404\r
1cb310e6 405 relativeCodePtr = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */\r
406 SD.sd_RelCodePtr = relativeCodePtr; \r
407 SD.sd_UserStackSize = sizeof(cell_t) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);\r
408 SD.sd_ReturnStackSize = sizeof(cell_t) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);\r
bb6b2dcd 409 SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */\r
410\r
411#ifdef PF_SUPPORT_FP\r
412 SD.sd_FloatSize = sizeof(PF_FLOAT); /* Must match compiled dictionary. */\r
413#else\r
414 SD.sd_FloatSize = 0;\r
415#endif\r
416\r
1cb310e6 417 SD.sd_CellSize = sizeof(cell_t);\r
bb6b2dcd 418\r
1cb310e6 419/* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */\r
bb6b2dcd 420 {\r
421#if defined(PF_BIG_ENDIAN_DIC)\r
422 int eflag = SD_F_BIG_ENDIAN_DIC;\r
423#elif defined(PF_LITTLE_ENDIAN_DIC)\r
424 int eflag = 0;\r
425#else\r
426 int eflag = IsHostLittleEndian() ? 0 : SD_F_BIG_ENDIAN_DIC;\r
427#endif\r
428 SD.sd_Flags = eflag;\r
429 }\r
430\r
431 if( EntryPoint )\r
432 {\r
433 SD.sd_EntryPoint = EntryPoint; /* Turnkey! */\r
434 }\r
435 else\r
436 {\r
437 SD.sd_EntryPoint = 0;\r
438 }\r
439\r
440/* Do we save names? */\r
441 if( NameSize == 0 )\r
442 {\r
443 SD.sd_RelContext = 0;\r
444 SD.sd_RelHeaderPtr = 0;\r
445 SD.sd_NameSize = 0;\r
446 }\r
447 else\r
448 {\r
1cb310e6 449 uint32_t relativeHeaderPtr;\r
bb6b2dcd 450/* Development mode. */\r
451 SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);\r
b3ad2602 452 relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr);\r
1cb310e6 453 SD.sd_RelHeaderPtr = relativeHeaderPtr;\r
bb6b2dcd 454\r
455/* How much real name space is there? */\r
1cb310e6 456 NameChunkSize = QUADUP(relativeHeaderPtr); /* Align */\r
bb6b2dcd 457\r
458/* NameSize must be 0 or greater than NameChunkSize + 1K */\r
459 NameSize = QUADUP(NameSize); /* Align */\r
460 if( NameSize > 0 )\r
461 {\r
462 NameSize = MAX( NameSize, (NameChunkSize + 1024) );\r
463 }\r
464 SD.sd_NameSize = NameSize;\r
465 }\r
466\r
467/* How much real code is there? */\r
1cb310e6 468 CodeChunkSize = QUADUP(relativeCodePtr);\r
bb6b2dcd 469 CodeSize = QUADUP(CodeSize); /* Align */\r
470 CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );\r
471 SD.sd_CodeSize = CodeSize;\r
472\r
473 \r
90975d26 474 convertDictionaryInfoWrite (&SD);\r
bb6b2dcd 475\r
1cb310e6 476 if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
bb6b2dcd 477\r
478/* Write Name Fields if NameSize non-zero ------- */\r
479 if( NameSize > 0 )\r
480 {\r
1cb310e6 481 if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,\r
bb6b2dcd 482 NameChunkSize ) < 0 ) goto error;\r
483 }\r
484\r
485/* Write Code Fields ---------------------------- */\r
1cb310e6 486 if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,\r
bb6b2dcd 487 CodeChunkSize ) < 0 ) goto error;\r
488\r
489 FormSize = sdTellFile( fid ) - 8;\r
490 sdSeekFile( fid, 4, PF_SEEK_SET );\r
1cb310e6 491 if( Write32ToFile( fid, FormSize ) < 0 ) goto error;\r
bb6b2dcd 492\r
493 sdCloseFile( fid );\r
494\r
bb6b2dcd 495/* Restore initialization. */\r
bb6b2dcd 496 pfExecIfDefined("AUTO.INIT");\r
bb6b2dcd 497 return 0;\r
498\r
499error:\r
500 sdSeekFile( fid, 0, PF_SEEK_SET );\r
1cb310e6 501 Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */\r
bb6b2dcd 502 sdCloseFile( fid );\r
503\r
504/* Restore initialization. */\r
bb6b2dcd 505 pfExecIfDefined("AUTO.INIT");\r
506\r
507 return -1;\r
508}\r
509\r
510#endif /* !PF_NO_FILEIO and !PF_NO_SHELL */\r
511\r
512\r
513#ifndef PF_NO_FILEIO\r
514\r
515/***************************************************************/\r
1cb310e6 516static uint32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )\r
bb6b2dcd 517{\r
1cb310e6 518 int32_t numr;\r
519 uint8_t pad[4];\r
520 numr = sdReadFile( pad, 1, sizeof(pad), fid );\r
521 if( numr != sizeof(pad) ) return -1;\r
522 *ValPtr = Read32BigEndian( pad );\r
bb6b2dcd 523 return 0;\r
524}\r
525\r
526/***************************************************************/\r
527PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
528{\r
529 pfDictionary_t *dic = NULL;\r
530 FileStream *fid;\r
531 DictionaryInfoChunk *sd;\r
1cb310e6 532 uint32_t ChunkID;\r
533 uint32_t ChunkSize;\r
534 uint32_t FormSize;\r
535 uint32_t BytesLeft;\r
536 uint32_t numr;\r
bb6b2dcd 537 int isDicBigEndian;\r
538\r
539DBUG(("pfLoadDictionary( %s )\n", FileName ));\r
540\r
541/* Open file. */\r
542 fid = sdOpenFile( FileName, "rb" );\r
543 if( fid == NULL )\r
544 {\r
545 pfReportError("pfLoadDictionary", PF_ERR_OPEN_FILE);\r
546 goto xt_error;\r
547 }\r
548\r
549/* Read FORM, Size, ID */\r
1cb310e6 550 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
bb6b2dcd 551 if( ChunkID != ID_FORM )\r
552 {\r
553 pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);\r
554 goto error;\r
555 }\r
556\r
1cb310e6 557 if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;\r
bb6b2dcd 558 BytesLeft = FormSize;\r
559\r
1cb310e6 560 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
bb6b2dcd 561 BytesLeft -= 4;\r
562 if( ChunkID != ID_P4TH )\r
563 {\r
564 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE);\r
565 goto error;\r
566 }\r
567\r
568/* Scan and parse all chunks in file. */\r
569 while( BytesLeft > 0 )\r
570 {\r
1cb310e6 571 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
572 if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;\r
bb6b2dcd 573 BytesLeft -= 8;\r
574\r
1cb310e6 575 DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));\r
bb6b2dcd 576\r
577 switch( ChunkID )\r
578 {\r
579 case ID_P4DI:\r
580 sd = (DictionaryInfoChunk *) pfAllocMem( ChunkSize );\r
581 if( sd == NULL ) goto nomem_error;\r
582\r
583 numr = sdReadFile( sd, 1, ChunkSize, fid );\r
584 if( numr != ChunkSize ) goto read_error;\r
585 BytesLeft -= ChunkSize;\r
586 \r
90975d26 587 convertDictionaryInfoRead (sd);\r
588\r
bb6b2dcd 589 isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;\r
590\r
591 if( !gVarQuiet )\r
592 {\r
593 MSG("pForth loading dictionary from file "); MSG(FileName);\r
594 EMIT_CR;\r
595 MSG_NUM_D(" File format version is ", sd->sd_Version );\r
596 MSG_NUM_D(" Name space size = ", sd->sd_NameSize );\r
597 MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );\r
598 MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );\r
1cb310e6 599 MSG_NUM_D(" Cell Size = ", sd->sd_CellSize );\r
bb6b2dcd 600 MSG( (isDicBigEndian ? " Big Endian Dictionary" :\r
601 " Little Endian Dictionary") );\r
602 if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");\r
603 EMIT_CR;\r
604 }\r
605\r
606 if( sd->sd_Version > PF_FILE_VERSION )\r
607 {\r
608 pfReportError("pfLoadDictionary", PF_ERR_VERSION_FUTURE );\r
609 goto error;\r
610 }\r
611 if( sd->sd_Version < PF_EARLIEST_FILE_VERSION )\r
612 {\r
613 pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );\r
614 goto error;\r
615 }\r
1cb310e6 616 if( sd->sd_CellSize != sizeof(cell_t) )\r
617 {\r
618 pfReportError("pfLoadDictionary", PF_ERR_CELL_SIZE_CONFLICT );\r
619 goto error;\r
620 }\r
bb6b2dcd 621 if( sd->sd_NumPrimitives > NUM_PRIMITIVES )\r
622 {\r
623 pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );\r
624 goto error;\r
625 }\r
626\r
627/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
628#if defined(PF_BIG_ENDIAN_DIC)\r
629 if(isDicBigEndian == 0)\r
630#elif defined(PF_LITTLE_ENDIAN_DIC)\r
631 if(isDicBigEndian == 1)\r
632#else\r
633 if( isDicBigEndian == IsHostLittleEndian() )\r
634#endif\r
635 {\r
636 pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );\r
637 goto error;\r
638 }\r
639\r
640/* Check for compatible float size. */\r
641#ifdef PF_SUPPORT_FP\r
642 if( sd->sd_FloatSize != sizeof(PF_FLOAT) )\r
643#else\r
644 if( sd->sd_FloatSize != 0 )\r
645#endif\r
646 {\r
647 pfReportError("pfLoadDictionary", PF_ERR_FLOAT_CONFLICT );\r
648 goto error;\r
649 }\r
650\r
651 dic = pfCreateDictionary( sd->sd_NameSize, sd->sd_CodeSize );\r
652 if( dic == NULL ) goto nomem_error;\r
653 gCurrentDictionary = dic;\r
654 if( sd->sd_NameSize > 0 )\r
655 {\r
656 gVarContext = (char *) NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */\r
b3ad2602 657 gCurrentDictionary->dic_HeaderPtr = (ucell_t)(uint8_t *)\r
bb6b2dcd 658 NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);\r
659 }\r
660 else\r
661 {\r
662 gVarContext = 0;\r
b3ad2602 663 gCurrentDictionary->dic_HeaderPtr = (ucell_t)NULL;\r
bb6b2dcd 664 }\r
1cb310e6 665 gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
bb6b2dcd 666 gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */\r
667/* Pass EntryPoint back to caller. */\r
668 if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;\r
669 pfFreeMem(sd);\r
670 break;\r
671\r
672 case ID_P4NM:\r
673#ifdef PF_NO_SHELL\r
674 pfReportError("pfLoadDictionary", PF_ERR_NO_SHELL );\r
675 goto error;\r
676#else\r
677 if( NAME_BASE == NULL )\r
678 {\r
679 pfReportError("pfLoadDictionary", PF_ERR_NO_NAMES );\r
680 goto error;\r
681 }\r
682 if( gCurrentDictionary == NULL )\r
683 {\r
684 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
685 goto error;\r
686 }\r
687 if( ChunkSize > NAME_SIZE )\r
688 {\r
689 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
690 goto error;\r
691 }\r
692 numr = sdReadFile( NAME_BASE, 1, ChunkSize, fid );\r
693 if( numr != ChunkSize ) goto read_error;\r
694 BytesLeft -= ChunkSize;\r
695#endif /* PF_NO_SHELL */\r
696 break;\r
697\r
698 case ID_P4CD:\r
699 if( gCurrentDictionary == NULL )\r
700 {\r
701 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
702 goto error;\r
703 }\r
704 if( ChunkSize > CODE_SIZE )\r
705 {\r
706 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
707 goto error;\r
708 }\r
709 numr = sdReadFile( CODE_BASE, 1, ChunkSize, fid );\r
710 if( numr != ChunkSize ) goto read_error;\r
711 BytesLeft -= ChunkSize;\r
712 break;\r
713\r
714 default:\r
715 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
716 sdSeekFile( fid, ChunkSize, PF_SEEK_CUR );\r
717 break;\r
718 }\r
719 }\r
720\r
721 sdCloseFile( fid );\r
722\r
723 if( NAME_BASE != NULL)\r
724 {\r
1cb310e6 725 cell_t Result;\r
bb6b2dcd 726/* Find special words in dictionary for global XTs. */\r
727 if( (Result = FindSpecialXTs()) < 0 )\r
728 {\r
729 pfReportError("pfLoadDictionary: FindSpecialXTs", Result);\r
730 goto error;\r
731 }\r
732 }\r
733\r
1cb310e6 734DBUG(("pfLoadDictionary: return %p\n", dic));\r
bb6b2dcd 735 return (PForthDictionary) dic;\r
736\r
737nomem_error:\r
738 pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);\r
739 sdCloseFile( fid );\r
740 return NULL;\r
741\r
742read_error:\r
743 pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);\r
744error:\r
745 sdCloseFile( fid );\r
746xt_error:\r
747 return NULL;\r
748}\r
749\r
750#else\r
751\r
752PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
753{\r
754 (void) FileName;\r
755 (void) EntryPointPtr;\r
756 return NULL;\r
757}\r
758#endif /* !PF_NO_FILEIO */\r
759\r
760\r
761\r
762/***************************************************************/\r
763PForthDictionary pfLoadStaticDictionary( void )\r
764{\r
765#ifdef PF_STATIC_DIC\r
1cb310e6 766 cell_t Result;\r
bb6b2dcd 767 pfDictionary_t *dic;\r
1cb310e6 768 cell_t NewNameSize, NewCodeSize;\r
bb6b2dcd 769 \r
770 if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
771 {\r
772 MSG( (IF_LITTLE_ENDIAN ?\r
773 "Little Endian Dictionary on " :\r
774 "Big Endian Dictionary on ") );\r
775 MSG( (IsHostLittleEndian() ?\r
776 "Little Endian CPU" :\r
777 "Big Endian CPU") );\r
778 EMIT_CR;\r
779 }\r
780 \r
781/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
782#if defined(PF_BIG_ENDIAN_DIC)\r
783 if(IF_LITTLE_ENDIAN == 1)\r
784#elif defined(PF_LITTLE_ENDIAN_DIC)\r
785 if(IF_LITTLE_ENDIAN == 0)\r
786#else /* Code is native endian! */\r
787 if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
788#endif\r
789 {\r
790 pfReportError("pfLoadStaticDictionary", PF_ERR_ENDIAN_CONFLICT );\r
791 goto error;\r
792 }\r
793\r
794\r
795#ifndef PF_EXTRA_HEADERS\r
796 #define PF_EXTRA_HEADERS (20000)\r
797#endif\r
798#ifndef PF_EXTRA_CODE\r
799 #define PF_EXTRA_CODE (40000)\r
800#endif\r
801\r
802/* Copy static const data to allocated dictionaries. */\r
803 NewNameSize = sizeof(MinDicNames) + PF_EXTRA_HEADERS;\r
804 NewCodeSize = sizeof(MinDicCode) + PF_EXTRA_CODE;\r
805\r
806 DBUG_NUM_D( "static dic name size = ", NewNameSize );\r
807 DBUG_NUM_D( "static dic code size = ", NewCodeSize );\r
808 \r
809 gCurrentDictionary = dic = pfCreateDictionary( NewNameSize, NewCodeSize );\r
810 if( !dic ) goto nomem_error;\r
811\r
812 pfCopyMemory( dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );\r
813 pfCopyMemory( dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );\r
1cb310e6 814 DBUG(("Static data copied to newly allocated dictionaries.\n"));\r
bb6b2dcd 815\r
1cb310e6 816 dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);\r
bb6b2dcd 817 gNumPrimitives = NUM_PRIMITIVES;\r
818\r
819 if( NAME_BASE != NULL)\r
820 {\r
821/* Setup name space. */\r
b3ad2602 822 dic->dic_HeaderPtr = (ucell_t)(uint8_t *) NAMEREL_TO_ABS(HEADERPTR);\r
bb6b2dcd 823 gVarContext = (char *) NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */\r
824\r
825/* Find special words in dictionary for global XTs. */\r
826 if( (Result = FindSpecialXTs()) < 0 )\r
827 {\r
828 pfReportError("pfLoadStaticDictionary: FindSpecialXTs", Result);\r
829 goto error;\r
830 }\r
831 }\r
832\r
833 return (PForthDictionary) dic;\r
834\r
835error:\r
836 return NULL;\r
837\r
838nomem_error:\r
839 pfReportError("pfLoadStaticDictionary", PF_ERR_NO_MEM);\r
840#endif /* PF_STATIC_DIC */\r
841\r
842 return NULL;\r
843}\r
844\r
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.