Add support for DELETE-FILE from Aleksej.
[debian/pforth] / csrc / pf_save.c
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
27 ** 000623 PLB Cast chars as ucell_t before shifting for 16 bit systems.\r
28 ***************************************************************/\r
29 \r
30 #include <assert.h>\r
31 \r
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
46 Dictionary File Format based on IFF standard.\r
47 The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.\r
48 The dictionaries may be big or little endian.\r
49         'FORM'\r
50         size\r
51         'P4TH'  -  Form Identifier\r
52 \r
53 Chunks\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
70 ucell_t ReadCellBigEndian( const uint8_t *addr )\r
71 {\r
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
84         return temp;\r
85 }\r
86 /***************************************************************/\r
87 /* Endian-ness tools. */\r
88 uint32_t Read32BigEndian( const uint8_t *addr )\r
89 {\r
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
95 }\r
96 \r
97 /***************************************************************/\r
98 uint16_t Read16BigEndian( const uint8_t *addr )\r
99 {\r
100         return (uint16_t) ((addr[0]<<8) | addr[1]);\r
101 }\r
102 \r
103 /***************************************************************/\r
104 ucell_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
118         return temp;\r
119 }\r
120 \r
121 /***************************************************************/\r
122 uint32_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
132 uint16_t Read16LittleEndian( const uint8_t *addr )\r
133 {\r
134         const unsigned char *bp = (const unsigned char *) addr;\r
135         return (uint16_t) ((bp[1]<<8) | bp[0]);\r
136 }\r
137 \r
138 #ifdef PF_SUPPORT_FP\r
139 \r
140 /***************************************************************/\r
141 static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );\r
142 \r
143 static 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
156 void 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
169 PF_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
184 void 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
197 PF_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
214 void WriteCellBigEndian( uint8_t *addr, ucell_t data )\r
215 {\r
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
229 }\r
230 \r
231 /***************************************************************/\r
232 void Write32BigEndian( uint8_t *addr, uint32_t data )\r
233 {\r
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
238 }\r
239 \r
240 /***************************************************************/\r
241 void Write16BigEndian( uint8_t *addr, uint16_t data )\r
242 {\r
243         *addr++ = (uint8_t) (data>>8);\r
244         *addr = (uint8_t) (data);\r
245 }\r
246 \r
247 /***************************************************************/\r
248 void 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
270 }\r
271 /***************************************************************/\r
272 void Write32LittleEndian( uint8_t *addr, uint32_t data )\r
273 {\r
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
282 \r
283 /***************************************************************/\r
284 void 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
289 }\r
290 \r
291 /***************************************************************/\r
292 /* Return 1 if host CPU is Little Endian */\r
293 int 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
302 cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
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
316 static int Write32ToFile( FileStream *fid, uint32_t Val )\r
317 {\r
318         int numw;\r
319         uint8_t pad[4];\r
320 \r
321         Write32BigEndian(pad,Val);\r
322         numw = sdWriteFile( pad, 1, sizeof(pad), fid );\r
323         if( numw != sizeof(pad) ) return -1;\r
324         return 0;\r
325 }\r
326 \r
327 /***************************************************************/\r
328 static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t NumBytes )\r
329 {\r
330         cell_t numw;\r
331         cell_t EvenNumW;\r
332 \r
333         EvenNumW = EVENUP(NumBytes);\r
334 \r
335         if( Write32ToFile( fid, ID ) < 0 ) goto error;\r
336         if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error;\r
337 \r
338         numw = sdWriteFile( Data, 1, EvenNumW, fid );\r
339         if( numw != EvenNumW ) goto error;\r
340         return 0;\r
341 error:\r
342         pfReportError("WriteChunkToFile", PF_ERR_WRITE_FILE);\r
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
351 cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize, cell_t CodeSize)\r
352 {\r
353         FileStream *fid;\r
354         DictionaryInfoChunk SD;\r
355         uint32_t FormSize;\r
356         uint32_t NameChunkSize = 0;\r
357         uint32_t CodeChunkSize;\r
358         uint32_t relativeCodePtr;\r
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
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
375 \r
376 /* Write P4DI Dictionary Info  ------------------ */\r
377         SD.sd_Version = PF_FILE_VERSION;\r
378 \r
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
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
391         SD.sd_CellSize = sizeof(cell_t);\r
392 \r
393 /* Set bit that specifies whether dictionary is BIG or LITTLE Endian. */\r
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
423                 uint32_t relativeHeaderPtr;\r
424 /* Development mode. */\r
425                 SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);\r
426                 relativeHeaderPtr = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr);\r
427                 SD.sd_RelHeaderPtr = relativeHeaderPtr;\r
428 \r
429 /* How much real name space is there? */\r
430                 NameChunkSize = QUADUP(relativeHeaderPtr);  /* Align */\r
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
442         CodeChunkSize = QUADUP(relativeCodePtr);\r
443         CodeSize = QUADUP(CodeSize);  /* Align */\r
444         CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );\r
445         SD.sd_CodeSize = CodeSize;\r
446 \r
447         \r
448 /* Convert all fields in DictionaryInfoChunk from Native to BigEndian. \r
449  * This assumes they are all 32-bit integers.\r
450  */\r
451         {\r
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
457         }\r
458 \r
459         if( WriteChunkToFile( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;\r
460 \r
461 /* Write Name Fields if NameSize non-zero ------- */\r
462         if( NameSize > 0 )\r
463         {\r
464                 if( WriteChunkToFile( fid, ID_P4NM, (char *) NAME_BASE,\r
465                         NameChunkSize ) < 0 ) goto error;\r
466         }\r
467 \r
468 /* Write Code Fields ---------------------------- */\r
469         if( WriteChunkToFile( fid, ID_P4CD, (char *) CODE_BASE,\r
470                 CodeChunkSize ) < 0 ) goto error;\r
471 \r
472         FormSize = sdTellFile( fid ) - 8;\r
473         sdSeekFile( fid, 4, PF_SEEK_SET );\r
474         if( Write32ToFile( fid, FormSize ) < 0 ) goto error;\r
475 \r
476         sdCloseFile( fid );\r
477 \r
478 /* Restore initialization. */\r
479         pfExecIfDefined("AUTO.INIT");\r
480         return 0;\r
481 \r
482 error:\r
483         sdSeekFile( fid, 0, PF_SEEK_SET );\r
484         Write32ToFile( fid, ID_BADF ); /* Mark file as bad. */\r
485         sdCloseFile( fid );\r
486 \r
487 /* Restore initialization. */\r
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
499 static uint32_t Read32FromFile( FileStream *fid, uint32_t *ValPtr )\r
500 {\r
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
506         return 0;\r
507 }\r
508 \r
509 /***************************************************************/\r
510 PForthDictionary pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )\r
511 {\r
512         pfDictionary_t *dic = NULL;\r
513         FileStream *fid;\r
514         DictionaryInfoChunk *sd;\r
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
520         int   i;\r
521         int   isDicBigEndian;\r
522 \r
523 DBUG(("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
534         if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
535         if( ChunkID != ID_FORM )\r
536         {\r
537                 pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);\r
538                 goto error;\r
539         }\r
540 \r
541         if (Read32FromFile( fid, &FormSize ) < 0) goto read_error;\r
542         BytesLeft = FormSize;\r
543 \r
544         if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
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
555                 if (Read32FromFile( fid, &ChunkID ) < 0) goto read_error;\r
556                 if (Read32FromFile( fid, &ChunkSize ) < 0) goto read_error;\r
557                 BytesLeft -= 8;\r
558 \r
559                 DBUG(("ChunkID = %4s, Size = %d\n", (char *)&ChunkID, ChunkSize ));\r
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
572                         {\r
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
578                         }\r
579                                 \r
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
590                                 MSG_NUM_D("     Cell Size       = ", sd->sd_CellSize );\r
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
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
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
648                                 gCurrentDictionary->dic_HeaderPtr = (ucell_t)(uint8_t *)\r
649                                         NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);\r
650                         }\r
651                         else\r
652                         {\r
653                                 gVarContext = 0;\r
654                                 gCurrentDictionary->dic_HeaderPtr = (ucell_t)NULL;\r
655                         }\r
656                         gCurrentDictionary->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(sd->sd_RelCodePtr);\r
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
716                 cell_t Result;\r
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
725 DBUG(("pfLoadDictionary: return %p\n", dic));\r
726         return (PForthDictionary) dic;\r
727 \r
728 nomem_error:\r
729         pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);\r
730         sdCloseFile( fid );\r
731         return NULL;\r
732 \r
733 read_error:\r
734         pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);\r
735 error:\r
736         sdCloseFile( fid );\r
737 xt_error:\r
738         return NULL;\r
739 }\r
740 \r
741 #else\r
742 \r
743 PForthDictionary 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
754 PForthDictionary pfLoadStaticDictionary( void )\r
755 {\r
756 #ifdef PF_STATIC_DIC\r
757         cell_t Result;\r
758         pfDictionary_t *dic;\r
759         cell_t NewNameSize, NewCodeSize;\r
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
805         DBUG(("Static data copied to newly allocated dictionaries.\n"));\r
806 \r
807         dic->dic_CodePtr.Byte = (uint8_t *) CODEREL_TO_ABS(CODEPTR);\r
808         gNumPrimitives = NUM_PRIMITIVES;\r
809 \r
810         if( NAME_BASE != NULL)\r
811         {\r
812 /* Setup name space. */\r
813                 dic->dic_HeaderPtr = (ucell_t)(uint8_t *) NAMEREL_TO_ABS(HEADERPTR);\r
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
826 error:\r
827         return NULL;\r
828 \r
829 nomem_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