Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/kernel/boot.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/kernel/boot.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 249 - (view) (download) (as text)
Original Path: sml/branches/SMLNJ/src/runtime/kernel/boot.c

1 : monnier 249 /* boot.c
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
4 :     *
5 :     * This is the bootstrap loader for booting from .bin files.
6 :     */
7 :    
8 :     #include "ml-osdep.h"
9 :     #include <stdio.h>
10 :     #include "ml-base.h"
11 :     #include "ml-limits.h"
12 :     #include "cache-flush.h"
13 :     #include "bin-file.h"
14 :     #include "ml-objects.h"
15 :     #include "gc.h"
16 :     #include "ml-globals.h"
17 :    
18 :     #ifndef SEEK_SET
19 :     # define SEEK_SET 0
20 :     #endif
21 :    
22 :     /** The names of the boot and binary file lists **/
23 :     PVT char *FileLists[] = {
24 :     "BOOTLIST", "PERVLIST", "COMPLIST"
25 :     };
26 :     #define NUM_FILE_LISTS (sizeof(FileLists) / sizeof(char *))
27 :    
28 :    
29 :     pers_id_t RunTimePerID = {RUNTIME_PERID};
30 :    
31 :    
32 :     /* The persistent ID list is stored in the PervStruct refcell. It has
33 :     * the following ML type:
34 :     *
35 :     * datatype runDynEnv
36 :     * = NILrde
37 :     * | CONSrde of (Word8Vector.vector * Object.object * runDynEnv)
38 :     */
39 :     #define PerIDList (*PTR_MLtoC(ml_val_t, PervStruct))
40 :    
41 :     PVT ml_val_t BinFileList = LIST_nil; /* A list of bin files to load */
42 :    
43 :    
44 :     /* local routines */
45 :     PVT ml_val_t BuildFileList (ml_state_t *msp, const char *binDir);
46 :     PVT FILE *OpenBinFile (const char *binDir, const char *fname, bool_t isBinary);
47 :     PVT void ReadBinFile (
48 :     FILE *file, void *buf, int nbytes,
49 :     const char *binDir, const char *fname
50 :     );
51 :     PVT void LoadBinFile (ml_state_t *msp, const char *binDir, const char *fname);
52 :     PVT void EnterPerID (ml_state_t *msp, pers_id_t *perID, ml_val_t obj);
53 :     PVT ml_val_t LookupPerID (pers_id_t *perID);
54 :     PVT void ShowPerID (char *buf, pers_id_t *perID);
55 :    
56 :    
57 :     /* BootML:
58 :     *
59 :     * Boot the system using the .bin files from binDir.
60 :     */
61 :     void BootML (const char *binDir, heap_params_t *heapParams)
62 :     {
63 :     ml_state_t *msp;
64 :     char fname[512];
65 :    
66 :     msp = AllocMLState (TRUE, heapParams);
67 :    
68 :     #ifdef HEAP_MONITOR
69 :     if (HeapMon_Init(CmdLineArgs, msp->ml_heap) == FAILURE)
70 :     Die("unable to start heap monitor");
71 :     #endif
72 :    
73 :     InitFaultHandlers ();
74 :     AllocGlobals (msp);
75 :    
76 :     /* Enter the runtime system binding */
77 :     EnterPerID (msp, &RunTimePerID, RunTimeCompUnit);
78 :    
79 :     /* construct the list of files to be loaded */
80 :     BinFileList = BuildFileList (msp, binDir);
81 :    
82 :     /* boot the system */
83 :     while (BinFileList != LIST_nil) {
84 :     strcpy(fname, STR_MLtoC(LIST_hd(BinFileList)));
85 :     Say ("[Loading %s]\n", fname);
86 :     BinFileList = LIST_tl(BinFileList);
87 :     LoadBinFile (msp, binDir, fname);
88 :     }
89 :    
90 :     } /* end of BootML */
91 :    
92 :    
93 :     /* BuildFileList:
94 :     *
95 :     * Given the directory path, build a list of the .bin files in the
96 :     * heap.
97 :     */
98 :     PVT ml_val_t BuildFileList (ml_state_t *msp, const char *binDir)
99 :     {
100 :     FILE *listF;
101 :     ml_val_t fileNames[MAX_NUM_BOOT_FILES];
102 :     int i, j, numFiles;
103 :     char nameBuf[MAX_BOOT_PATH_LEN];
104 :     ml_val_t fileList;
105 :    
106 :     for (numFiles = 0, i = 0; i < NUM_FILE_LISTS; i++) {
107 :     listF = OpenBinFile (binDir, FileLists[i], FALSE);
108 :     if (listF == NULL)
109 :     continue;
110 :     /* read in the file names, converting them to ML strings. */
111 :     while (fgets (nameBuf, MAX_BOOT_PATH_LEN, listF) != NIL(char *)) {
112 :     j = strlen(nameBuf)-1;
113 :     if (nameBuf[j] == '\n') nameBuf[j] = '\0'; /* remove "\n" */
114 :     if (numFiles < MAX_NUM_BOOT_FILES)
115 :     fileNames[numFiles++] = ML_CString(msp, nameBuf);
116 :     else
117 :     Die ("too many files\n");
118 :     }
119 :     fclose (listF);
120 :     }
121 :    
122 :     /* create the in-heap list */
123 :     for (fileList = LIST_nil, i = numFiles; --i >= 0; ) {
124 :     LIST_cons(msp, fileList, fileNames[i], fileList);
125 :     }
126 :    
127 :     return fileList;
128 :    
129 :     } /* end of BuildFileList */
130 :    
131 :    
132 :     /* OpenBinFile:
133 :     *
134 :     * Open a file in the bin file directory.
135 :     */
136 :     PVT FILE *OpenBinFile (const char *binDir, const char *fname, bool_t isBinary)
137 :     {
138 :     char path[MAX_BOOT_PATH_LEN];
139 :     FILE *file;
140 :    
141 :     sprintf(path, "%s%c%s", binDir, PATH_ARC_SEP, fname);
142 :    
143 :     if ((file = fopen(path, isBinary ? "rb" : "r")) == NULL)
144 :     Error ("unable to open \"%s\"\n", path);
145 :    
146 :     return file;
147 :    
148 :     } /* end of OpenBinFile */
149 :    
150 :     /*
151 :     * BINFILE FORMAT description:
152 :     *
153 :     *************** The following really belongs in the header file ****************
154 :     * Every 4-byte integer field is stored in big-endian format.
155 :     *
156 :     * Start Size Purpose
157 :     * ----BEGIN OF HEADER----
158 :     * 0 16 magic string
159 :     * 16 4 number of import values (importCnt)
160 :     * 20 4 number of exports (exportCnt = currently always 0 or 1)
161 :     * 24 4 size of CM-specific info in bytes (cmInfoSzB)
162 :     * 28 4 size of pickled lambda-expression in bytes (lambdaSzB)
163 :     * 32 4 size of reserved area 1 in bytes (reserved1)
164 :     * 36 4 size of reserved area 2 in bytes (reserved2)
165 :     * 40 4 size of code area in bytes (codeSzB)
166 :     * 44 4 size of pickled environment in bytes (envSzB)
167 :     * 48 i import trees [This area contains pickled import trees --
168 :     * see below. The total number of leaves in these trees is
169 :     * importCnt. The size impSzB of this area depends on the
170 :     * shape of the trees.]
171 :     * i+48 ex export pids [Each export pid occupies 16 bytes. Thus, the
172 :     * size ex of this area is 16*exportCnt (0 or 16).]
173 :     * ex+i+48 cm CM info [Currently a list of pid-pairs.] (cm = cmInfoSzB)
174 :     * ----END OF HEADER----
175 :     * 0 h HEADER (h = 48+cm+ex+i)
176 :     * h l pickle of exported lambda-expr. (l = lambdaSzB)
177 :     * l+h r reserved areas (r = reserved1+reserved2)
178 :     * r+l+h c code area (c = codeSzB) [Structured into several
179 :     * segments -- see below.]
180 :     * c+r+l+h e pickle of static environment (e = envSzB)
181 :     * e+c+r+l+h - END OF BINFILE
182 :     *
183 :     * IMPORT TREE FORMAT description:
184 :     *
185 :     * The import tree area contains a list of (pid * tree) pairs.
186 :     * The pids are stored directly as 16-byte strings.
187 :     * Trees are constructed according to the following ML-datatype:
188 :     * datatype tree = NODE of (int * tree) list
189 :     * Leaves in this tree have the form (NODE []).
190 :     * Trees are written recursively -- (NODE l) is represented by n (= the
191 :     * length of l) followed by n (int * node) subcomponents. Each component
192 :     * consists of the integer selector followed by the corresponding tree.
193 :     *
194 :     * The size of the import tree area is only given implicitly. When reading
195 :     * this area, the reader must count the number of leaves and compare it
196 :     * with importCnt.
197 :     *
198 :     * Integer values in the import tree area (lengths and selectors) are
199 :     * written in "packed" integer format. In particular, this means that
200 :     * Values in the range 0..127 are represented by only 1 byte.
201 :     * Conceptually, the following pickling routine is used:
202 :     *
203 :     * void recur_write_ul (unsigned long l, FILE *file)
204 :     * {
205 :     * if (l != 0) {
206 :     * recur_write_ul (l >> 7, file);
207 :     * putc ((l & 0x7f) | 0x80, file);
208 :     * }
209 :     * }
210 :     *
211 :     * void write_ul (unsigned long l, FILE *file)
212 :     * {
213 :     * recur_write_ul (l >> 7, file);
214 :     * putc (l & 0x7f, file);
215 :     * }
216 :     *
217 :     * CODE AREA FORMAT description:
218 :     *
219 :     * The code area contains multiple code segements. There will be at least
220 :     * two. The very first segment is the "data" segment -- responsible for
221 :     * creating literal constants on the heap. The idea is that code in the
222 :     * data segment will be executed only once at link-time. Thus, it can
223 :     * then be garbage-collected immediatly. (In the future it is possible that
224 :     * the data segment will not contain executable code at all but some form
225 :     * of bytecode that is to be interpreted separately.)
226 :     *
227 :     * In the binfile, each code segment is represented by its size s (in
228 :     * bytes -- written as a 4-byte big-endian integer) followed by s bytes of
229 :     * machine- (or byte-) code. The total length of all code segments
230 :     * (including the bytes spent on representing individual sizes) is codeSzB.
231 :     *
232 :     * LINKING CONVENTIONS:
233 :     *
234 :     * Linking is achieved by executing all code segments in sequential order.
235 :     *
236 :     * The first code segment (i.e., the "data" segment) receives unit as
237 :     * its single argument.
238 :     *
239 :     * The second code segment receives a record as its single argument.
240 :     * This record has (importCnt+1) components. The first importCnt
241 :     * components correspond to the leaves of the import trees. The final
242 :     * component is the result from executing the data segment.
243 :     *
244 :     * All other code segments receive a single argument which is the result
245 :     * of the preceding segment.
246 :     *
247 :     * The result of the last segment represents the exports of the compilation
248 :     * unit. It is to be paired up with the export pid and stored in the
249 :     * dynamic environment. If there is no export pid, then the final result
250 :     * will be thrown away.
251 :     *
252 :     * The import trees are used for constructing the argument record for the
253 :     * second code segment. The pid at the root of each tree is the key for
254 :     * looking up a value in the existing dynamic environment. In general,
255 :     * that value will be a record. The selector fields of the import tree
256 :     * associated with the pid are used to recursively fetch components of that
257 :     * record.
258 :     */
259 :    
260 :     /* ReadBinFile:
261 :     */
262 :     PVT void ReadBinFile (
263 :     FILE *file, void *buf, int nbytes, const char *binDir, const char *fname
264 :     )
265 :     {
266 :     if (fread(buf, nbytes, 1, file) == -1)
267 :     Die ("cannot read file \"%s%c%s\"", binDir, PATH_ARC_SEP, fname);
268 :    
269 :     } /* end of ReadBinFile */
270 :    
271 :     /* ReadPackedInt32:
272 :     *
273 :     * Read an integer in "packed" format. (Small numbers only require 1 byte.)
274 :     */
275 :     PVT Int32_t ReadPackedInt32 (FILE *file, const char *binDir, const char *fname)
276 :     {
277 :     Unsigned32_t n;
278 :     Byte_t c;
279 :    
280 :     n = 0;
281 :     do {
282 :     ReadBinFile (file, &c, sizeof(c), binDir, fname);
283 :     n = (n << 7) | (c & 0x7f);
284 :     } while ((c & 0x80) != 0);
285 :    
286 :     return ((Int32_t)n);
287 :    
288 :     } /* end of ReadPackedInt32 */
289 :    
290 :     /* ImportSelection:
291 :     *
292 :     * Select out the interesting bits from the imported object.
293 :     */
294 :     PVT void ImportSelection (
295 :     ml_state_t *msp,
296 :     FILE *file,
297 :     const char *binDir,
298 :     const char *fname,
299 :     int *importVecPos,
300 :     ml_val_t tree)
301 :     {
302 :     Int32_t cnt = ReadPackedInt32 (file, binDir, fname);
303 :     if (cnt == 0) {
304 :     ML_AllocWrite (msp, *importVecPos, tree);
305 :     (*importVecPos)++;
306 :     }
307 :     else {
308 :     while (cnt-- > 0) {
309 :     Int32_t selector = ReadPackedInt32 (file, binDir, fname);
310 :     ImportSelection (
311 :     msp, file, binDir, fname, importVecPos,
312 :     REC_SEL(tree, selector));
313 :     }
314 :     }
315 :    
316 :     } /* end of ImportSelection */
317 :    
318 :     /* LoadBinFile:
319 :     */
320 :     PVT void LoadBinFile (ml_state_t *msp, const char *binDir, const char *fname)
321 :     {
322 :     FILE *file;
323 :     int i, exportSzB, remainingCode, importRecLen;
324 :     bool_t isDataSeg;
325 :     ml_val_t codeObj, importRec, closure, val;
326 :     binfile_hdr_t hdr;
327 :     pers_id_t exportPerID;
328 :     Int32_t thisSzB;
329 :    
330 :     /* open the file */
331 :     file = OpenBinFile (binDir, fname, TRUE);
332 :     if (file == NULL)
333 :     Exit (1);
334 :    
335 :     /* get the header */
336 :     ReadBinFile (file, &hdr, sizeof(binfile_hdr_t), binDir, fname);
337 :    
338 :     /* get header byte order right */
339 :     hdr.importCnt = BIGENDIAN_TO_HOST(hdr.importCnt);
340 :     hdr.exportCnt = BIGENDIAN_TO_HOST(hdr.exportCnt);
341 :     hdr.importSzB = BIGENDIAN_TO_HOST(hdr.importSzB);
342 :     hdr.cmInfoSzB = BIGENDIAN_TO_HOST(hdr.cmInfoSzB);
343 :     hdr.lambdaSzB = BIGENDIAN_TO_HOST(hdr.lambdaSzB);
344 :     hdr.reserved1 = BIGENDIAN_TO_HOST(hdr.reserved1);
345 :     hdr.reserved2 = BIGENDIAN_TO_HOST(hdr.reserved2);
346 :     hdr.codeSzB = BIGENDIAN_TO_HOST(hdr.codeSzB);
347 :     hdr.envSzB = BIGENDIAN_TO_HOST(hdr.envSzB);
348 :    
349 :     /* read the import PerIDs, and create the import vector */
350 :     {
351 :     int importVecPos;
352 :    
353 :     importRecLen = hdr.importCnt + 1;
354 :    
355 :     if (NeedGC (msp, REC_SZB(importRecLen)))
356 :     InvokeGCWithRoots (msp, 0, &BinFileList, NIL(ml_val_t *));
357 :    
358 :     ML_AllocWrite (msp, 0, MAKE_DESC(importRecLen, DTAG_record));
359 :     for (importVecPos = 1; importVecPos < importRecLen; ) {
360 :     pers_id_t importPid;
361 :     ReadBinFile (file, &importPid, sizeof(pers_id_t), binDir, fname);
362 :     ImportSelection (
363 :     msp, file, binDir, fname, &importVecPos,
364 :     LookupPerID(&importPid));
365 :     }
366 :     ML_AllocWrite(msp, importRecLen, ML_nil);
367 :     importRec = ML_Alloc(msp, importRecLen);
368 :     }
369 :    
370 :     /* read the export PerID */
371 :     if (hdr.exportCnt == 1) {
372 :     exportSzB = sizeof(pers_id_t);
373 :     ReadBinFile (file, &exportPerID, exportSzB, binDir, fname);
374 :     }
375 :     else if (hdr.exportCnt != 0)
376 :     Die ("# of export pids is %d (should be 0 or 1)", (int)hdr.exportCnt);
377 :     else
378 :     exportSzB = 0;
379 :    
380 :     /* seek to code section */
381 :     {
382 :     long off = sizeof(binfile_hdr_t)
383 :     + hdr.importSzB
384 :     + exportSzB
385 :     + hdr.cmInfoSzB
386 :     + hdr.lambdaSzB
387 :     + hdr.reserved1 + hdr.reserved2;
388 :    
389 :     if (fseek(file, off, SEEK_SET) == -1)
390 :     Die ("cannot seek on bin file \"%s%c%s\"", binDir, PATH_ARC_SEP, fname);
391 :     }
392 :    
393 :     /* Read code objects and run them. The first code object will be the
394 :     * data segment. We add a comment string to each code object to mark
395 :     * which bin file it came from. This code should be the same as that
396 :     * in ../c-libs/smlnj-runtime/mkcode.c.
397 :     */
398 :    
399 :     remainingCode = hdr.codeSzB;
400 :    
401 :     /* read the size for the data object */
402 :     ReadBinFile (file, &thisSzB, sizeof(Int32_t), binDir, fname);
403 :     thisSzB = BIGENDIAN_TO_HOST(thisSzB);
404 :    
405 :     remainingCode -= thisSzB + sizeof(Int32_t);
406 :     if (remainingCode < 0)
407 :     Die ("format error (data size mismatch) in bin file \"%s%c%s\"",
408 :     binDir, PATH_ARC_SEP, fname);
409 :    
410 :     if (thisSzB > 0) {
411 :     Byte_t *dataObj = NEW_VEC(Byte_t, thisSzB);
412 :    
413 :     ReadBinFile (file, dataObj, thisSzB, binDir, fname);
414 :     SaveCState (msp, &BinFileList, &importRec, NIL(ml_val_t *));
415 :     val = BuildLiterals (msp, dataObj, thisSzB);
416 :     FREE(dataObj);
417 :     RestoreCState (msp, &BinFileList, &importRec, NIL(ml_val_t *));
418 :     }
419 :     else {
420 :     val = ML_unit;
421 :     }
422 :     /* do a functional update of the last element of the importRec. */
423 :     for (i = 0; i < importRecLen; i++)
424 :     ML_AllocWrite(msp, i, PTR_MLtoC(ml_val_t, importRec)[i-1]);
425 :     ML_AllocWrite(msp, importRecLen, val);
426 :     val = ML_Alloc(msp, importRecLen);
427 :     /* do a GC, if necessary */
428 :     if (NeedGC (msp, PERID_LEN+REC_SZB(5)))
429 :     InvokeGCWithRoots (msp, 0, &BinFileList, &val, NIL(ml_val_t *));
430 :    
431 :     while (remainingCode > 0) {
432 :     int strLen, padLen, extraLen;
433 :    
434 :     /* read the size for this code object */
435 :     ReadBinFile (file, &thisSzB, sizeof(Int32_t), binDir, fname);
436 :     thisSzB = BIGENDIAN_TO_HOST(thisSzB);
437 :    
438 :     /* We use one byte for the length, so the longest string is 255
439 :     * characters. We need padding so that the code + string +
440 :     * length byte is WORD_SZB bytes. The padding is inserted between
441 :     * the code and the string.
442 :     */
443 :     strLen = strlen(fname);
444 :     if (strLen > 255)
445 :     strLen = 255;
446 :     extraLen = strLen+1; /* include byte for length */
447 :     padLen = ROUNDUP(thisSzB+extraLen, WORD_SZB) - (thisSzB+extraLen);
448 :     extraLen += padLen;
449 :    
450 :     /* how much more? */
451 :     remainingCode -= thisSzB + sizeof(Int32_t);
452 :     if (remainingCode < 0)
453 :     Die ("format error (code size mismatch) in bin file \"%s%c%s\"",
454 :     binDir, PATH_ARC_SEP, fname);
455 :    
456 :     /* allocate space and read code object */
457 :     codeObj = ML_AllocCode (msp, thisSzB+extraLen);
458 :     ReadBinFile (file, PTR_MLtoC(char, codeObj), thisSzB, binDir, fname);
459 :    
460 :     /* tack on the bin-file name as a comment string. */
461 :     memcpy (PTR_MLtoC(char, codeObj)+thisSzB+padLen, fname, strLen);
462 :     *(PTR_MLtoC(Byte_t, codeObj)+thisSzB+extraLen-1) = (Byte_t)strLen;
463 :    
464 :     FlushICache (PTR_MLtoC(char, codeObj), thisSzB);
465 :    
466 :     /* create closure */
467 :     REC_ALLOC1 (msp, closure, codeObj);
468 :    
469 :     /* apply the closure to the import PerID vector */
470 :     SaveCState (msp, &BinFileList, NIL(ml_val_t *));
471 :     val = ApplyMLFn (msp, closure, val, TRUE);
472 :     RestoreCState (msp, &BinFileList, NIL(ml_val_t *));
473 :    
474 :     /* do a GC, if necessary */
475 :     if (NeedGC (msp, PERID_LEN+REC_SZB(5)))
476 :     InvokeGCWithRoots (msp, 0, &BinFileList, &val, NIL(ml_val_t *));
477 :     }
478 :    
479 :     /* record the resulting exported PerID */
480 :     if (exportSzB != 0)
481 :     EnterPerID (msp, &exportPerID, val);
482 :    
483 :     fclose (file);
484 :    
485 :     } /* end of LoadBinFile */
486 :    
487 :     /* EnterPerID:
488 :     *
489 :     * Enter a PerID/object binding in the heap allocated list of PerIDs.
490 :     */
491 :     PVT void EnterPerID (ml_state_t *msp, pers_id_t *perID, ml_val_t obj)
492 :     {
493 :     ml_val_t mlPerID;
494 :    
495 :     /* Allocate space for the PerID */
496 :     mlPerID = ML_AllocString (msp, PERID_LEN);
497 :     memcpy (STR_MLtoC(mlPerID), (char *)perID, PERID_LEN);
498 :    
499 :     /* Allocate the list element */
500 :     REC_ALLOC3(msp, PerIDList, mlPerID, obj, PerIDList);
501 :    
502 :     }
503 :    
504 :     /* LookupPerID:
505 :     */
506 :     PVT ml_val_t LookupPerID (pers_id_t *perID)
507 :     {
508 :     ml_val_t p, id;
509 :    
510 :     for (p = PerIDList; p != ML_unit; p = REC_SEL(p, 2)) {
511 :     id = REC_SEL(p, 0);
512 :     if (memcmp((char *)perID, STR_MLtoC(id), PERID_LEN) == 0)
513 :     return (REC_SEL(p, 1));
514 :     }
515 :    
516 :     {
517 :     char buf[64];
518 :     ShowPerID (buf, perID);
519 :     Die ("unable to find PerID %s", buf);
520 :     }
521 :    
522 :     } /* end of LookupPerID */
523 :    
524 :    
525 :     /* ShowPerID:
526 :     */
527 :     PVT void ShowPerID (char *buf, pers_id_t *perID)
528 :     {
529 :     char *cp = buf;
530 :     int i;
531 :    
532 :     *cp++ = '[';
533 :     for (i = 0; i < PERID_LEN; i++) {
534 :     sprintf (cp, "%02x", perID->bytes[i]);
535 :     cp += 2;
536 :     }
537 :     *cp++ = ']';
538 :     *cp++ = '\0';
539 :    
540 :     } /* end of ShowPerID */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0