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

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