/* boot.c
*
* COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
*
* This is the bootstrap loader for booting from .bin files.
*/
#include "ml-osdep.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include "ml-base.h"
#include "ml-limits.h"
#include "cache-flush.h"
#include "bin-file.h"
#include "ml-objects.h"
#include "gc.h"
#include "ml-globals.h"
#ifndef SEEK_SET
# define SEEK_SET 0
#endif
/* The persistent ID list is stored in the PervStruct refcell. It has
* the following ML type:
*
* datatype runDynEnv
* = NILrde
* | CONSrde of (Word8Vector.vector * Object.object * runDynEnv)
*/
#define PerIDList (*PTR_MLtoC(ml_val_t, PervStruct))
PVT ml_val_t BinFileList = LIST_nil; /* A list of bin files to load */
/* local routines */
PVT ml_val_t BuildFileList (ml_state_t *msp, const char *bootlist,
int *max_boot_path_len_ptr);
PVT FILE *OpenBinFile (const char *fname, bool_t isBinary);
PVT void ReadBinFile (FILE *file, void *buf, int nbytes, const char *fname);
PVT void LoadBinFile (ml_state_t *msp, char *fname);
PVT void EnterPerID (ml_state_t *msp, pers_id_t *perID, ml_val_t obj);
PVT ml_val_t LookupPerID (pers_id_t *perID);
PVT void ShowPerID (char *buf, pers_id_t *perID);
static int HEX(int c)
{
if (isdigit(c)) return c - '0';
if (c >= 'a' && c <= 'z') return c - 'a' + 10;
return c - 'A' + 10;
}
/* BootML:
*
* Boot the system using the items read from the "bootlist" file.
*/
void BootML (const char *bootlist, heap_params_t *heapParams)
{
ml_state_t *msp;
int max_boot_path_len;
char *fname;
int rts_init = 0;
msp = AllocMLState (TRUE, heapParams);
#ifdef HEAP_MONITOR
if (HeapMon_Init(CmdLineArgs, msp->ml_heap) == FAILURE)
Die("unable to start heap monitor");
#endif
InitFaultHandlers ();
AllocGlobals (msp);
/* construct the list of files to be loaded */
BinFileList = BuildFileList (msp, bootlist, &max_boot_path_len);
/* this space is ultimately wasted */
if ((fname = MALLOC (max_boot_path_len)) == NULL)
Die ("unable to allocate space for boot file names");
/* boot the system */
while (BinFileList != LIST_nil) {
/* need to make a copy of the path name because LoadBinFile is
* going to scribble into it */
strcpy(fname, STR_MLtoC(LIST_hd(BinFileList)));
BinFileList = LIST_tl(BinFileList);
if (fname[0] == '#') {
if (rts_init)
Die ("runtime system registered more than once\n");
else {
/* register the runtime system under the given pers id */
pers_id_t pid;
int i, l = strlen (fname + 1);
for (i = 0; i < PERID_LEN; i++) {
int i2 = 2 * i;
if (i2 + 1 < l) {
int c1 = fname[i2+1];
int c2 = fname[i2+2];
pid.bytes[i] = (HEX(c1) << 4) + HEX(c2);
}
}
if (!SilentLoad)
Say ("[Registering runtime system as %s]\n", fname+1);
EnterPerID (msp, &pid, RunTimeCompUnit);
rts_init = 1; /* make sure we do this only once */
}
}
else
LoadBinFile (msp, fname);
}
} /* end of BootML */
/* BuildFileList:
*
* Given the directory path, build a list of the .bin files in the
* heap.
*/
PVT ml_val_t BuildFileList (ml_state_t *msp, const char *bootlist, int *mbplp)
{
FILE *listF;
ml_val_t *fileNames = NULL;
char *nameBuf = NULL;
int max_num_boot_files = MAX_NUM_BOOT_FILES;
int max_boot_path_len = MAX_BOOT_PATH_LEN;
int i, j, numFiles;
ml_val_t fileList;
# define SIZE_BUF_LEN 128 /* this should be plenty for two numbers */
char sizeBuf[SIZE_BUF_LEN];
char c;
numFiles = 0;
listF = OpenBinFile (bootlist, FALSE);
if (listF != NULL) {
c = getc (listF);
if (c == EOF)
Die ("bootlist file \"%s\" is empty", bootlist);
if (c == '%') {
if (fgets (sizeBuf, SIZE_BUF_LEN, listF) != NIL(char *)) {
/* hardly any checking here... */
char *space = strchr (sizeBuf, ' ');
*space = '\0';
max_num_boot_files = strtoul(sizeBuf, NULL, 0);
max_boot_path_len = strtoul(space+1, NULL, 0) + 2;
}
else
Die ("unable to read first line in \"%s\" after %%", bootlist);
}
else {
/* size spec is missing -- use defaults */
ungetc (c, listF);
}
*mbplp = max_boot_path_len; /* tell the calling function... */
if ((nameBuf = MALLOC(max_boot_path_len)) == NIL(char *))
Die ("unable to allocate space for boot file names");
if ((fileNames = MALLOC(max_num_boot_files * sizeof(char *))) == NULL)
Die ("unable to allocate space for boot file name table");
/* read in the file names, converting them to ML strings. */
while (fgets (nameBuf, max_boot_path_len, listF) != NIL(char *)) {
j = strlen(nameBuf)-1;
if (nameBuf[j] == '\n') nameBuf[j] = '\0'; /* remove "\n" */
if (numFiles < max_num_boot_files)
fileNames[numFiles++] = ML_CString(msp, nameBuf);
else
Die ("too many files\n");
}
fclose (listF);
}
/* create the in-heap list */
for (fileList = LIST_nil, i = numFiles; --i >= 0; ) {
LIST_cons(msp, fileList, fileNames[i], fileList);
}
/* these guys are no longer needed from now on */
if (fileNames)
FREE (fileNames);
if (nameBuf)
FREE (nameBuf);
return fileList;
} /* end of BuildFileList */
/* OpenBinFile:
*
* Open a file in the bin file directory.
*/
PVT FILE *OpenBinFile (const char *fname, bool_t isBinary)
{
FILE *file;
if ((file = fopen (fname, isBinary ? "rb" : "r")) == NULL)
Error ("unable to open \"%s\"\n", fname);
return file;
} /* end of OpenBinFile */
/*
* BINFILE FORMAT description:
*
*************** The following really belongs in the header file ****************
* Every 4-byte integer field is stored in big-endian format.
*
* Start Size Purpose
* ----BEGIN OF HEADER----
* 0 16 magic string
* 16 4 number of import values (importCnt)
* 20 4 number of exports (exportCnt = currently always 0 or 1)
* 24 4 size of import tree area in bytes (importSzB)
* 28 4 size of CM-specific info in bytes (cmInfoSzB)
* 32 4 size of pickled lambda-expression in bytes (lambdaSzB)
* 36 4 size of reserved area in bytes (reserved)
* 40 4 size of padding area in bytes (pad)
* 44 4 size of code area in bytes (codeSzB)
* 48 4 size of pickled environment in bytes (envSzB)
* 52 i import trees [This area contains pickled import trees --
* see below. The total number of leaves in these trees is
* importCnt. The size impSzB of this area depends on the
* shape of the trees.]
* i+52 ex export pids [Each export pid occupies 16 bytes. Thus, the
* size ex of this area is 16*exportCnt (0 or 16).]
* ex+i+52 cm CM info [Currently a list of pid-pairs.] (cm = cmInfoSzB)
* ----END OF HEADER----
* 0 h HEADER (h = 52+cm+ex+i)
* h l pickle of exported lambda-expr. (l = lambdaSzB)
* l+h r reserved area (r = reserved)
* r+l+h p padding (p = pad)
* p+r+l+h c code area (c = codeSzB) [Structured into several
* segments -- see below.]
* c+p+r+l+h e pickle of static environment (e = envSzB)
* e+c+p+r+l+h - END OF BINFILE
*
* IMPORT TREE FORMAT description:
*
* The import tree area contains a list of (pid * tree) pairs.
* The pids are stored directly as 16-byte strings.
* Trees are constructed according to the following ML-datatype:
* datatype tree = NODE of (int * tree) list
* Leaves in this tree have the form (NODE []).
* Trees are written recursively -- (NODE l) is represented by n (= the
* length of l) followed by n (int * node) subcomponents. Each component
* consists of the integer selector followed by the corresponding tree.
*
* The size of the import tree area is only given implicitly. When reading
* this area, the reader must count the number of leaves and compare it
* with importCnt.
*
* Integer values in the import tree area (lengths and selectors) are
* written in "packed" integer format. In particular, this means that
* Values in the range 0..127 are represented by only 1 byte.
* Conceptually, the following pickling routine is used:
*
* void recur_write_ul (unsigned long l, FILE *file)
* {
* if (l != 0) {
* recur_write_ul (l >> 7, file);
* putc ((l & 0x7f) | 0x80, file);
* }
* }
*
* void write_ul (unsigned long l, FILE *file)
* {
* recur_write_ul (l >> 7, file);
* putc (l & 0x7f, file);
* }
*
* CODE AREA FORMAT description:
*
* The code area contains multiple code segements. There will be at least
* two. The very first segment is the "data" segment -- responsible for
* creating literal constants on the heap. The idea is that code in the
* data segment will be executed only once at link-time. Thus, it can
* then be garbage-collected immediatly. (In the future it is possible that
* the data segment will not contain executable code at all but some form
* of bytecode that is to be interpreted separately.)
*
* In the binfile, each code segment is represented by its size s and its
* entry point offset (in bytes -- written as 4-byte big-endian integers)
* followed by s bytes of machine- (or byte-) code. The total length of all
* code segments (including the bytes spent on representing individual sizes
* and entry points) is codeSzB. The entrypoint field for the data segment
* is currently ignored (and should be 0).
*
* LINKING CONVENTIONS:
*
* Linking is achieved by executing all code segments in sequential order.
*
* The first code segment (i.e., the "data" segment) receives unit as
* its single argument.
*
* The second code segment receives a record as its single argument.
* This record has (importCnt+1) components. The first importCnt
* components correspond to the leaves of the import trees. The final
* component is the result from executing the data segment.
*
* All other code segments receive a single argument which is the result
* of the preceding segment.
*
* The result of the last segment represents the exports of the compilation
* unit. It is to be paired up with the export pid and stored in the
* dynamic environment. If there is no export pid, then the final result
* will be thrown away.
*
* The import trees are used for constructing the argument record for the
* second code segment. The pid at the root of each tree is the key for
* looking up a value in the existing dynamic environment. In general,
* that value will be a record. The selector fields of the import tree
* associated with the pid are used to recursively fetch components of that
* record.
*/
/* ReadBinFile:
*/
PVT void ReadBinFile (FILE *file, void *buf, int nbytes, const char *fname)
{
if (fread(buf, nbytes, 1, file) == -1)
Die ("cannot read file \"%s\"", fname);
} /* end of ReadBinFile */
/* ReadPackedInt32:
*
* Read an integer in "packed" format. (Small numbers only require 1 byte.)
*/
PVT Int32_t ReadPackedInt32 (FILE *file, const char *fname)
{
Unsigned32_t n;
Byte_t c;
n = 0;
do {
ReadBinFile (file, &c, sizeof(c), fname);
n = (n << 7) | (c & 0x7f);
} while ((c & 0x80) != 0);
return ((Int32_t)n);
} /* end of ReadPackedInt32 */
/* ImportSelection:
*
* Select out the interesting bits from the imported object.
*/
PVT void ImportSelection (ml_state_t *msp, FILE *file, const char *fname,
int *importVecPos, ml_val_t tree)
{
Int32_t cnt = ReadPackedInt32 (file, fname);
if (cnt == 0) {
ML_AllocWrite (msp, *importVecPos, tree);
(*importVecPos)++;
}
else {
while (cnt-- > 0) {
Int32_t selector = ReadPackedInt32 (file, fname);
ImportSelection (msp, file, fname, importVecPos,
REC_SEL(tree, selector));
}
}
} /* end of ImportSelection */
/* LoadBinFile:
*/
PVT void LoadBinFile (ml_state_t *msp, char *fname)
{
FILE *file;
int i, remainingCode, importRecLen;
int exportSzB = 0;
ml_val_t codeObj, importRec, closure, val;
binfile_hdr_t hdr;
pers_id_t exportPerID;
Int32_t thisSzB, thisEntryPoint;
size_t archiveOffset;
char *atptr, *colonptr;
char *objname = fname;
if ((atptr = strchr (fname, '@')) == NULL)
archiveOffset = 0;
else {
if ((colonptr = strchr (atptr + 1, ':')) != NULL) {
objname = colonptr + 1;
*colonptr = '\0';
}
/* not a lot of extensive checking here... */
archiveOffset = strtoul (atptr + 1, NULL, 0);
*atptr = '\0';
}
if (!SilentLoad)
Say ("[Loading %s]\n", objname);
/* open the file */
file = OpenBinFile (fname, TRUE);
if (file == NULL)
Exit (1);
/* if an offset is given (i.e., we are probably dealing with a stable
* archive), then seek to the beginning of the section that contains
* the binfile
*/
if (archiveOffset != 0) {
if (fseek (file, archiveOffset, SEEK_SET) == -1)
Die ("cannot seek on archive file \"%s@%ul\"",
fname, (unsigned long) archiveOffset);
}
/* get the header */
ReadBinFile (file, &hdr, sizeof(binfile_hdr_t), fname);
/* get header byte order right */
hdr.importCnt = BIGENDIAN_TO_HOST(hdr.importCnt);
hdr.exportCnt = BIGENDIAN_TO_HOST(hdr.exportCnt);
hdr.importSzB = BIGENDIAN_TO_HOST(hdr.importSzB);
hdr.cmInfoSzB = BIGENDIAN_TO_HOST(hdr.cmInfoSzB);
hdr.lambdaSzB = BIGENDIAN_TO_HOST(hdr.lambdaSzB);
hdr.reserved = BIGENDIAN_TO_HOST(hdr.reserved);
hdr.pad = BIGENDIAN_TO_HOST(hdr.pad);
hdr.codeSzB = BIGENDIAN_TO_HOST(hdr.codeSzB);
hdr.envSzB = BIGENDIAN_TO_HOST(hdr.envSzB);
/* read the import PerIDs, and create the import vector */
{
int importVecPos;
importRecLen = hdr.importCnt + 1;
if (NeedGC (msp, REC_SZB(importRecLen)))
InvokeGCWithRoots (msp, 0, &BinFileList, NIL(ml_val_t *));
ML_AllocWrite (msp, 0, MAKE_DESC(importRecLen, DTAG_record));
for (importVecPos = 1; importVecPos < importRecLen; ) {
pers_id_t importPid;
ReadBinFile (file, &importPid, sizeof(pers_id_t), fname);
ImportSelection (msp, file, fname, &importVecPos,
LookupPerID(&importPid));
}
ML_AllocWrite(msp, importRecLen, ML_nil);
importRec = ML_Alloc(msp, importRecLen);
}
/* read the export PerID */
if (hdr.exportCnt == 1) {
exportSzB = sizeof(pers_id_t);
ReadBinFile (file, &exportPerID, exportSzB, fname);
}
else if (hdr.exportCnt != 0)
Die ("# of export pids is %d (should be 0 or 1)", (int)hdr.exportCnt);
/* seek to code section */
{
long off = archiveOffset
+ sizeof(binfile_hdr_t)
+ hdr.importSzB
+ exportSzB
+ hdr.cmInfoSzB
+ hdr.lambdaSzB
+ hdr.reserved
+ hdr.pad;
if (fseek(file, off, SEEK_SET) == -1)
Die ("cannot seek on bin file \"%s\"", fname);
}
/* Read code objects and run them. The first code object will be the
* data segment. */
remainingCode = hdr.codeSzB;
/* read the size and the dummy entry point for the data object */
ReadBinFile (file, &thisSzB, sizeof(Int32_t), fname);
thisSzB = BIGENDIAN_TO_HOST(thisSzB);
ReadBinFile (file, &thisEntryPoint, sizeof(Int32_t), fname);
/* thisEntryPoint = BIGENDIAN_TO_HOST(thisEntryPoint); */
remainingCode -= thisSzB + 2 * sizeof(Int32_t);
if (remainingCode < 0)
Die ("format error (data size mismatch) in bin file \"%s\"", fname);
if (thisSzB > 0) {
Byte_t *dataObj = NEW_VEC(Byte_t, thisSzB);
ReadBinFile (file, dataObj, thisSzB, fname);
SaveCState (msp, &BinFileList, &importRec, NIL(ml_val_t *));
val = BuildLiterals (msp, dataObj, thisSzB);
FREE(dataObj);
RestoreCState (msp, &BinFileList, &importRec, NIL(ml_val_t *));
}
else {
val = ML_unit;
}
/* do a functional update of the last element of the importRec. */
for (i = 0; i < importRecLen; i++)
ML_AllocWrite(msp, i, PTR_MLtoC(ml_val_t, importRec)[i-1]);
ML_AllocWrite(msp, importRecLen, val);
val = ML_Alloc(msp, importRecLen);
/* do a GC, if necessary */
if (NeedGC (msp, PERID_LEN+REC_SZB(5)))
InvokeGCWithRoots (msp, 0, &BinFileList, &val, NIL(ml_val_t *));
while (remainingCode > 0) {
/* read the size and entry point for this code object */
ReadBinFile (file, &thisSzB, sizeof(Int32_t), fname);
thisSzB = BIGENDIAN_TO_HOST(thisSzB);
ReadBinFile (file, &thisEntryPoint, sizeof(Int32_t), fname);
thisEntryPoint = BIGENDIAN_TO_HOST(thisEntryPoint);
/* how much more? */
remainingCode -= thisSzB + 2 * sizeof(Int32_t);
if (remainingCode < 0)
Die ("format error (code size mismatch) in bin file \"%s\"", fname);
/* allocate space and read code object */
codeObj = ML_AllocCode (msp, thisSzB);
ReadBinFile (file, PTR_MLtoC(char, codeObj), thisSzB, fname);
FlushICache (PTR_MLtoC(char, codeObj), thisSzB);
/* create closure (taking entry point into account) */
REC_ALLOC1 (msp, closure,
PTR_CtoML (PTR_MLtoC (char, codeObj) + thisEntryPoint));
/* apply the closure to the import PerID vector */
SaveCState (msp, &BinFileList, NIL(ml_val_t *));
val = ApplyMLFn (msp, closure, val, TRUE);
RestoreCState (msp, &BinFileList, NIL(ml_val_t *));
/* do a GC, if necessary */
if (NeedGC (msp, PERID_LEN+REC_SZB(5)))
InvokeGCWithRoots (msp, 0, &BinFileList, &val, NIL(ml_val_t *));
}
/* record the resulting exported PerID */
if (exportSzB != 0)
EnterPerID (msp, &exportPerID, val);
fclose (file);
} /* end of LoadBinFile */
/* EnterPerID:
*
* Enter a PerID/object binding in the heap allocated list of PerIDs.
*/
PVT void EnterPerID (ml_state_t *msp, pers_id_t *perID, ml_val_t obj)
{
ml_val_t mlPerID;
/* Allocate space for the PerID */
mlPerID = ML_AllocString (msp, PERID_LEN);
memcpy (STR_MLtoC(mlPerID), (char *)perID, PERID_LEN);
/* Allocate the list element */
REC_ALLOC3(msp, PerIDList, mlPerID, obj, PerIDList);
}
/* LookupPerID:
*/
PVT ml_val_t LookupPerID (pers_id_t *perID)
{
ml_val_t p, id;
for (p = PerIDList; p != ML_unit; p = REC_SEL(p, 2)) {
id = REC_SEL(p, 0);
if (memcmp((char *)perID, STR_MLtoC(id), PERID_LEN) == 0)
return (REC_SEL(p, 1));
}
{
char buf[64];
ShowPerID (buf, perID);
Die ("unable to find PerID %s", buf);
}
} /* end of LookupPerID */
/* ShowPerID:
*/
PVT void ShowPerID (char *buf, pers_id_t *perID)
{
char *cp = buf;
int i;
*cp++ = '[';
for (i = 0; i < PERID_LEN; i++) {
sprintf (cp, "%02x", perID->bytes[i]);
cp += 2;
}
*cp++ = ']';
*cp++ = '\0';
} /* end of ShowPerID */
syntax highlighted by Code2HTML, v. 0.9.1