/* +-------+-----------------+------+-----------------+-------+-----------------+ |Program| SAVE_4TH.C |Header| 4TH.H |Library| 4TH | +-------+-----------------+------+-----------------+-------+----------+------+ |HISTORY | Programmer | Date | +--------------------------------------------------+------------------+------+ | Turbo C V2.0 version | J.L. Bezemer |210495| | Linux V2.2.10 version | J.L. Bezemer |190600| +--------------------------------------------------+------------------+------+ |MODIFICATION LOG | Programmer | Date | +--------------------------------------------------+------------------+------+ | Added ErrLin4th | J.L. Bezemer |030595| | Added support for Hcode | J.L. Bezemer |120296| | Added SaveBlock() | J.L. Bezemer |130396| | Removed SaveBlock(); added SaveByte(), SaveCell()| J.L. Bezemer |100496| | Added SaveInfo(), SaveHeader() and SaveCode() | J.L. Bezemer |100496| | Added SaveString() | J.L. Bezemer |100496| | Rewrote in order to accomodate new Hcode format | J.L. Bezemer |021096| | Renamed Appl4th to App4th | J.L. Bezemer |031296| | Added LOCAL_H support | J.L. Bezemer |220597| | Removed and | J.L. Bezemer |250797| | Added BRANCHXT; changed header fieldname | J.L. Bezemer |120997| | Removed BRANCHXT | J.L. Bezemer |170997| | Added QDO | J.L. Bezemer |151097| | Removed EasyC syntax | J.L. Bezemer |150198| | Checks open file before closing | J.L. Bezemer |180298| | Added SQUOTE | J.L. Bezemer |200298| | Added SaveValue(); more compact HX format | J.L. Bezemer |140999| | Cleaned up encoding constants | J.L. Bezemer |150999| | Fixed serious bug in SaveCell() | J.L. Bezemer |111099| | Always return CodeSiz in ErrLine | J.L. Bezemer |031199| | Fixed major bug; CSOut now properly initialized | J.L. Bezemer |111199| | Fixed small error in K&R prototype | J.L. Bezemer |291299| | Fixed some Linux warnings (no need; code is OK) | J.L. Bezemer |190600| | Added CELLD, STRINGD; removed NOOP | J.L. Bezemer |060603| | Added SaveUnit(), SaveHX() and store_4th() | J.L. Bezemer |230603| | Fixed tiny bug in SaveEmbedByte() | J.L. Bezemer |010703| | Added VECTOR | J.L. Bezemer |011203| | Added dormant HX support | J.L. Bezemer |050104| | Added hidden variables support | J.L. Bezemer |120304| | Changed 'n' to unsigned in SaveString() | J.L. Bezemer |231205| | Added ENVIRON | J.L. Bezemer |110106| | Added PLITERAL | J.L. Bezemer |130106| | Added RADIX, OFFSET | J.L. Bezemer |201207| +--------------------------------------------------+------------------+------+ |REMARKS | Programmer | Date | +--------------------------------------------------+------------------+------+ | None | | | +--------------------------------------------------+------------------+------+ Copyright (C) 1997,2006 J.L. Bezemer This file is part of 4tH 4tH is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. This routine writes the contents of an object to disk. It can then be loaded with load_4th(). The object is pointed to by Program, filename must contain a valid filename. Prototype: void save_4th (Hcode *Program, char *filename) Returns : nothing Memory : none Example : #include "4th.h" #include #ifndef ARCHAIC int main (int argc, char **argv) #else int main (argc, argv) int argc; char **argv; #endif { Hcode *object; char *sources; if (argc == 2) { if ((sources = open_4th (argv [1])) == NULL) printf ("Loading; \'%s\' does not exist or too large\n", argv [1]); else { object = comp_4th (sources); if (object) printf ("Compile; word %u: %s\n", object->ErrLine, errs_4th [object->ErrNo]); save_4th (object, "out.hx"); return (object->ErrNo ? EXIT_FAILURE : EXIT_SUCCESS); } } return (EXIT_FAILURE); } Input : None Output : depends on program Related : dump_4th(), exec_4th() */ #ifdef USRLIB4TH #include <4th.h> #include #else #include "4th.h" #include "cmds_4th.h" #endif #define SaveCheck() SaveUnit(CSOut) static FILE* HXOut; /* pointer to HX-file */ static size_t MaxBytes; /* size of array */ static size_t Stored; static unit* BytecodeOut; /* pointer to embedded HX */ static int CSOut; /* checksum */ static unsigned* SaveErr; #ifndef ARCHAIC static void (*SaveByte) (int Value); /* save function (K&R) */ #else static void (*SaveByte) (Value) int Value; /* save function (ANSI) */ #endif /* This low level function only saves a byte to the HX-file. In fact a dedicated version of fputc(). */ #ifndef ARCHAIC static void SaveFileByte (int Value) #else static void SaveFileByte (Value) int Value; #endif { if (fputc (Value, HXOut) == EOF) *SaveErr = M4IOERR; } /* This low level function only saves a byte to embedded HX-code. */ #ifndef ARCHAIC static void SaveEmbedByte (int Value) #else static void SaveEmbedByte (Value) int Value; #endif { if (Stored < MaxBytes) { *(BytecodeOut++) = Value; Stored++; } else *SaveErr = M4NOMEM; } /* This function only saves a byte to the HX-file if there have been no errors up to now. Furthermore a checksum is generated. */ #ifndef ARCHAIC static void SaveUnit (int Value) #else static void SaveUnit (Value) int Value; #endif { if (! *SaveErr) { (*(SaveByte)) (Value); CSOut ^= Value; } } /* This function saves a value in tiny, small or full length. */ #ifndef ARCHAIC static void SaveValue (cell Value, size_t Max) #else static void SaveValue (Value, Max) cell Value; size_t Max; #endif { size_t n; for (n = 0 ; n < Max; n++) { /* save each byte */ SaveUnit ((int) (Value & (cell) HMASK)); Value >>= HBITS; /* get the next byte */ } } /* This function saves an integer value up to the size of a cell to an HX-file. Like Forth, its components are broken up into an non-negative number and a sign-byte. */ #ifndef ARCHAIC static void SaveCell (cell Value) #else static void SaveCell (Value) cell Value; #endif { int Sign; /* handle special cases first */ if (Value == -1L) SaveUnit (HCONE | HSNEG); else if (Value == 0L) SaveUnit (HCZERO | HSPOS); else if (Value == 1L) SaveUnit (HCONE | HSPOS); else if (Value == CELL_MIN) SaveUnit (HCZERO | HSNEG); else { if ((Sign = (Value < 0 ? HSNEG : HSPOS)) == TRUE) Value = -Value; /* take care of the sign */ if (Value <= (cell) HNTINY) { /* this fits in a byte */ SaveUnit (HCBYTE | Sign); SaveValue (Value, sizeof (char)); } else if (Value <= (cell) HNSMALL) { /* this fits in a short */ SaveUnit (HCSHRT | Sign); SaveValue (Value, sizeof (short)); } else { /* this number needs full cell */ SaveUnit (HCCELL | Sign); SaveValue (Value, sizeof (cell)); } } } /* This function saves all info which identifies the HX-program. */ #ifndef ARCHAIC static void SaveInfo (void) #else static void SaveInfo () #endif { SaveUnit (sizeof (char)); SaveUnit (sizeof (short)); SaveUnit (sizeof (cell)); SaveCell (CELL_MAX); /* save sizes of numbers */ SaveCell ((cell) Version4th); /* save version info */ SaveCell ((cell) App4th); } /* This function saves all information which describes the programs runtime- environment. */ #ifndef ARCHAIC static void SaveHeader (Hcode* ObjHead) #else static void SaveHeader (ObjHead) Hcode* ObjHead; #endif { SaveCell ((cell) ObjHead->CodeSiz); SaveCell ((cell) ObjHead->StringSiz); SaveCell ((cell) ObjHead->Offset); SaveCell ((cell) ObjHead->Variables); SaveCell ((cell) ObjHead->Strings); } /* This function saves the program-code in a condensed format. Only those words which need an argument have their arguments saved. */ #ifndef ARCHAIC static void SaveCode (Hcode* ObjCode) #else static void SaveCode (ObjCode) Hcode* ObjCode; #endif { int n; for (n = 0; n < ObjCode->CodeSiz; n++) { SaveUnit ((int) ObjCode->CodeSeg [n].Word); switch (ObjCode->CodeSeg [n].Word) { case (VARIABLE): case (VALUE): case (ENVIRON): case (VECTOR): case (TO): case (CELLD): case (STRINGD): case (LITERAL): case (PLITERAL): case (PRINT): case (SQUOTE): case (BRANCH): case (BRANCH0): case (QDO): case (LOOP): case (PLOOP): case (RADIX): case (OFFSET): case (CALL): SaveCell (ObjCode->CodeSeg [n].Value); break; } } } /* This function simply saves the contents of the StringSegment. */ #ifndef ARCHAIC static void SaveString (Hcode* ObjStr) #else static void SaveString (ObjStr) Hcode* ObjStr; #endif { unsigned n; for (n = 0; n < ObjStr->StringSiz; n++) SaveUnit ((int) ObjStr->StringSeg [n]); } /* This function simply saves the contents of the Environment. */ #ifndef ARCHAIC static void SaveEnv (Hcode* ObjEnv) #else static void SaveEnv (ObjEnv) Hcode* ObjEnv; #endif { int n; int u = ObjEnv->Strings + TIBSIZ + PADSIZ + 1; int c = ObjEnv->Variables + ObjEnv->Offset + STACKSIZ + SYS4TH; if (! ObjEnv->Offset) return; for (n = 0; n < u; n++) SaveUnit ((int) ObjEnv->UnitSeg [n]); for (n = 0; n < c; n++) SaveCell (ObjEnv->CellSeg [n]); } /* This function sets up some common variables and writes the HX code. */ #ifndef ARCHAIC static void SaveHX (Hcode* Obj) #else static void SaveHX (Obj) Hcode* Obj; #endif { CSOut = 0; /* reset checksum */ SaveErr = &(Obj->ErrNo); /* global pointer */ Obj->ErrNo = M4NOERRS; /* reset errors */ Obj->ErrLine = Obj->CodeSiz; /* signal all saved */ SaveInfo (); SaveHeader (Obj); SaveCode (Obj); SaveString (Obj); SaveEnv (Obj); SaveCheck (); } /* The API hook to write HX file. It sets up the proper parameters. It returns nothing. Be sure to check the ErrNo member. */ #ifndef ARCHAIC void save_4th (Hcode* Object, char* filename) #else void save_4th (Object, filename) Hcode* Object; char* filename; #endif { if (Object) /* check if object is reliable */ if (Object->Reliable) { if ((HXOut = fopen (filename, "wb")) == NULL) Object->ErrNo = M4IOERR; else { SaveByte = SaveFileByte; SaveHX (Object); if (fclose (HXOut)) Object->ErrNo = M4IOERR; } } } /* The API hook to write embedded HX code. It sets up the proper parameters. It returns the number of bytes written if (partially) successful, otherwise zero. Be sure to check the ErrNo member. */ #ifndef ARCHAIC size_t store_4th (Hcode* Object, unit *Memory, size_t Limit) #else size_t store_4th (Object, Memory, Limit) Hcode* Object; char* Memory; size_t Limit; #endif { if (Object) /* check if object is reliable */ if (Object->Reliable) { Stored = 0; MaxBytes = Limit; BytecodeOut = Memory; SaveByte = SaveEmbedByte; SaveHX (Object); return (Stored); } return (0); }