1 /* @(#) pf_save.c 98/01/26 1.3 */
2 /***************************************************************
3 ** Save and Load Dictionary
4 ** for PForth based on 'C'
6 ** Compile file based version or static data based version
7 ** depending on PF_NO_FILEIO switch.
10 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
12 ** The pForth software code is dedicated to the public domain,
13 ** and any third party may reproduce, distribute and modify
14 ** the pForth software code or any derivative works thereof
15 ** without any compensation or license. The pForth software
16 ** code is provided on an "as is" basis without any warranty
17 ** of any kind, including, without limitation, the implied
18 ** warranties of merchantability and fitness for a particular
19 ** purpose and their equivalents under the laws of any jurisdiction.
21 ****************************************************************
22 ** 940225 PLB Fixed CodePtr save, was using NAMEREL instead of CODEREL
23 ** This would only work if the relative location
24 ** of names and code was the same when saved and reloaded.
25 ** 940228 PLB Added PF_NO_FILEIO version
26 ** 961204 PLB Added PF_STATIC_DIC
27 ***************************************************************/
31 int IsHostLittleEndian( void );
\r
33 /* If no File I/O, then force static dictionary. */
41 Dictionary File Format based on IFF standard.
42 The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.
\r
43 The dictionaries may be big or little endian.
46 'P4TH' - Form Identifier
51 struct DictionaryInfoChunk
55 Name and Header portion of dictionary. (Big or Little Endian) (Optional)
59 Code portion of dictionary. (Big or Little Endian)
63 /***************************************************************/
\r
64 /* Endian-ness tools. */
\r
65 uint32 ReadLongBigEndian( const uint32 *addr )
\r
67 const unsigned char *bp = (const unsigned char *) addr;
\r
68 return (bp[0]<<24) | (bp[1]<<16) | (bp[2]<<8) | bp[3];
\r
70 /***************************************************************/
\r
71 uint16 ReadShortBigEndian( const uint16 *addr )
\r
73 const unsigned char *bp = (const unsigned char *) addr;
\r
74 return (uint16) ((bp[0]<<8) | bp[1]);
\r
77 /***************************************************************/
\r
78 uint32 ReadLongLittleEndian( const uint32 *addr )
\r
80 const unsigned char *bp = (const unsigned char *) addr;
\r
81 return (bp[3]<<24) | (bp[2]<<16) | (bp[1]<<8) | bp[0];
\r
83 /***************************************************************/
\r
84 uint16 ReadShortLittleEndian( const uint16 *addr )
\r
86 const unsigned char *bp = (const unsigned char *) addr;
\r
87 return (uint16) ((bp[1]<<8) | bp[0]);
\r
90 #ifdef PF_SUPPORT_FP
\r
92 /***************************************************************/
\r
93 static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );
\r
95 static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst )
\r
98 unsigned char *d = (unsigned char *) dst;
\r
99 const unsigned char *s = (const unsigned char *) src;
\r
101 for( i=0; i<sizeof(PF_FLOAT); i++ )
\r
103 d[i] = s[sizeof(PF_FLOAT) - 1 - i];
\r
107 /***************************************************************/
\r
108 void WriteFloatBigEndian( PF_FLOAT *addr, PF_FLOAT data )
\r
110 if( IsHostLittleEndian() )
\r
112 ReverseCopyFloat( &data, addr );
\r
120 /***************************************************************/
\r
121 PF_FLOAT ReadFloatBigEndian( const PF_FLOAT *addr )
\r
124 if( IsHostLittleEndian() )
\r
126 ReverseCopyFloat( addr, &data );
\r
135 /***************************************************************/
\r
136 void WriteFloatLittleEndian( PF_FLOAT *addr, PF_FLOAT data )
\r
138 if( IsHostLittleEndian() )
\r
144 ReverseCopyFloat( &data, addr );
\r
148 /***************************************************************/
\r
149 PF_FLOAT ReadFloatLittleEndian( const PF_FLOAT *addr )
\r
152 if( IsHostLittleEndian() )
\r
158 ReverseCopyFloat( addr, &data );
\r
165 /***************************************************************/
\r
166 void WriteLongBigEndian( uint32 *addr, uint32 data )
\r
168 unsigned char *bp = (unsigned char *) addr;
\r
170 bp[0] = (unsigned char) (data>>24);
\r
171 bp[1] = (unsigned char) (data>>16);
\r
172 bp[2] = (unsigned char) (data>>8);
\r
173 bp[3] = (unsigned char) (data);
\r
176 /***************************************************************/
\r
177 void WriteShortBigEndian( uint16 *addr, uint16 data )
\r
179 unsigned char *bp = (unsigned char *) addr;
\r
181 bp[0] = (unsigned char) (data>>8);
\r
182 bp[1] = (unsigned char) (data);
\r
185 /***************************************************************/
\r
186 void WriteLongLittleEndian( uint32 *addr, uint32 data )
\r
188 unsigned char *bp = (unsigned char *) addr;
\r
190 bp[0] = (unsigned char) (data);
\r
191 bp[1] = (unsigned char) (data>>8);
\r
192 bp[2] = (unsigned char) (data>>16);
\r
193 bp[3] = (unsigned char) (data>>24);
\r
195 /***************************************************************/
\r
196 void WriteShortLittleEndian( uint16 *addr, uint16 data )
\r
198 unsigned char *bp = (unsigned char *) addr;
\r
200 bp[0] = (unsigned char) (data);
\r
201 bp[1] = (unsigned char) (data>>8);
\r
204 /***************************************************************/
\r
205 /* Return 1 if host CPU is Little Endian */
\r
206 int IsHostLittleEndian( void )
\r
208 uint16 gEndianCheck = 1;
\r
209 unsigned char *bp = (unsigned char *) &gEndianCheck;
\r
210 return *bp; /* Return byte pointed to by address. If LSB then == 1 */
\r
213 #ifndef PF_STATIC_DIC
216 /***************************************************************/
217 static int32 WriteLong( FileStream *fid, int32 Val )
222 WriteLongBigEndian(&pad,Val);
223 numw = sdWriteFile( (char *) &pad, 1, sizeof(int32), fid );
224 if( numw != sizeof(int32) ) return -1;
228 /***************************************************************/
229 static int32 WriteChunk( FileStream *fid, int32 ID, char *Data, int32 NumBytes )
234 EvenNumW = EVENUP(NumBytes);
236 if( WriteLong( fid, ID ) < 0 ) goto error;
237 if( WriteLong( fid, EvenNumW ) < 0 ) goto error;
239 numw = sdWriteFile( Data, 1, EvenNumW, fid );
240 if( numw != EvenNumW ) goto error;
243 pfReportError("WriteChunk", PF_ERR_WRITE_FILE);
247 /****************************************************************
248 ** Save Dictionary in File.
249 ** If EntryPoint is NULL, save as development environment.
250 ** If EntryPoint is non-NULL, save as turnKey environment with no names.
252 int32 ffSaveForth( const char *FileName, ExecToken EntryPoint, int32 NameSize, int32 CodeSize)
255 DictionaryInfoChunk SD;
257 int32 NameChunkSize = 0;
258 int32 CodeChunkSize;
\r
263 fid = sdOpenFile( FileName, "wb" );
266 pfReportError("pfSaveDictionary", PF_ERR_OPEN_FILE);
270 /* Save in uninitialized form. */
271 pfExecByName("AUTO.TERM");
273 /* Write FORM Header ---------------------------- */
274 if( WriteLong( fid, ID_FORM ) < 0 ) goto error;
275 if( WriteLong( fid, 0 ) < 0 ) goto error;
276 if( WriteLong( fid, ID_P4TH ) < 0 ) goto error;
278 /* Write P4DI Dictionary Info ------------------ */
279 SD.sd_Version = PF_FILE_VERSION;
281 rcp = ABS_TO_CODEREL(gCurrentDictionary->dic_CodePtr.Byte); /* 940225 */
282 SD.sd_RelCodePtr = rcp;
283 SD.sd_UserStackSize = sizeof(cell) * (gCurrentTask->td_StackBase - gCurrentTask->td_StackLimit);
284 SD.sd_ReturnStackSize = sizeof(cell) * (gCurrentTask->td_ReturnBase - gCurrentTask->td_ReturnLimit);
\r
285 SD.sd_NumPrimitives = gNumPrimitives; /* Must match compiled dictionary. */
\r
287 #ifdef PF_SUPPORT_FP
\r
288 SD.sd_FloatSize = sizeof(PF_FLOAT); /* Must match compiled dictionary. */
\r
290 SD.sd_FloatSize = 0;
\r
293 SD.sd_Reserved = 0;
\r
295 /* Set bit that specifiec whether dictionary is BIG or LITTLE Endian. */
\r
297 #if defined(PF_BIG_ENDIAN_DIC)
\r
298 int eflag = SD_F_BIG_ENDIAN_DIC;
\r
299 #elif defined(PF_LITTLE_ENDIAN_DIC)
\r
302 int eflag = IsHostLittleEndian() ? 0 : SD_F_BIG_ENDIAN_DIC;
\r
304 SD.sd_Flags = eflag;
\r
309 SD.sd_EntryPoint = EntryPoint; /* Turnkey! */
313 SD.sd_EntryPoint = 0;
316 /* Do we save names? */
319 SD.sd_RelContext = 0;
320 SD.sd_RelHeaderPtr = 0;
325 /* Development mode. */
326 SD.sd_RelContext = ABS_TO_NAMEREL(gVarContext);
\r
327 rhp = ABS_TO_NAMEREL(gCurrentDictionary->dic_HeaderPtr.Byte);
\r
328 SD.sd_RelHeaderPtr = rhp;
330 /* How much real name space is there? */
331 NameChunkSize = QUADUP(rhp); /* Align */
333 /* NameSize must be 0 or greater than NameChunkSize + 1K */
334 NameSize = QUADUP(NameSize); /* Align */
337 NameSize = MAX( NameSize, (NameChunkSize + 1024) );
339 SD.sd_NameSize = NameSize;
342 /* How much real code is there? */
343 CodeChunkSize = QUADUP(rcp);
344 CodeSize = QUADUP(CodeSize); /* Align */
345 CodeSize = MAX( CodeSize, (CodeChunkSize + 2048) );
346 SD.sd_CodeSize = CodeSize;
349 /* Convert all fields in structure from Native to BigEndian. */
\r
350 p = (uint32 *) &SD;
\r
351 for( i=0; i<((int)(sizeof(SD)/sizeof(int32))); i++ )
\r
353 WriteLongBigEndian( &p[i], p[i] );
\r
356 if( WriteChunk( fid, ID_P4DI, (char *) &SD, sizeof(DictionaryInfoChunk) ) < 0 ) goto error;
358 /* Write Name Fields if NameSize non-zero ------- */
361 if( WriteChunk( fid, ID_P4NM, (char *) NAME_BASE,
362 NameChunkSize ) < 0 ) goto error;
365 /* Write Code Fields ---------------------------- */
366 if( WriteChunk( fid, ID_P4CD, (char *) CODE_BASE,
367 CodeChunkSize ) < 0 ) goto error;
369 FormSize = sdTellFile( fid ) - 8;
370 sdSeekFile( fid, 4, PF_SEEK_SET );
371 if( WriteLong( fid, FormSize ) < 0 ) goto error;
377 /* Restore initialization. */
379 pfExecByName("AUTO.INIT");
384 sdSeekFile( fid, 0, PF_SEEK_SET );
385 WriteLong( fid, ID_BADF ); /* Mark file as bad. */
388 /* Restore initialization. */
390 pfExecByName("AUTO.INIT");
394 #endif /* !PF_NO_SHELL */
396 /***************************************************************/
397 static int32 ReadLong( FileStream *fid, int32 *ValPtr )
402 numr = sdReadFile( &temp, 1, sizeof(int32), fid );
403 if( numr != sizeof(int32) ) return -1;
\r
404 *ValPtr = ReadLongBigEndian( &temp );
408 /***************************************************************/
409 cfDictionary *pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )
411 cfDictionary *dic = NULL;
413 DictionaryInfoChunk *sd;
421 int isDicBigEndian;
\r
423 DBUG(("pfLoadDictionary( %s )\n", FileName ));
426 fid = sdOpenFile( FileName, "rb" );
429 pfReportError("pfLoadDictionary", PF_ERR_OPEN_FILE);
433 /* Read FORM, Size, ID */
434 if (ReadLong( fid, &ChunkID ) < 0) goto read_error;
435 if( ChunkID != ID_FORM )
437 pfReportError("pfLoadDictionary", PF_ERR_WRONG_FILE);
441 if (ReadLong( fid, &FormSize ) < 0) goto read_error;
442 BytesLeft = FormSize;
444 if (ReadLong( fid, &ChunkID ) < 0) goto read_error;
446 if( ChunkID != ID_P4TH )
448 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE);
452 /* Scan and parse all chunks in file. */
453 while( BytesLeft > 0 )
455 if (ReadLong( fid, &ChunkID ) < 0) goto read_error;
456 if (ReadLong( fid, &ChunkSize ) < 0) goto read_error;
459 DBUG(("ChunkID = %4s, Size = %d\n", &ChunkID, ChunkSize ));
464 sd = (DictionaryInfoChunk *) pfAllocMem( ChunkSize );
465 if( sd == NULL ) goto nomem_error;
467 numr = sdReadFile( sd, 1, ChunkSize, fid );
468 if( numr != ChunkSize ) goto read_error;
469 BytesLeft -= ChunkSize;
471 /* Convert all fields in structure from BigEndian to Native. */
\r
473 for( i=0; i<((int)(sizeof(*sd)/sizeof(int32))); i++ )
\r
475 p[i] = ReadLongBigEndian( &p[i] );
\r
478 isDicBigEndian = sd->sd_Flags & SD_F_BIG_ENDIAN_DIC;
\r
482 MSG("pForth loading dictionary from file "); MSG(FileName);
484 MSG_NUM_D(" File format version is ", sd->sd_Version );
485 MSG_NUM_D(" Name space size = ", sd->sd_NameSize );
486 MSG_NUM_D(" Code space size = ", sd->sd_CodeSize );
\r
487 MSG_NUM_D(" Entry Point = ", sd->sd_EntryPoint );
\r
488 MSG( (isDicBigEndian ? " Big Endian Dictionary" :
\r
489 " Little Endian Dictionary") );
\r
490 if( isDicBigEndian == IsHostLittleEndian() ) MSG(" !!!!");
\r
494 if( sd->sd_Version > PF_FILE_VERSION )
496 pfReportError("pfLoadDictionary", PF_ERR_VERSION_FUTURE );
499 if( sd->sd_Version < PF_EARLIEST_FILE_VERSION )
501 pfReportError("pfLoadDictionary", PF_ERR_VERSION_PAST );
504 if( sd->sd_NumPrimitives > NUM_PRIMITIVES )
506 pfReportError("pfLoadDictionary", PF_ERR_NOT_SUPPORTED );
510 /* Check to make sure that EndianNess of dictionary matches mode of pForth. */
\r
511 #if defined(PF_BIG_ENDIAN_DIC)
\r
512 if(isDicBigEndian == 0)
\r
513 #elif defined(PF_LITTLE_ENDIAN_DIC)
\r
514 if(isDicBigEndian == 1)
\r
516 if( isDicBigEndian == IsHostLittleEndian() )
\r
519 pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );
\r
523 /* Check for compatible float size. */
\r
524 #ifdef PF_SUPPORT_FP
\r
525 if( sd->sd_FloatSize != sizeof(PF_FLOAT) )
\r
527 if( sd->sd_FloatSize != 0 )
\r
530 pfReportError("pfLoadDictionary", PF_ERR_FLOAT_CONFLICT );
\r
534 dic = pfCreateDictionary( sd->sd_NameSize, sd->sd_CodeSize );
535 if( dic == NULL ) goto nomem_error;
536 gCurrentDictionary = dic;
537 if( sd->sd_NameSize > 0 )
539 gVarContext = (char *) NAMEREL_TO_ABS(sd->sd_RelContext); /* Restore context. */
540 gCurrentDictionary->dic_HeaderPtr.Byte = (uint8 *)
\r
541 NAMEREL_TO_ABS(sd->sd_RelHeaderPtr);
546 gCurrentDictionary->dic_HeaderPtr.Byte = NULL;
548 gCurrentDictionary->dic_CodePtr.Byte = (uint8 *) CODEREL_TO_ABS(sd->sd_RelCodePtr);
549 gNumPrimitives = sd->sd_NumPrimitives; /* Must match compiled dictionary. */
550 /* Pass EntryPoint back to caller. */
551 if( EntryPointPtr != NULL ) *EntryPointPtr = sd->sd_EntryPoint;
557 pfReportError("pfLoadDictionary", PF_ERR_NO_SHELL );
560 if( NAME_BASE == NULL )
562 pfReportError("pfLoadDictionary", PF_ERR_NO_NAMES );
565 if( gCurrentDictionary == NULL )
567 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
570 if( ChunkSize > NAME_SIZE )
572 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);
575 numr = sdReadFile( NAME_BASE, 1, ChunkSize, fid );
576 if( numr != ChunkSize ) goto read_error;
577 BytesLeft -= ChunkSize;
578 #endif /* PF_NO_SHELL */
582 if( gCurrentDictionary == NULL )
584 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
587 if( ChunkSize > CODE_SIZE )
589 pfReportError("pfLoadDictionary", PF_ERR_TOO_BIG);
592 numr = sdReadFile( CODE_BASE, 1, ChunkSize, fid );
593 if( numr != ChunkSize ) goto read_error;
594 BytesLeft -= ChunkSize;
598 pfReportError("pfLoadDictionary", PF_ERR_BAD_FILE );
599 sdSeekFile( fid, ChunkSize, PF_SEEK_CUR );
606 if( NAME_BASE != NULL)
609 /* Find special words in dictionary for global XTs. */
610 if( (Result = FindSpecialXTs()) < 0 )
612 pfReportError("pfLoadDictionary: FindSpecialXTs", Result);
617 DBUG(("pfLoadDictionary: return 0x%x\n", dic));
621 pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);
626 pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);
633 #else /* PF_STATIC_DIC ============================================== */
636 ** Dictionary must come from data array because there is no file I/O.
639 #include "pfdicdat.h"
642 int32 ffSaveForth( const char *FileName, ExecToken EntryPoint, int32 NameSize, int32 CodeSize)
649 pfReportError("ffSaveForth", PF_ERR_NOT_SUPPORTED);
654 /***************************************************************/
\r
655 cfDictionary *pfLoadDictionary( const char *FileName, ExecToken *EntryPointPtr )
\r
659 int32 NewNameSize, NewCodeSize;
\r
661 MSG("pfLoadDictionary - Filename ignored! Loading from static data.\n");
\r
664 TOUCH(EntryPointPtr);
666 /* Check to make sure that EndianNess of dictionary matches mode of pForth. */
\r
667 #if defined(PF_BIG_ENDIAN_DIC)
\r
668 if(IF_LITTLE_ENDIAN == 1)
\r
669 #elif defined(PF_LITTLE_ENDIAN_DIC)
\r
670 if(IF_LITTLE_ENDIAN == 0)
\r
672 if( IF_LITTLE_ENDIAN != IsHostLittleEndian() )
\r
675 pfReportError("pfLoadDictionary", PF_ERR_ENDIAN_CONFLICT );
\r
679 /* Static data too small. Copy it to larger array. */
\r
680 #ifndef PF_EXTRA_HEADERS
\r
681 #define PF_EXTRA_HEADERS (20000)
\r
683 #ifndef PF_EXTRA_CODE
\r
684 #define PF_EXTRA_CODE (40000)
\r
686 /* Copy static const data to allocated dictionaries. */
\r
687 NewNameSize = sizeof(MinDicNames) + PF_EXTRA_HEADERS;
\r
688 NewCodeSize = sizeof(MinDicCode) + PF_EXTRA_CODE;
\r
690 gCurrentDictionary = dic = pfCreateDictionary( NewNameSize, NewCodeSize );
\r
691 if( !dic ) goto nomem_error;
\r
693 pfCopyMemory( dic->dic_HeaderBase, MinDicNames, sizeof(MinDicNames) );
\r
694 pfCopyMemory( dic->dic_CodeBase, MinDicCode, sizeof(MinDicCode) );
\r
695 MSG("Static data copied to newly allocated dictionaries.\n");
\r
697 dic->dic_CodePtr.Byte = (uint8 *) CODEREL_TO_ABS(CODEPTR);
\r
698 gNumPrimitives = NUM_PRIMITIVES;
\r
700 if( NAME_BASE != NULL)
\r
702 /* Setup name space. */
\r
703 dic->dic_HeaderPtr.Byte = (uint8 *) NAMEREL_TO_ABS(HEADERPTR);
\r
704 gVarContext = (char *) NAMEREL_TO_ABS(RELCONTEXT); /* Restore context. */
\r
706 /* Find special words in dictionary for global XTs. */
\r
707 if( (Result = FindSpecialXTs()) < 0 )
\r
709 pfReportError("pfLoadDictionary: FindSpecialXTs", Result);
\r
717 pfReportError("pfLoadDictionary", -1);
\r
721 pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);
\r
726 #endif /* PF_STATIC_DIC */