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.SAV
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 104 - (view) (download)

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

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