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 1856 - (view) (download) (as text)

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

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