git.gag.com Git - debian/pforth/blob - 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 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
  44 Dictionary File Format based on IFF standard.\r
  45 The chunk IDs, sizes, and data values are all Big Endian in conformance with the IFF standard.\r
  46 The dictionaries may be big or little endian.\r
  47         'FORM'\r
  48         size\r
  49         'P4TH'  -  Form Identifier\r
  50 \r
  51 Chunks\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
  68 uint32 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
  80 uint16 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
  87 uint32 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
  99 uint16 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
 108 static void ReverseCopyFloat( const PF_FLOAT *src, PF_FLOAT *dst );\r
 109 \r
 110 static 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
 123 void 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
 136 PF_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
 151 void 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
 164 PF_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
 181 void 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
 192 void 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
 201 void 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
 211 void 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
 221 int 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
 230 int32 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
 244 static 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
 256 static 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
 269 error:\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
 279 int32 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
 410 error:\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
 428 static 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
 440 PForthDictionary 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
 454 DBUG(("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
 648 DBUG(("pfLoadDictionary: return 0x%x\n", dic));\r
 649         return (PForthDictionary) dic;\r
 650 \r
 651 nomem_error:\r
 652         pfReportError("pfLoadDictionary", PF_ERR_NO_MEM);\r
 653         sdCloseFile( fid );\r
 654         return NULL;\r
 655 \r
 656 read_error:\r
 657         pfReportError("pfLoadDictionary", PF_ERR_READ_FILE);\r
 658 error:\r
 659         sdCloseFile( fid );\r
 660 xt_error:\r
 661         return NULL;\r
 662 }\r
 663 \r
 664 #else\r
 665 \r
 666 PForthDictionary 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
 677 PForthDictionary 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
 749 error:\r
 750         return NULL;\r
 751 \r
 752 nomem_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