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 113 - (view) (download) (as text)
Original Path: sml/branches/SMLNJ/src/runtime/kernel/boot.c

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

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