projects / pforth / blame_incremental
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
V25 with 64-bit support
[pforth] / csrc / pf_save.c
... / ...
CommitLineData
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
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
70ucell_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
88uint32_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
98uint16_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
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
118 return temp;\r
119}\r
120\r
121/***************************************************************/\r
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
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
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
214void 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
232void 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
241void 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
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
270}\r
271/***************************************************************/\r
272void 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
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
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
302cell_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
316static 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
328static 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
341error:\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
351cell_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.Byte);\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
482error:\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
499static 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
510PForthDictionary 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
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
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.Byte = (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.Byte = 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
725DBUG(("pfLoadDictionary: return %p\n", dic));\r
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
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.Byte = (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
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.