projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
V25 with 64-bit support
[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
346/****************************************************************\r
347** Save Dictionary in File.\r
348** If EntryPoint is NULL, save as development environment.\r
349** If EntryPoint is non-NULL, save as turnKey environment with no names.\r
350*/\r
1cb310e6 351cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
bb6b2dcd 352{\r
353 FileStream *fid;\r
354 DictionaryInfoChunk SD;\r
1cb310e6 355 uint32_t FormSize;\r
356 uint32_t NameChunkSize = 0;\r
357 uint32_t CodeChunkSize;\r
358 uint32_t relativeCodePtr;\r
bb6b2dcd 359 int i;\r
360\r
361 fid = sdOpenFile( FileName, "wb" );\r
362 if( fid == NULL )\r
363 {\r
364 pfReportError("pfSaveDictionary", PF_ERR_OPEN_FILE);\r
365 return -1;\r
366 }\r
367\r
368/* Save in uninitialized form. */\r
369 pfExecIfDefined("AUTO.TERM");\r
370\r
371/* Write FORM Header ---------------------------- */\r
1cb310e6 372 if( Write32ToFile( fid, ID_FORM ) < 0 ) goto error;\r
373 if( Write32ToFile( fid, 0 ) < 0 ) goto error;\r
374 if( Write32ToFile( fid, ID_P4TH ) < 0 ) goto error;\r
bb6b2dcd 375\r
376/* Write P4DI Dictionary Info ------------------ */\r
377 SD.sd_Version = PF_FILE_VERSION;\r
378\r
1cb310e6 379 relativeCodePtr = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */\r
380 SD.sd_RelCodePtr = relativeCodePtr; \r
381 SD.sd_UserStackSize = sizeof(cell_t) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);\r
382 SD.sd_ReturnStackSize = sizeof(cell_t) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);\r
bb6b2dcd 383 SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */\r
384\r
385#ifdef PF_SUPPORT_FP\r
386 SD.sd_FloatSize = sizeof(PF_FLOAT); /* Must match compiled dictionary. */\r
387#else\r
388 SD.sd_FloatSize = 0;\r
389#endif\r
390\r
1cb310e6 391 SD.sd_CellSize = sizeof(cell_t);\r
bb6b2dcd 392\r
1cb310e6 393/* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */\r
bb6b2dcd 394 {\r
395#if defined(PF_BIG_ENDIAN_DIC)\r
396 int eflag = SD_F_BIG_ENDIAN_DIC;\r
397#elif defined(PF_LITTLE_ENDIAN_DIC)\r
398 int eflag = 0;\r
399#else\r
400 int eflag = IsHostLittleEndian() ? 0 : SD_F_BIG_ENDIAN_DIC;\r
401#endif\r
402 SD.sd_Flags = eflag;\r
403 }\r
404\r
405 if( EntryPoint )\r
406 {\r
407 SD.sd_EntryPoint = EntryPoint; /* Turnkey! */\r
408 }\r
409 else\r
410 {\r
411 SD.sd_EntryPoint = 0;\r
412 }\r
413\r
414/* Do we save names? */\r
415 if( NameSize == 0 )\r
416 {\r
417 SD.sd_RelContext = 0;\r
418 SD.sd_RelHeaderPtr = 0;\r
419 SD.sd_NameSize = 0;\r
420 }\r
421 else\r
422 {\r
1cb310e6 423 uint32_t relativeHeaderPtr;\r
bb6b2dcd 424/* Development mode. */\r
425 SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);\r
1cb310e6 426 relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr.Byte);\r
427 SD.sd_RelHeaderPtr = relativeHeaderPtr;\r
bb6b2dcd 428\r
429/* How much real name space is there? */\r
1cb310e6 430 NameChunkSize = QUADUP(relativeHeaderPtr); /* Align */\r
bb6b2dcd 431\r
432/* NameSize must be 0 or greater than NameChunkSize + 1K */\r
433 NameSize = QUADUP(NameSize); /* Align */\r
434 if( NameSize > 0 )\r
435 {\r
436 NameSize = MAX( NameSize, (NameChunkSize + 1024) );\r
437 }\r
438 SD.sd_NameSize = NameSize;\r
439 }\r
440\r
441/* How much real code is there? */\r
1cb310e6 442 CodeChunkSize = QUADUP(relativeCodePtr);\r
bb6b2dcd 443 CodeSize = QUADUP(CodeSize); /* Align */\r
444 CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );\r
445 SD.sd_CodeSize = CodeSize;\r
446\r
447 \r
1cb310e6 448/* Convert all fields in DictionaryInfoChunk from Native to BigEndian. \r
449 * This assumes they are all 32-bit integers.\r
450 */\r
bb6b2dcd 451 {\r
1cb310e6 452 uint32_t *p = (uint32_t *) &SD;\r
453 for( i=0; i<((int)(sizeof(SD)/sizeof(uint32_t))); i++ )\r
454 {\r
455 Write32BigEndian( (uint8_t *)&p[i], p[i] );\r
456 }\r
bb6b2dcd 457 }\r
458\r
1cb310e6 459 if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
bb6b2dcd 460\r
461/* Write Name Fields if NameSize non-zero ------- */\r
462 if( NameSize > 0 )\r
463 {\r
1cb310e6 464 if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,\r
bb6b2dcd 465 NameChunkSize ) < 0 ) goto error;\r
466 }\r
467\r
468/* Write Code Fields ---------------------------- */\r
1cb310e6 469 if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,\r
bb6b2dcd 470 CodeChunkSize ) < 0 ) goto error;\r
471\r
472 FormSize = sdTellFile( fid ) - 8;\r
473 sdSeekFile( fid, 4, PF_SEEK_SET );\r
1cb310e6 474 if( Write32ToFile( fid, FormSize ) < 0 ) goto error;\r
bb6b2dcd 475\r
476 sdCloseFile( fid );\r
477\r
bb6b2dcd 478/* Restore initialization. */\r
bb6b2dcd 479 pfExecIfDefined("AUTO.INIT");\r
bb6b2dcd 480 return 0;\r
481\r
482error:\r
483 sdSeekFile( fid, 0, PF_SEEK_SET );\r
1cb310e6 484 Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */\r
bb6b2dcd 485 sdCloseFile( fid );\r
486\r
487/* Restore initialization. */\r
bb6b2dcd 488 pfExecIfDefined("AUTO.INIT");\r
489\r
490 return -1;\r
491}\r
492\r
493#endif /* !PF_NO_FILEIO and !PF_NO_SHELL */\r
494\r
495\r
496#ifndef PF_NO_FILEIO\r
497\r
498/***************************************************************/\r
1cb310e6 499static uint32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )\r
bb6b2dcd 500{\r
1cb310e6 501 int32_t numr;\r
502 uint8_t pad[4];\r
503 numr = sdReadFile( pad, 1, sizeof(pad), fid );\r
504 if( numr != sizeof(pad) ) return -1;\r
505 *ValPtr = Read32BigEndian( pad );\r
bb6b2dcd 506 return 0;\r
507}\r
508\r
509/***************************************************************/\r
510PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
511{\r
512 pfDictionary_t *dic = NULL;\r
513 FileStream *fid;\r
514 DictionaryInfoChunk *sd;\r
1cb310e6 515 uint32_t ChunkID;\r
516 uint32_t ChunkSize;\r
517 uint32_t FormSize;\r
518 uint32_t BytesLeft;\r
519 uint32_t numr;\r
bb6b2dcd 520 int i;\r
521 int isDicBigEndian;\r
522\r
523DBUG(("pfLoadDictionary( %s )\n", FileName ));\r
524\r
525/* Open file. */\r
526 fid = sdOpenFile( FileName, "rb" );\r
527 if( fid == NULL )\r
528 {\r
529 pfReportError("pfLoadDictionary", PF_ERR_OPEN_FILE);\r
530 goto xt_error;\r
531 }\r
532\r
533/* Read FORM, Size, ID */\r
1cb310e6 534 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
bb6b2dcd 535 if( ChunkID != ID_FORM )\r
536 {\r
537 pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);\r
538 goto error;\r
539 }\r
540\r
1cb310e6 541 if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;\r
bb6b2dcd 542 BytesLeft = FormSize;\r
543\r
1cb310e6 544 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
bb6b2dcd 545 BytesLeft -= 4;\r
546 if( ChunkID != ID_P4TH )\r
547 {\r
548 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE);\r
549 goto error;\r
550 }\r
551\r
552/* Scan and parse all chunks in file. */\r
553 while( BytesLeft > 0 )\r
554 {\r
1cb310e6 555 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
556 if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;\r
bb6b2dcd 557 BytesLeft -= 8;\r
558\r
1cb310e6 559 DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));\r
bb6b2dcd 560\r
561 switch( ChunkID )\r
562 {\r
563 case ID_P4DI:\r
564 sd = (DictionaryInfoChunk *) pfAllocMem( ChunkSize );\r
565 if( sd == NULL ) goto nomem_error;\r
566\r
567 numr = sdReadFile( sd, 1, ChunkSize, fid );\r
568 if( numr != ChunkSize ) goto read_error;\r
569 BytesLeft -= ChunkSize;\r
570 \r
571/* Convert all fields in structure from BigEndian to Native. */\r
bb6b2dcd 572 {\r
1cb310e6 573 uint32_t *p = (uint32_t *) sd;\r
574 for( i=0; i<((int)(sizeof(*sd)/sizeof(uint32_t))); i++ )\r
575 {\r
576 p[i] = Read32BigEndian( (uint8_t *)&p[i] );\r
577 }\r
bb6b2dcd 578 }\r
1cb310e6 579 \r
bb6b2dcd 580 isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;\r
581\r
582 if( !gVarQuiet )\r
583 {\r
584 MSG("pForth loading dictionary from file "); MSG(FileName);\r
585 EMIT_CR;\r
586 MSG_NUM_D(" File format version is ", sd->sd_Version );\r
587 MSG_NUM_D(" Name space size = ", sd->sd_NameSize );\r
588 MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );\r
589 MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );\r
1cb310e6 590 MSG_NUM_D(" Cell Size = ", sd->sd_CellSize );\r
bb6b2dcd 591 MSG( (isDicBigEndian ? " Big Endian Dictionary" :\r
592 " Little Endian Dictionary") );\r
593 if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");\r
594 EMIT_CR;\r
595 }\r
596\r
597 if( sd->sd_Version > PF_FILE_VERSION )\r
598 {\r
599 pfReportError("pfLoadDictionary", PF_ERR_VERSION_FUTURE );\r
600 goto error;\r
601 }\r
602 if( sd->sd_Version < PF_EARLIEST_FILE_VERSION )\r
603 {\r
604 pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );\r
605 goto error;\r
606 }\r
1cb310e6 607 if( sd->sd_CellSize != sizeof(cell_t) )\r
608 {\r
609 pfReportError("pfLoadDictionary", PF_ERR_CELL_SIZE_CONFLICT );\r
610 goto error;\r
611 }\r
bb6b2dcd 612 if( sd->sd_NumPrimitives > NUM_PRIMITIVES )\r
613 {\r
614 pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );\r
615 goto error;\r
616 }\r
617\r
618/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
619#if defined(PF_BIG_ENDIAN_DIC)\r
620 if(isDicBigEndian == 0)\r
621#elif defined(PF_LITTLE_ENDIAN_DIC)\r
622 if(isDicBigEndian == 1)\r
623#else\r
624 if( isDicBigEndian == IsHostLittleEndian() )\r
625#endif\r
626 {\r
627 pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );\r
628 goto error;\r
629 }\r
630\r
631/* Check for compatible float size. */\r
632#ifdef PF_SUPPORT_FP\r
633 if( sd->sd_FloatSize != sizeof(PF_FLOAT) )\r
634#else\r
635 if( sd->sd_FloatSize != 0 )\r
636#endif\r
637 {\r
638 pfReportError("pfLoadDictionary", PF_ERR_FLOAT_CONFLICT );\r
639 goto error;\r
640 }\r
641\r
642 dic = pfCreateDictionary( sd->sd_NameSize, sd->sd_CodeSize );\r
643 if( dic == NULL ) goto nomem_error;\r
644 gCurrentDictionary = dic;\r
645 if( sd->sd_NameSize > 0 )\r
646 {\r
647 gVarContext = (char *) NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */\r
1cb310e6 648 gCurrentDictionary->dic_HeaderPtr.Byte = (uint8_t *)\r
bb6b2dcd 649 NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);\r
650 }\r
651 else\r
652 {\r
653 gVarContext = 0;\r
654 gCurrentDictionary->dic_HeaderPtr.Byte = NULL;\r
655 }\r
1cb310e6 656 gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
bb6b2dcd 657 gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */\r
658/* Pass EntryPoint back to caller. */\r
659 if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;\r
660 pfFreeMem(sd);\r
661 break;\r
662\r
663 case ID_P4NM:\r
664#ifdef PF_NO_SHELL\r
665 pfReportError("pfLoadDictionary", PF_ERR_NO_SHELL );\r
666 goto error;\r
667#else\r
668 if( NAME_BASE == NULL )\r
669 {\r
670 pfReportError("pfLoadDictionary", PF_ERR_NO_NAMES );\r
671 goto error;\r
672 }\r
673 if( gCurrentDictionary == NULL )\r
674 {\r
675 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
676 goto error;\r
677 }\r
678 if( ChunkSize > NAME_SIZE )\r
679 {\r
680 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
681 goto error;\r
682 }\r
683 numr = sdReadFile( NAME_BASE, 1, ChunkSize, fid );\r
684 if( numr != ChunkSize ) goto read_error;\r
685 BytesLeft -= ChunkSize;\r
686#endif /* PF_NO_SHELL */\r
687 break;\r
688\r
689 case ID_P4CD:\r
690 if( gCurrentDictionary == NULL )\r
691 {\r
692 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
693 goto error;\r
694 }\r
695 if( ChunkSize > CODE_SIZE )\r
696 {\r
697 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);\r
698 goto error;\r
699 }\r
700 numr = sdReadFile( CODE_BASE, 1, ChunkSize, fid );\r
701 if( numr != ChunkSize ) goto read_error;\r
702 BytesLeft -= ChunkSize;\r
703 break;\r
704\r
705 default:\r
706 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );\r
707 sdSeekFile( fid, ChunkSize, PF_SEEK_CUR );\r
708 break;\r
709 }\r
710 }\r
711\r
712 sdCloseFile( fid );\r
713\r
714 if( NAME_BASE != NULL)\r
715 {\r
1cb310e6 716 cell_t Result;\r
bb6b2dcd 717/* Find special words in dictionary for global XTs. */\r
718 if( (Result = FindSpecialXTs()) < 0 )\r
719 {\r
720 pfReportError("pfLoadDictionary: FindSpecialXTs", Result);\r
721 goto error;\r
722 }\r
723 }\r
724\r
1cb310e6 725DBUG(("pfLoadDictionary: return %p\n", dic));\r
bb6b2dcd 726 return (PForthDictionary) dic;\r
727\r
728nomem_error:\r
729 pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);\r
730 sdCloseFile( fid );\r
731 return NULL;\r
732\r
733read_error:\r
734 pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);\r
735error:\r
736 sdCloseFile( fid );\r
737xt_error:\r
738 return NULL;\r
739}\r
740\r
741#else\r
742\r
743PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
744{\r
745 (void) FileName;\r
746 (void) EntryPointPtr;\r
747 return NULL;\r
748}\r
749#endif /* !PF_NO_FILEIO */\r
750\r
751\r
752\r
753/***************************************************************/\r
754PForthDictionary pfLoadStaticDictionary( void )\r
755{\r
756#ifdef PF_STATIC_DIC\r
1cb310e6 757 cell_t Result;\r
bb6b2dcd 758 pfDictionary_t *dic;\r
1cb310e6 759 cell_t NewNameSize, NewCodeSize;\r
bb6b2dcd 760 \r
761 if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
762 {\r
763 MSG( (IF_LITTLE_ENDIAN ?\r
764 "Little Endian Dictionary on " :\r
765 "Big Endian Dictionary on ") );\r
766 MSG( (IsHostLittleEndian() ?\r
767 "Little Endian CPU" :\r
768 "Big Endian CPU") );\r
769 EMIT_CR;\r
770 }\r
771 \r
772/* Check to make sure that EndianNess of dictionary matches mode of pForth. */\r
773#if defined(PF_BIG_ENDIAN_DIC)\r
774 if(IF_LITTLE_ENDIAN == 1)\r
775#elif defined(PF_LITTLE_ENDIAN_DIC)\r
776 if(IF_LITTLE_ENDIAN == 0)\r
777#else /* Code is native endian! */\r
778 if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )\r
779#endif\r
780 {\r
781 pfReportError("pfLoadStaticDictionary", PF_ERR_ENDIAN_CONFLICT );\r
782 goto error;\r
783 }\r
784\r
785\r
786#ifndef PF_EXTRA_HEADERS\r
787 #define PF_EXTRA_HEADERS (20000)\r
788#endif\r
789#ifndef PF_EXTRA_CODE\r
790 #define PF_EXTRA_CODE (40000)\r
791#endif\r
792\r
793/* Copy static const data to allocated dictionaries. */\r
794 NewNameSize = sizeof(MinDicNames) + PF_EXTRA_HEADERS;\r
795 NewCodeSize = sizeof(MinDicCode) + PF_EXTRA_CODE;\r
796\r
797 DBUG_NUM_D( "static dic name size = ", NewNameSize );\r
798 DBUG_NUM_D( "static dic code size = ", NewCodeSize );\r
799 \r
800 gCurrentDictionary = dic = pfCreateDictionary( NewNameSize, NewCodeSize );\r
801 if( !dic ) goto nomem_error;\r
802\r
803 pfCopyMemory( dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );\r
804 pfCopyMemory( dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );\r
1cb310e6 805 DBUG(("Static data copied to newly allocated dictionaries.\n"));\r
bb6b2dcd 806\r
1cb310e6 807 dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);\r
bb6b2dcd 808 gNumPrimitives = NUM_PRIMITIVES;\r
809\r
810 if( NAME_BASE != NULL)\r
811 {\r
812/* Setup name space. */\r
1cb310e6 813 dic->dic_HeaderPtr.Byte = (uint8_t *) NAMEREL_TO_ABS(HEADERPTR);\r
bb6b2dcd 814 gVarContext = (char *) NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */\r
815\r
816/* Find special words in dictionary for global XTs. */\r
817 if( (Result = FindSpecialXTs()) < 0 )\r
818 {\r
819 pfReportError("pfLoadStaticDictionary: FindSpecialXTs", Result);\r
820 goto error;\r
821 }\r
822 }\r
823\r
824 return (PForthDictionary) dic;\r
825\r
826error:\r
827 return NULL;\r
828\r
829nomem_error:\r
830 pfReportError("pfLoadStaticDictionary", PF_ERR_NO_MEM);\r
831#endif /* PF_STATIC_DIC */\r
832\r
833 return NULL;\r
834}\r
835\r
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.