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