1 /* Saving and loading of memory images. */
2
3 /* --------------------------- Specification ---------------------------- */
4
5 /* UP: Saves a memory image on disk.
6 savemem(stream,executable);
7 > object stream: open file output stream
8 > uintL executable: 0: no runtime; 1: runtime; 2: also delegate command line
9 < file length
10 As a side effect, the stream is closed.
11 can trigger GC */
12 global maygc off_t savemem (object stream, uintL executable);
13
14 /* UP: Restores a memory image from disk.
15 loadmem(filename);
16 This overwrites all Lisp data. */
17 local void loadmem (const char* filename);
18
19 /* load the memory image from the currently running executable
20 return 0 on success
21 and 1 on error (when the executable does not contain a memory image) */
22 local int loadmem_from_executable (void);
23
24 /* The "mem file binary interface" of a clisp executable is the combination
25 of all details that matter for mem file compatibility: object representation,
26 types of built-in stream, list of add-on modules, etc.
27
28 The "hash code of the mem file binary interface" (MFIH) is a hash code of
29 such a combination. Its purpose is to be able to guarantee that a given clisp
30 executable and a given mem file are compatible. It's intended to be used
31 as part of Debian virtual package names.
32 We use SHA-1, because that's good enough. For SHA-224 we don't have a gnulib
33 module; and SHA-256 would produce very long Debian package names (currently
34 the longest Debian package name has 67 characters). */
35
36 #define MFIH_LEN 20 /* 20 for SHA-1, 28 for SHA-224, 32 for SHA-256 */
37
38 /* UP: Returns the hash code of the mem file binary interface of the current
39 executable.
40 get_mem_file_interface_hash(&buffer);
41 < uintB buf[MFIH_LEN]: hash code */
42 local void get_mem_file_interface_hash (uintB buf[MFIH_LEN]);
43
44 /* UP: Returns the hash code of the mem file binary interface that was used to
45 create the given memory image file.
46 extract_mem_file_interface_hash(&buffer,const char* filename);
47 > filename: a file name
48 < uintB buf[MFIH_LEN]: hash code */
49 local void extract_mem_file_interface_hash (uintB buf[MFIH_LEN],
50 const char* filename);
51
52 /* UP: Determines whether the current executable can load the given memory image
53 file.
54 is_mem_file_compatible (const char* filename)
55 > filename: a file name
56 < true if the current executable can load the given memory image file,
57 false if not
58 Note:
59 If get_mem_file_interface_hash() and extract_mem_file_interface_hash(filename)
60 produce the same value and the mem file is not truncated,
61 is_mem_file_compatible(filename) returns true. But there are cases when they
62 produce different values and is_mem_file_compatible(filename) is still true;
63 this is an important case for producing mem files with added modules (cf.
64 clisp-link). */
65 local bool is_mem_file_compatible (const char* filename);
66
67 /* --------------------------- Implementation --------------------------- */
68
69 /* Flags, that influence the format of a MEM-file: */
70 local const uint32 memflags =
71 /* typecode allocation: */
72 #ifdef WIDE
73 bit(0) |
74 #endif
75 #ifdef TYPECODES
76 bit(1) |
77 #endif
78 #if 0 /* defined(STANDARD_TYPECODES) */
79 bit(2) |
80 #endif
81 #if 0 /* defined(PACKED_TYPECODES) */
82 bit(3) |
83 #endif
84 #if 0 /* defined(SEVENBIT_TYPECODES) */
85 bit(4) |
86 #endif
87 #if 0 /* defined(SIXBIT_TYPECODES) */
88 bit(5) |
89 #endif
90 #ifdef case_structure
91 bit(6) |
92 #endif
93 #ifdef case_stream
94 bit(7) |
95 #endif
96 /* coding of numbers: */
97 #ifdef FAST_FLOAT
98 bit(8) |
99 #endif
100 #ifdef FAST_DOUBLE
101 bit(9) |
102 #endif
103 /* coding of streams: */
104 #if 1 /* defined(STRM_WR_SS) */
105 bit(10) |
106 #endif
107 #if (SIZEOF_OFF_T > 4)
108 bit(11) |
109 #endif
110 /* coding of strmtype: */
111 #if 1 /* defined(HANDLES) */
112 bit(12) |
113 #endif
114 #ifdef KEYBOARD
115 bit(13) |
116 #endif
117 #ifdef SCREEN
118 bit(14) |
119 #endif
120 #ifdef PRINTER
121 bit(15) |
122 #endif
123 #ifdef PIPES
124 bit(16) |
125 #endif
126 #ifdef X11SOCKETS
127 bit(17) |
128 #endif
129 #ifdef GENERIC_STREAMS
130 bit(18) |
131 #endif
132 #ifdef SOCKET_STREAMS
133 bit(19) |
134 #endif
135 /* coding of strings: */
136 #ifdef ENABLE_UNICODE
137 bit(20) |
138 #endif
139 /* other: */
140 #ifdef MULTITHREAD
141 bit(21) |
142 #endif
143 #ifdef MFIH_LEN
144 bit(22) |
145 #endif
146 0;
147
148 /* Maximum length of (machine-instance) return value: */
149 #define DUMPHOST_LEN (64+45+3) /* 64 for host name, 45 for IPv6 address */
150
151 /* Format: */
152 /* a header: */
153 typedef struct {
154 uintL _magic; /* recognition */
155 #define memdump_magic 0x70768BD2UL
156 uint32 _memflags;
157 uintB _mfihash[MFIH_LEN];
158 oint _oint_type_mask;
159 oint _oint_addr_mask;
160 #ifdef TYPECODES
161 tint _cons_type, _complex_type, _symbol_type, _system_type;
162 #endif
163 uintC _varobject_alignment;
164 uintC _hashtable_length;
165 uintC _pathname_length;
166 uintC _intDsize;
167 uintC _module_count;
168 uintL _module_names_size;
169 uintC _fsubr_count;
170 uintC _pseudofun_count;
171 #if !defined(OLD_GC) && defined(MULTITHREAD)
172 /* number of per thread symvalues */
173 uintC _per_thread_symvalues_count;
174 #endif
175 uintC _symbol_count;
176 uintL _page_alignment;
177 aint _subr_tab_addr;
178 aint _symbol_tab_addr;
179 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
180 aint _mem_varobjects_start;
181 aint _mem_varobjects_end;
182 aint _mem_conses_start;
183 aint _mem_conses_end;
184 #endif
185 #ifndef SPVW_MIXED_BLOCKS_OPPOSITE
186 uintC _heapcount;
187 #endif
188 uintL _dumptime;
189 char _dumphost[DUMPHOST_LEN+1];
190 } memdump_header_t;
191 /* then the module names,
192 then fsubr_tab, pseudofun_tab, symbol_tab,
193 and for each module subr_addr, subr_count, object_count, subr_tab, object_tab, */
194 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
195 /* then the objects of variable length
196 (between mem.varobjects.heap_start and mem.varobjects.heap_end),
197 then the conses (between mem.conses.heap_start and mem.conses.heap_end). */
198 #else
199 #if defined(SPVW_PURE_BLOCKS) || defined(SPVW_MIXED_BLOCKS_STAGGERED)
200 /* then for each heap (block) the start- and end address, */
201 #endif
202 #ifdef SPVW_PAGES
203 /* SPVW_PAGES: then for each heap the number of pages,
204 then for each heap and for each page of the heap
205 the start- and end address, */
206 #endif
207 typedef struct {
208 aint _page_start;
209 aint _page_end;
210 } memdump_page_t;
211 #if defined(SPVW_PURE_BLOCKS) && defined(GENERATIONAL_GC)
212 /* then for each heap the length of physpages,
213 then for each heap the complete physpages-array, */
214 typedef struct {
215 gcv_object_t* continued_addr;
216 uintC continued_count;
217 aint firstobject;
218 } memdump_physpage_state_t;
219 #endif
220 /* then the content of the pages in the same order. */
221 #ifdef SPVW_PURE_BLOCKS
222 /* Finally, the addresses of all objects within the heaps that
223 have to be updated by loadmem_update(), the addresses of the
224 hashtables that have to be marked with set_ht_invalid(), the addresses
225 of the foreign-pointers that have to be marked with mark_fp_invalid(),
226 the addresses of the Fsubrs that have to be relocated with
227 loadmem_update_fsubr(). But beforehand, their numbers.
228 (That is redundant, but reduces the startup times.) */
229 typedef struct {
230 uintL reloccount;
231 uintL htcount;
232 uintL fpcount;
233 uintL fscount;
234 } memdump_reloc_header_t;
235 #endif
236 #endif
237
238 /* page_alignment = Alignment for the page contents in the file. */
239 #if ((defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))) && defined(HAVE_MMAP)
240 #define page_alignment map_pagesize
241 #define WRITE_page_alignment(position) \
242 do { \
243 var uintL aligncount = (uintL)(-(position)) % page_alignment; \
244 if (aligncount > 0) { /* get a piece of zeroed memory: */ \
245 var DYNAMIC_ARRAY(zeroes,uintB,aligncount); \
246 var uintB* ptr = &zeroes[0]; \
247 var uintL count; \
248 dotimespL(count,aligncount, { *ptr++ = 0; } ); \
249 /* and write: */ \
250 WRITE(&zeroes[0],aligncount); \
251 FREE_DYNAMIC_ARRAY(zeroes); \
252 } \
253 } while(0)
254 #define READ_page_alignment(position) \
255 do { \
256 var uintL aligncount = (uintL)(-(position)) % page_alignment; \
257 if (aligncount > 0) { \
258 var DYNAMIC_ARRAY(dummy,uintB,aligncount); \
259 READ(&dummy[0],aligncount); \
260 FREE_DYNAMIC_ARRAY(dummy); \
261 } \
262 } while(0)
263 #else
264 #define page_alignment 1
265 #define WRITE_page_alignment(position)
266 #define READ_page_alignment(position)
267 #endif
268
get_mem_file_interface_hash(uintB buf[MFIH_LEN])269 local void get_mem_file_interface_hash (uintB buf[MFIH_LEN])
270 {
271 var struct sha1_ctx ctx;
272 sha1_init_ctx (&ctx);
273 /* To know which details to consider here, look at the ABORT_INCOMPAT1
274 invocations in memfile_handle_do_operation. */
275 /* It is important that we process exactly as many bytes for each detail
276 as in memdump_header_t. The simplest way to guarantee this is to allocate
277 a dummy memdump_header_t. */
278 var memdump_header_t header;
279 header._memflags = memflags;
280 sha1_process_bytes(&header._memflags,sizeof(header._memflags),&ctx);
281 header._oint_type_mask = oint_type_mask;
282 sha1_process_bytes(&header._oint_type_mask,sizeof(header._oint_type_mask),&ctx);
283 header._oint_addr_mask = oint_addr_mask;
284 sha1_process_bytes(&header._oint_addr_mask,sizeof(header._oint_addr_mask),&ctx);
285 #ifdef TYPECODES
286 header._cons_type = cons_type;
287 sha1_process_bytes(&header._cons_type,sizeof(header._cons_type),&ctx);
288 header._complex_type = complex_type;
289 sha1_process_bytes(&header._complex_type,sizeof(header._complex_type),&ctx);
290 header._symbol_type = symbol_type;
291 sha1_process_bytes(&header._symbol_type,sizeof(header._symbol_type),&ctx);
292 header._system_type = system_type;
293 sha1_process_bytes(&header._system_type,sizeof(header._system_type),&ctx);
294 #endif
295 header._varobject_alignment = varobject_alignment;
296 sha1_process_bytes(&header._varobject_alignment,sizeof(header._varobject_alignment),&ctx);
297 header._hashtable_length = hashtable_length;
298 sha1_process_bytes(&header._hashtable_length,sizeof(header._hashtable_length),&ctx);
299 header._pathname_length = pathname_length;
300 sha1_process_bytes(&header._pathname_length,sizeof(header._pathname_length),&ctx);
301 header._intDsize = intDsize;
302 sha1_process_bytes(&header._intDsize,sizeof(header._intDsize),&ctx);
303 header._fsubr_count = fsubr_count;
304 sha1_process_bytes(&header._fsubr_count,sizeof(header._fsubr_count),&ctx);
305 header._pseudofun_count = pseudofun_count;
306 sha1_process_bytes(&header._pseudofun_count,sizeof(header._pseudofun_count),&ctx);
307 header._symbol_count = symbol_count;
308 sha1_process_bytes(&header._symbol_count,sizeof(header._symbol_count),&ctx);
309 header._page_alignment = page_alignment;
310 sha1_process_bytes(&header._page_alignment,sizeof(header._page_alignment),&ctx);
311 #ifndef SPVW_MIXED_BLOCKS_OPPOSITE
312 header._heapcount = heapcount;
313 sha1_process_bytes(&header._heapcount,sizeof(header._heapcount),&ctx);
314 #endif
315 #ifdef SPVW_PURE_BLOCKS /* SINGLEMAP_MEMORY */
316 header._subr_tab_addr = (aint)(&subr_tab);
317 sha1_process_bytes(&header._subr_tab_addr,sizeof(header._subr_tab_addr),&ctx);
318 header._symbol_tab_addr = (aint)(&symbol_tab);
319 sha1_process_bytes(&header._symbol_tab_addr,sizeof(header._symbol_tab_addr),&ctx);
320 #endif
321 header._module_count = module_count;
322 sha1_process_bytes(&header._module_count,sizeof(header._module_count),&ctx);
323 /* It is not necessary to sort the list of modules, because this list is in
324 predictable (not random) order. */
325 {
326 var uintC count;
327 dotimespC(count,1+header._module_count, {
328 var const module_t* module;
329 for_modules(all_modules, {
330 sha1_process_bytes(module->name,asciz_length(module->name)+1,&ctx);
331 });
332 });
333 }
334 {
335 var uintC count;
336 dotimespC(count,1+header._module_count, {
337 var const module_t* module;
338 for_modules(all_modules, {
339 var uintC mod_subr_count = *module->stab_size;
340 sha1_process_bytes(&mod_subr_count,sizeof(mod_subr_count),&ctx);
341 var uintC mod_object_count = *module->otab_size;
342 sha1_process_bytes(&mod_object_count,sizeof(mod_object_count),&ctx);
343 if (mod_subr_count > 0) {
344 var const subr_t* ptr = module->stab;
345 var uintC counter;
346 dotimespC(counter,mod_subr_count, {
347 sha1_process_bytes(&ptr->req_count,sizeof(ptr->req_count),&ctx);
348 sha1_process_bytes(&ptr->opt_count,sizeof(ptr->opt_count),&ctx);
349 sha1_process_bytes(&ptr->rest_flag,sizeof(ptr->rest_flag),&ctx);
350 sha1_process_bytes(&ptr->key_flag,sizeof(ptr->key_flag),&ctx);
351 sha1_process_bytes(&ptr->key_count,sizeof(ptr->key_count),&ctx);
352 ptr++;
353 });
354 }
355 });
356 });
357 }
358 sha1_finish_ctx (&ctx, buf);
359 }
360
361 /* fill the header's constant slots, excluding _dumptime & _dumphost
362 > memdump_header_t *header: filled
363 return the total size of all module names */
fill_memdump_header(memdump_header_t * header)364 local uintL fill_memdump_header (memdump_header_t *header) {
365 var uintL module_names_size;
366 memset(header,0,sizeof(*header));
367 header->_magic = memdump_magic;
368 header->_memflags = memflags;
369 get_mem_file_interface_hash(&header->_mfihash[0]);
370 header->_oint_type_mask = oint_type_mask;
371 header->_oint_addr_mask = oint_addr_mask;
372 #ifdef TYPECODES
373 header->_cons_type = cons_type;
374 header->_complex_type = complex_type;
375 header->_symbol_type = symbol_type;
376 header->_system_type = system_type;
377 #endif
378 header->_varobject_alignment = varobject_alignment;
379 header->_hashtable_length = hashtable_length;
380 header->_pathname_length = pathname_length;
381 header->_intDsize = intDsize;
382 header->_module_count = module_count;
383 {
384 var module_t* module;
385 module_names_size = 0;
386 for_modules(all_modules, {
387 module_names_size += asciz_length(module->name)+1;
388 });
389 module_names_size = round_up(module_names_size,varobject_alignment);
390 }
391 header->_module_names_size = module_names_size;
392 header->_fsubr_count = fsubr_count;
393 header->_pseudofun_count = pseudofun_count;
394 #if !defined(OLD_GC) && defined(MULTITHREAD)
395 header->_per_thread_symvalues_count = num_symvalues;
396 #endif
397 header->_symbol_count = symbol_count;
398 header->_page_alignment = page_alignment;
399 header->_subr_tab_addr = (aint)(&subr_tab);
400 header->_symbol_tab_addr = (aint)(&symbol_tab);
401 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
402 #if !defined(GENERATIONAL_GC)
403 header->_mem_varobjects_start = mem.varobjects.heap_start;
404 header->_mem_varobjects_end = mem.varobjects.heap_end;
405 header->_mem_conses_start = mem.conses.heap_start;
406 header->_mem_conses_end = mem.conses.heap_end;
407 #else /* defined(GENERATIONAL_GC) */
408 header->_mem_varobjects_start = mem.varobjects.heap_gen0_start;
409 header->_mem_varobjects_end = mem.varobjects.heap_gen0_end;
410 header->_mem_conses_start = mem.conses.heap_gen0_start;
411 header->_mem_conses_end = mem.conses.heap_gen0_end;
412 #endif
413 #endif
414 #ifndef SPVW_MIXED_BLOCKS_OPPOSITE
415 header->_heapcount = heapcount;
416 #endif
417 return module_names_size;
418 }
419
420 #if defined(UNIX)
421 #define CLOSE_HANDLE CLOSE
422 #elif defined(WIN32_NATIVE)
423 #define CLOSE_HANDLE CloseHandle
424 #else
425 #error define CLOSE_HANDLE for your platform
426 #endif
427
428 #if defined(WIN32_NATIVE)
open_native_filename(const char * filename)429 local Handle open_native_filename (const char* filename)
430 {
431 var char resolved[MAX_PATH];
432 return /* try to resolve shell shortcuts in the filename */
433 CreateFile((real_path(filename,resolved) ? resolved : filename),
434 GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE,
435 NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
436 }
437 #endif
open_filename(const char * filename)438 local Handle open_filename (const char* filename)
439 { /* open file for reading: */
440 #if defined(UNIX)
441 return OPEN((char*)filename,O_RDONLY|O_BINARY,my_open_mask);
442 #elif defined(WIN32_NATIVE)
443 #define CYGDRIVE "/cygdrive/"
444 #define CYGDRIVE_LEN 10
445 #ifdef __MINGW32__
446 if (!strncasecmp(filename,CYGDRIVE,CYGDRIVE_LEN))
447 #else
448 if (!strncmp(filename,CYGDRIVE,CYGDRIVE_LEN)) /* MS lacks strncasecmp */
449 #endif
450 {
451 var uintL len = asciz_length(filename);
452 var DYNAMIC_ARRAY(newfilename,char,len);
453 newfilename[0] = filename[CYGDRIVE_LEN];
454 newfilename[1] = ':';
455 memcpy(newfilename+2,filename+CYGDRIVE_LEN+1,len-CYGDRIVE_LEN);
456 var Handle result = open_native_filename(newfilename);
457 FREE_DYNAMIC_ARRAY(newfilename);
458 return result;
459 }
460 #undef CYGDRIVE
461 #undef CYGDRIVE_LEN
462 else
463 return open_native_filename(filename);
464 #else
465 #error missing open_filename()
466 #endif
467 }
468
469 /* find the marker of given size in the open file handle */
find_marker(Handle handle,const char * marker,size_t marker_len)470 local size_t find_marker (Handle handle, const char* marker, size_t marker_len)
471 {
472 char buf[BUFSIZ];
473 size_t marker_pos = 0;
474 size_t pos = 0;
475 while (1) {
476 size_t result = full_read(handle,(void*)buf,BUFSIZ);
477 size_t i;
478 if (result <= 0)
479 return (size_t)-1;
480 for (i = 0; i < result; i++) {
481 pos++;
482 if (buf[i] == marker[marker_pos]) {
483 if (++marker_pos == marker_len) /* found! */
484 return pos - marker_len;
485 } else
486 marker_pos = 0;
487 }
488 }
489 return (size_t)-1;
490 }
491
492 /* the size of the runtime executable for executable dumping
493 == the start of memory image in the executable */
494 static size_t mem_start = (size_t)-1;
495 static bool mem_searched = false; /* have we looked for memdump already */
496
497 /* find the memory image in the file
498 there are two methods:
499 - the last sizeof(size_t) bytes in the executable are mem_start
500 this method is fast, i.e., O(1): constant time
501 #if defined(LOADMEM_TRY_SEARCH)
502 - find the memdump_header_t inside the file as if by CL:SEARCH
503 this method is expensive, i.e., O(NM) where N is the size of the executable
504 (runtime+image) and M is the size of the header (header_size below);
505 and can increase the startup time by as much as a few seconds
506 #endif
507 Since we always record mem_start in every executable image we write,
508 there is no reason to do the search.
509 If "image size" somehow fails, we want a bug report right away.
510 > fd : the open file descriptor (its position is changed)
511 < set mem_start and mem_searched */
find_memdump(Handle fd)512 local void find_memdump (Handle fd) {
513 var memdump_header_t header;
514 var size_t header_size = offsetof(memdump_header_t,_subr_tab_addr);
515 fill_memdump_header(&header);
516 /* "sizeof(size_t)" is unsigned, so "-sizeof(size_t)" is also unsigned,
517 so we need the "(off_t)" cast to pass a negative number to lseek() */
518 if (lseek(fd,-(off_t)sizeof(size_t),SEEK_END) > 0
519 && full_read(fd,(void*)&mem_start,sizeof(size_t)) == sizeof(size_t)
520 && lseek(fd,mem_start,SEEK_SET) == mem_start) {
521 var memdump_header_t header1;
522 full_read(fd,(void*)&header1,header_size);
523 #if !defined(OLD_GC) && defined(MULTITHREAD)
524 /* restore the count of symvalues. this field should not be used for
525 validation by compare */
526 header._per_thread_symvalues_count = header1._per_thread_symvalues_count;
527 #endif
528 if (memcmp((void*)&header,(void*)&header1,header_size) != 0) {
529 mem_start = (size_t)-1; /* bad header => no image */
530 }
531 } else {
532 #if defined(LOADMEM_TRY_SEARCH)
533 /* lseek+read does not work ==> use marker */
534 lseek(fd,0,SEEK_SET);
535 mem_start = find_marker(fd,(const char*)&header,header_size);
536 if (mem_start != (size_t)-1)
537 /* image size failed, but header is found -- this is fishy! */
538 fprintf(stderr,GETTEXTL("%s: 'image size' method failed, but found image header at %d\n"),get_executable_name(),mem_start);
539 #else
540 mem_start = (size_t)-1;
541 #endif
542 }
543 mem_searched = true;
544 }
545
546 /* ================================ SAVEMEM ================================ */
547
548 #define WRITE(buf,len) \
549 do { \
550 begin_system_call(); \
551 { var ssize_t result = full_write(handle,(void*)buf,len); \
552 if (result != (ssize_t)(len)) { \
553 end_system_call(); \
554 builtin_stream_close(&STACK_0,0); \
555 if (result<0) /* error occurred? */ \
556 { OS_file_error(TheStream(STACK_0)->strm_file_truename); } \
557 /* FILE-ERROR slot PATHNAME */ \
558 pushSTACK(TheStream(STACK_0)->strm_file_truename); \
559 error(file_error,GETTEXT("disk full")); \
560 } \
561 } \
562 end_system_call(); \
563 } while(0)
564
565 /* write the executable into the handle */
savemem_with_runtime(Handle handle,bool delegating)566 static void savemem_with_runtime (Handle handle, bool delegating) {
567 var char *executable_name = get_executable_name();
568 var char buf[BUFSIZ];
569 begin_system_call();
570 var Handle runtime = open_filename(executable_name);
571 /* if we did not look for memory image in the executable yet, do it now!
572 we want to avoid this scenario:
573 $ clisp -x '(saveinitmem "foo" :executable t)'
574 $ ./foo -M lispinit.mem -x '(saveinitmem "bar" :executable t)'
575 bar should not include 2 images, but foo received the -M option
576 and thus did not call loadmem_from_executable(),
577 so mem_searched is false and mem_start is 0,
578 so we need to call find_memdump() now
579 so that bar will get just one image */
580 if (!mem_searched) {
581 find_memdump(runtime); /* search for memdump_header_t */
582 lseek(runtime,0,SEEK_SET); /* reset position */
583 } /* now: mem_searched == true */
584 if (mem_start != (size_t)-1) { /* ==> have an image - cut it off */
585 var uintL remains = mem_start;
586 while (remains > 0) {
587 var ssize_t res = full_read(runtime,(void*)buf,BUFSIZ);
588 end_system_call();
589 if (res <= 0) {
590 builtin_stream_close(&STACK_0,0);
591 if (res < 0) /* error occurred? */
592 OS_file_error(TheStream(STACK_0)->strm_file_truename);
593 /* FILE-ERROR slot PATHNAME */
594 pushSTACK(asciz_to_string(executable_name,O(pathname_encoding)));
595 pushSTACK(fixnum(remains));
596 error(file_error,GETTEXT("runtime too small (~S bytes missing)"));
597 }
598 var uintL len = (remains > res ? res : remains);
599 remains -= len;
600 WRITE(buf,len);
601 begin_system_call();
602 }
603 } else { /* mem_start == -1 ==> no memory image in the executable,
604 just copy everything */
605 mem_start = 0;
606 while (1) {
607 var ssize_t res = full_read(runtime,(void*)buf,BUFSIZ);
608 if (res == 0) break;
609 end_system_call();
610 if (res < 0) {
611 builtin_stream_close(&STACK_0,0);
612 OS_file_error(TheStream(STACK_0)->strm_file_truename);
613 }
614 WRITE(buf,res);
615 mem_start += res;
616 begin_system_call();
617 }
618 }
619 if (delegating != delegating_p()) {
620 /* reset delegating_cookie in handle to delegating
621 (i.e., only handle --clisp-* command line arguments)
622 assume that the current executable has the same cookie as handle */
623 lseek(handle,0,SEEK_SET); /* search from file start */
624 var size_t delegating_cookie_pos = find_marker(handle,delegating_cookie,
625 delegating_cookie_length);
626 if (delegating_cookie_pos == (size_t)-1) {
627 /* FILE-ERROR slot PATHNAME */
628 pushSTACK(asciz_to_string(executable_name,O(pathname_encoding)));
629 error(file_error,GETTEXT("Delegating cookie not found"));
630 }
631 lseek(handle,delegating_cookie_pos+delegating_cookie_length-1,SEEK_SET);
632 WRITE((delegating ? "Y" : "N"),1); /* reset the cookie */
633 lseek(handle,0,SEEK_END); /* restore file position */
634 }
635 #if defined(UNIX) && defined(HAVE_FCHMOD)
636 { /* make the saved image executable */
637 var mode_t mode = 0;
638 var struct stat st;
639 if (fstat(handle,&st) == 0) mode = st.st_mode;
640 if (fstat(runtime,&st) == 0) mode |= st.st_mode;
641 fchmod(handle,mode);
642 }
643 #endif
644 CLOSE_HANDLE(runtime); end_system_call();
645 }
646
647 /* UP, stores the memory image on disk
648 savemem(stream,executable);
649 > object stream: open File-Output-Stream, will be closed
650 > uintL executable: 0: no runtime; 1: runtime; 2: also delegate command line
651 can trigger GC */
savemem(object stream,uintL executable)652 global maygc off_t savemem (object stream, uintL executable)
653 { /* We need the stream only because of the handle provided by it.
654 In case of an error we have to close it (the caller makes no
655 WITH-OPEN-FILE, but only OPEN). Hence, the whole stream is passed
656 to us, so that we can close it. */
657 var Handle handle = TheHandle(TheStream(stream)->strm_buffered_channel);
658 pushSTACK(stream); /* save stream */
659 /* GET-UNIVERSAL-TIME and MACHINE-INSTANCE cons,
660 so they should be called before gar_col() */
661 funcall(L(get_universal_time),0);
662 var uintL universal_time = I_to_UL(value1);
663 funcall(L(machine_instance),0);
664 var char hostname[DUMPHOST_LEN+1];
665 memset(hostname,'\0',DUMPHOST_LEN+1);
666 if (!nullp(value1)) {
667 with_string_0(value1,Symbol_value(S(utf_8)),host,{
668 strncpy(hostname,host,DUMPHOST_LEN);
669 });
670 }
671 /* execute one GC first: */
672 PERFORM_GC(gar_col(1),true); /* lock the heap before the GC */
673 if (executable>0) savemem_with_runtime(handle, executable>1);
674 /* write basic information: */
675 var memdump_header_t header;
676 var uintL module_names_size = fill_memdump_header(&header);
677 header._dumptime = universal_time;
678 memcpy(&header._dumphost[0],&hostname[0],DUMPHOST_LEN+1);
679 WRITE(&header,sizeof(header));
680 #if !defined(OLD_GC) && defined(MULTITHREAD)
681 /* save per thread special variables symvalues.
682 currently just a single thread. instead of:
683 for_all_threads({
684 WRITE(thread->_ptr_symvalues,num_symvalues*sizeof(gcv_object_t));
685 });
686 we will use: */
687 WRITE(allthreads.head->_ptr_symvalues,num_symvalues*sizeof(gcv_object_t));
688 #endif
689 { /* write module name: */
690 var DYNAMIC_ARRAY(module_names_buffer,char,module_names_size);
691 var char* ptr2 = &module_names_buffer[0];
692 var module_t* module;
693 var uintC count;
694 for_modules(all_modules, {
695 var const char* ptr1 = module->name;
696 while ((*ptr2++ = *ptr1++) != '\0') ;
697 });
698 dotimesC(count,&module_names_buffer[module_names_size] - ptr2, {
699 *ptr2++ = 0;
700 });
701 WRITE(module_names_buffer,module_names_size);
702 FREE_DYNAMIC_ARRAY(module_names_buffer);
703 }
704 /* write fsubr_tab, pseudofun_tab, symbol_tab: */
705 WRITE(&fsubr_tab,sizeof(fsubr_tab));
706 WRITE(&pseudofun_tab,sizeof(pseudofun_tab));
707 WRITE(&symbol_tab,sizeof(symbol_tab));
708 { /* write for each module subr_addr, subr_count, object_count,
709 subr_tab, object_tab: */
710 var module_t* module;
711 for_modules(all_modules, {
712 WRITE(&module->stab,sizeof(subr_t*));
713 WRITE(module->stab_size,sizeof(uintC));
714 WRITE(module->otab_size,sizeof(uintC));
715 WRITE(module->stab,*module->stab_size*sizeof(subr_t));
716 WRITE(module->otab,*module->otab_size*sizeof(gcv_object_t));
717 });
718 }
719 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
720 { /* write objects of variable length: */
721 var uintM len = header._mem_varobjects_end - header._mem_varobjects_start;
722 WRITE(header._mem_varobjects_start,len);
723 }
724 { /* write conses: */
725 var uintM len = header._mem_conses_end - header._mem_conses_start;
726 WRITE(header._mem_conses_start,len);
727 }
728 #endif
729 #ifndef SPVW_MIXED_BLOCKS_OPPOSITE
730 #ifdef SPVW_PAGES
731 {
732 var uintL heapnr;
733 for (heapnr=0; heapnr<heapcount; heapnr++) {
734 var uintC pagecount = 0;
735 map_heap(mem.heaps[heapnr],page, { pagecount++; } );
736 WRITE(&pagecount,sizeof(pagecount));
737 }
738 }
739 #endif
740 {
741 var uintL heapnr;
742 for (heapnr=0; heapnr<heapcount; heapnr++) {
743 #if !defined(GENERATIONAL_GC)
744 map_heap(mem.heaps[heapnr],page, {
745 var memdump_page_t _page;
746 _page._page_start = page->page_start;
747 _page._page_end = page->page_end;
748 WRITE(&_page,sizeof(_page));
749 });
750 #else /* defined(GENERATIONAL_GC) */
751 var Heap* heap = &mem.heaps[heapnr];
752 var memdump_page_t _page;
753 _page._page_start = heap->heap_gen0_start;
754 _page._page_end = heap->heap_gen0_end;
755 WRITE(&_page,sizeof(_page));
756 #endif
757 }
758 }
759 #if defined(SPVW_PURE_BLOCKS) && defined(GENERATIONAL_GC)
760 {
761 var uintL numphyspages[heapcount];
762 var uintL heapnr;
763 for (heapnr=0; heapnr<heapcount; heapnr++) {
764 var Heap* heap = &mem.heaps[heapnr];
765 numphyspages[heapnr] =
766 (heap->physpages==NULL ? 0 :
767 (((heap->heap_gen0_end + (physpagesize-1)) & -physpagesize)
768 - (heap->heap_gen0_start & -physpagesize)
769 ) >> physpageshift);
770 }
771 WRITE(&numphyspages,sizeof(numphyspages));
772 for (heapnr=0; heapnr<heapcount; heapnr++)
773 if (numphyspages[heapnr] > 0) {
774 var uintL count = numphyspages[heapnr];
775 var Heap* heap = &mem.heaps[heapnr];
776 var physpage_state_t* physpages = heap->physpages;
777 var DYNAMIC_ARRAY(_physpages,memdump_physpage_state_t,count);
778 var uintL i;
779 for (i=0; i<count; i++) {
780 _physpages[i].continued_addr = physpages[i].continued_addr;
781 _physpages[i].continued_count = physpages[i].continued_count;
782 _physpages[i].firstobject = physpages[i].firstobject;
783 }
784 WRITE(_physpages,count*sizeof(memdump_physpage_state_t));
785 FREE_DYNAMIC_ARRAY(_physpages);
786 }
787 }
788 #endif
789 #if (defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))
790 #if defined(HAVE_MMAP) /* else, page_alignment is = 1, anyway */
791 { /* put alignment into practice: */
792 begin_system_call();
793 var off_t result = lseek(handle,0,SEEK_CUR); /* fetch file-position */
794 end_system_call();
795 if (result<0) { builtin_stream_close(&STACK_0,0); OS_file_error(TheStream(STACK_0)->strm_file_truename); } /* error? */
796 WRITE_page_alignment(result);
797 }
798 #endif
799 #endif
800 {
801 var uintL heapnr;
802 for (heapnr=0; heapnr<heapcount; heapnr++) {
803 var uintM misaligned = 0;
804 #if ((defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))) && defined(HAVE_MMAP) && varobjects_misaligned
805 if (is_varobject_heap(heapnr)) {
806 var uintB zeroes[varobjects_misaligned];
807 var uintB* ptr = &zeroes[0];
808 doconsttimes(varobjects_misaligned, { *ptr++ = 0; } );
809 /* write zeroes: */
810 WRITE(&zeroes[0],varobjects_misaligned);
811 misaligned = varobjects_misaligned;
812 }
813 #endif
814 #if !defined(GENERATIONAL_GC)
815 map_heap(mem.heaps[heapnr],page, {
816 var uintM len = page->page_end - page->page_start;
817 WRITE(page->page_start,len);
818 WRITE_page_alignment(misaligned+len);
819 });
820 #else /* defined(GENERATIONAL_GC) */
821 var Heap* heap = &mem.heaps[heapnr];
822 var uintM len = heap->heap_gen0_end - heap->heap_gen0_start;
823 WRITE(heap->heap_gen0_start,len);
824 WRITE_page_alignment(misaligned+len);
825 #endif
826 }
827 }
828 #ifdef SPVW_PURE_BLOCKS
829 { /* write relocations:
830 (only frame-pointers, subr, machine must be relocated, and
831 hashtables and fpointers must be marked, see
832 update_varobjects(), update_record(), loadmem_update().) */
833 var memdump_reloc_header_t rheader;
834 rheader.reloccount = 0;
835 rheader.htcount = 0;
836 rheader.fpcount = 0;
837 rheader.fscount = 0;
838 #if !defined(GENERATIONAL_GC)
839 #define update_conspage update_conspage_normal
840 #define update_page update_page_normal
841 #else /* defined(GENERATIONAL_GC) */
842 #define update_conspage(page) /* ignores page, uses heapnr */ \
843 do { var aint objptr = mem.heaps[heapnr].heap_gen0_start; \
844 var aint objptrend = mem.heaps[heapnr].heap_gen0_end; \
845 /* update all pointers in the (new) CONS-region */ \
846 /* start <= address < end: */ \
847 while (objptr != objptrend) { \
848 update((gcv_object_t*)objptr); \
849 objptr += sizeof(gcv_object_t); \
850 update((gcv_object_t*)objptr); \
851 objptr += sizeof(gcv_object_t); \
852 }} while(0)
853 #define update_page(page,updater) /* ignores page, uses heapnr */ \
854 do { var aint ptr = mem.heaps[heapnr].heap_gen0_start; \
855 var aint ptrend = mem.heaps[heapnr].heap_gen0_end; \
856 /* traverse all objects with address >=ptr, <ptrend : */ \
857 while (ptr != ptrend) { /* until ptr has reached the end */ \
858 /* traverse next object with address ptr (< ptrend) : */ \
859 updater(typecode_at(ptr)); /* and advance */ \
860 }} while(0)
861 #endif
862 #define update_hashtable_invalid true
863 #define update_unrealloc false
864 #define update_ss_unrealloc(obj)
865 #define update_in_unrealloc(obj)
866 #ifdef FOREIGN
867 #define update_fpointer_invalid true
868 #else
869 #define update_fpointer_invalid false
870 #endif
871 #define update_fsubr_function true
872 #define update(objptr) \
873 do { switch (mtypecode(*(gcv_object_t*)objptr)) { \
874 case_system: \
875 if (wbit_test(as_oint(*(gcv_object_t*)objptr),0+oint_addr_shift)) \
876 break; \
877 case_subr: \
878 case_machine: \
879 rheader.reloccount++; \
880 default: \
881 break; \
882 }} while(0)
883 #define update_ht_invalid(obj) rheader.htcount++;
884 #define update_fp_invalid(obj) rheader.fpcount++;
885 #define update_fs_function(obj) rheader.fscount++;
886 update_conses();
887 update_varobjects();
888 #undef update_fs_function
889 #undef update_fp_invalid
890 #undef update_ht_invalid
891 #undef update
892 var DYNAMIC_ARRAY(relocbuf,gcv_object_t*,rheader.reloccount);
893 var DYNAMIC_ARRAY(htbuf,Hashtable,rheader.htcount);
894 var DYNAMIC_ARRAY(fpbuf,Record,rheader.fpcount);
895 var DYNAMIC_ARRAY(fsbuf,Fsubr,rheader.fscount);
896 var gcv_object_t** relocbufptr = &relocbuf[0];
897 var Hashtable* htbufptr = &htbuf[0];
898 var Record* fpbufptr = &fpbuf[0];
899 var Fsubr* fsbufptr = &fsbuf[0];
900 #define update(objptr) \
901 do { \
902 switch (mtypecode(*(gcv_object_t*)objptr)) { \
903 case_system: \
904 if (wbit_test(as_oint(*(gcv_object_t*)objptr),0+oint_addr_shift)) \
905 break; \
906 case_subr: \
907 case_machine: \
908 *relocbufptr++ = (gcv_object_t*)objptr; \
909 default: \
910 break; \
911 } \
912 } while(0)
913 #define update_ht_invalid(obj) *htbufptr++ = (obj);
914 #define update_fp_invalid(obj) *fpbufptr++ = (obj);
915 #define update_fs_function(obj) *fsbufptr++ = (obj);
916 update_conses();
917 update_varobjects();
918 #undef update_fs_function
919 #undef update_fp_invalid
920 #undef update_ht_invalid
921 #undef update
922 #undef update_fsubr_function
923 #undef update_fpointer_invalid
924 #undef update_in_unrealloc
925 #undef update_ss_unrealloc
926 #undef update_unrealloc
927 #undef update_hashtable_invalid
928 #undef update_page
929 #undef update_conspage
930 WRITE(&rheader,sizeof(rheader));
931 WRITE(&relocbuf[0],rheader.reloccount*sizeof(gcv_object_t*));
932 WRITE(&htbuf[0],rheader.htcount*sizeof(Hashtable));
933 WRITE(&fpbuf[0],rheader.fpcount*sizeof(Record));
934 WRITE(&fsbuf[0],rheader.fscount*sizeof(Fsubr));
935 FREE_DYNAMIC_ARRAY(fsbuf);
936 FREE_DYNAMIC_ARRAY(fpbuf);
937 FREE_DYNAMIC_ARRAY(htbuf);
938 FREE_DYNAMIC_ARRAY(relocbuf);
939 }
940 #endif
941 #endif
942 if (executable>0) WRITE(&mem_start,sizeof(size_t)); /* see find_memdump() */
943 else { size_t tmp = (size_t)-1; WRITE(&tmp,sizeof(size_t)); }
944 /* close stream (stream-buffer is unchanged, but thus also the
945 handle at the operating system is closed): */
946 var off_t res;
947 begin_blocking_system_call();
948 res = handle_length(&STACK_0,handle);
949 end_blocking_system_call();
950 builtin_stream_close(&STACK_0,0);
951 skipSTACK(1);
952 return res;
953 }
954 #undef WRITE
955
956 /* ================================ LOADMEM ================================ */
957
958 /* update of an object in memory: */
959 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
960 local var oint offset_varobjects_o;
961 local var oint offset_conses_o;
962 #endif
963 #ifdef SPVW_MIXED_BLOCKS_STAGGERED
964 local var oint offset_heaps_o[heapcount];
965 #define offset_varobjects_o offset_heaps_o[0]
966 #define offset_conses_o offset_heaps_o[1]
967 #endif
968 #ifdef SINGLEMAP_MEMORY_RELOCATE
969 local var oint offset_heaps_o[heapcount];
970 local var bool offset_heaps_all_zero;
971 #endif
972 #ifdef SPVW_PAGES
973 typedef struct { aint old_page_start; oint offset_page_o; } offset_pages_t;
974 local var offset_pages_t *offset_pages;
975 #define addr_mask ~(((oint_addr_mask>>oint_addr_shift) & ~ (wbitm(oint_addr_relevant_len)-1)) << addr_shift) /* mostly = ~0 */
976 #define pagenr_of(addr) floor(addr,min_page_size_brutto)
977 #define offset_pages_len (pagenr_of((oint)((wbitm(oint_addr_relevant_len)-1)<<addr_shift))+1)
978 #endif
979 #if !defined(SINGLEMAP_MEMORY)
980 local var oint offset_symbols_o;
981 local var oint old_symbol_tab_o;
982 #endif
983 typedef struct { oint low_o; oint high_o; oint offset_o; } offset_subrs_t;
984 local var offset_subrs_t* offset_subrs;
985 local var uintC offset_subrs_count;
986 local var struct fsubr_tab_ old_fsubr_tab;
987 local var struct pseudofun_tab_ old_pseudofun_tab;
loadmem_update(gcv_object_t * objptr)988 local void loadmem_update (gcv_object_t* objptr)
989 {
990 #ifdef TYPECODES
991 switch (mtypecode(*objptr))
992 #else
993 if (orecordp(*objptr)) {
994 goto case_record;
995 } else if (consp(*objptr)) {
996 goto case_cons;
997 } else if (immsubrp(*objptr)) {
998 goto case_subr;
999 } else if (machinep(*objptr)) {
1000 goto case_machine;
1001 } else {
1002 return;
1003 }
1004 switch (0)
1005 #endif
1006 {
1007 #ifdef TYPECODES
1008 case_symbol: /* symbol */
1009 #ifndef SPVW_PURE_BLOCKS
1010 if (as_oint(*objptr) - old_symbol_tab_o
1011 < ((oint)sizeof(symbol_tab)<<(oint_addr_shift-addr_shift))) {
1012 /* symbol from symbol_tab */
1013 *objptr = as_object(as_oint(*objptr) + offset_symbols_o); break;
1014 }
1015 /* other symbols are objects of variable length. */
1016 #endif
1017 #endif
1018 case_record:
1019 #ifdef HEAPCODES
1020 if (as_oint(*objptr) - old_symbol_tab_o
1021 < ((oint)sizeof(symbol_tab)<<(oint_addr_shift-addr_shift))) {
1022 /* symbol from symbol_tab */
1023 *objptr = as_object(as_oint(*objptr) + offset_symbols_o); break;
1024 }
1025 #endif
1026 #if defined(KERNELVOID32_HEAPCODES) || defined(GENERIC64_HEAPCODES)
1027 { /* Test for a SUBR in one of the modules. */
1028 var oint addr = as_oint(*objptr);
1029 var offset_subrs_t* ptr = offset_subrs;
1030 var uintC count;
1031 dotimespC(count,offset_subrs_count, {
1032 if ((ptr->low_o <= addr) && (addr < ptr->high_o)) {
1033 *objptr = as_object(as_oint(*objptr) + ptr->offset_o);
1034 goto found_subr;
1035 }
1036 ptr++;
1037 });
1038 }
1039 #endif
1040 #ifdef TYPECODES
1041 case_array:
1042 case_bignum:
1043 #ifndef IMMEDIATE_FFLOAT
1044 case_ffloat:
1045 #endif
1046 case_dfloat:
1047 case_lfloat:
1048 #endif
1049 /* object of variable length */
1050 #ifdef SPVW_MIXED_BLOCKS
1051 { *objptr = as_object(as_oint(*objptr) + offset_varobjects_o); break; }
1052 #endif
1053 case_pair:
1054 /* Two-Pointer-Object */
1055 #ifdef SPVW_MIXED_BLOCKS
1056 { *objptr = as_object(as_oint(*objptr) + offset_conses_o); break; }
1057 #endif
1058 #ifdef SPVW_PAGES
1059 {
1060 var aint addr = /* address */
1061 #ifdef TYPECODES
1062 upointer(*(gcv_object_t*)objptr);
1063 #else
1064 as_oint(*(gcv_object_t*)objptr);
1065 #endif
1066 /* As pages have a minimal length, so the start addresses
1067 of different pages have at least a distance of
1068 min_page_size_brutto, it is quite simple, to conclude from the
1069 address to the page: */
1070 var uintL pagenr = pagenr_of(addr & addr_mask);
1071 if (addr < offset_pages[pagenr].old_page_start) { pagenr--; }
1072 *objptr = as_object(as_oint(*objptr) +
1073 offset_pages[pagenr].offset_page_o);
1074 }
1075 break;
1076 #endif
1077 #ifdef SPVW_PURE_BLOCKS /* SINGLEMAP_MEMORY */
1078 #ifdef SINGLEMAP_MEMORY_RELOCATE
1079 *objptr = as_object(as_oint(*objptr) +
1080 offset_heaps_o[mtypecode(*objptr)]);
1081 break;
1082 #else
1083 break; /* everything so far experiences no displacement */
1084 #endif
1085 #endif
1086 /*---NOTREACHED---*/
1087 #if !(defined(KERNELVOID32_HEAPCODES) || defined(GENERIC64_HEAPCODES))
1088 case_subr: { /* SUBR */
1089 var oint addr = as_oint(*objptr);
1090 var offset_subrs_t* ptr = offset_subrs;
1091 var uintC count;
1092 dotimespC(count,offset_subrs_count, {
1093 if ((ptr->low_o <= addr) && (addr < ptr->high_o)) {
1094 *objptr = as_object(as_oint(*objptr) + ptr->offset_o);
1095 goto found_subr;
1096 }
1097 ptr++;
1098 });
1099 /* SUBR not found -> #<UNBOUND> */
1100 *objptr = unbound;
1101 }
1102 #endif
1103 found_subr:
1104 break;
1105 /*---NOTREACHED---*/
1106 #ifdef TYPECODES
1107 case_system: /* frame-pointer or small-read-label or system-constant */
1108 if ((as_oint(*objptr) & wbit(0+oint_addr_shift)) ==0) {
1109 /* Frame-Pointer -> #<DISABLED> */
1110 *objptr = disabled;
1111 }
1112 break;
1113 #endif
1114 /*---NOTREACHED---*/
1115 case_machine: { /* pseudo-function or other machine pointer */
1116 /* conversion old_pseudofun_tab -> pseudofun_tab : */
1117 var object addr = *objptr;
1118 {
1119 var uintC i = pseudofun_count;
1120 var const object* ptr = &old_pseudofun_tab.pointer[pseudofun_count];
1121 while (i!=0) {
1122 i--;
1123 if (eq(*--ptr,addr)) {
1124 *objptr = pseudofun_tab.pointer[i]; break;
1125 }
1126 }
1127 }
1128 /* other machine pointer */
1129 break;
1130 }
1131 /*---NOTREACHED---*/
1132 #ifdef TYPECODES
1133 case_char:
1134 case_fixnum:
1135 case_sfloat:
1136 #ifdef IMMEDIATE_FFLOAT
1137 case_ffloat:
1138 #endif
1139 #endif
1140 break;
1141 /*---NOTREACHED---*/
1142 #if defined(KERNELVOID32_HEAPCODES) || defined(GENERIC64_HEAPCODES)
1143 case_subr: /* immediate Subrs don't exist in this case */
1144 #endif
1145 default: /*NOTREACHED*/ abort();
1146 }
1147 }
loadmem_update_fsubr(Fsubr fsubrptr)1148 local void loadmem_update_fsubr (Fsubr fsubrptr)
1149 {
1150 var void* addr = fsubrptr->function;
1151 var uintC i = fsubr_count;
1152 var fsubr_t* p = &((fsubr_t*)(&old_fsubr_tab))[fsubr_count];
1153 while (i!=0) {
1154 i--;
1155 if ((void*) *--p == addr) {
1156 fsubrptr->function = (void*) ((const fsubr_t *)(&fsubr_tab))[i];
1157 break;
1158 }
1159 }
1160 }
1161
1162 typedef enum { op_extract_mfih, op_test_compatibility, op_load } memfile_operation;
1163 /* Performs an operation on a mem file, given as a handle.
1164 > handle: open handle to the contents of the mem file.
1165 < true if successful, false upon fatal error
1166 The handle gets closed by this function, except in the case of a successful op_load operation. */
memfile_handle_do_operation(Handle handle,const char * filename,memfile_operation op,void * arg)1167 local bool memfile_handle_do_operation (Handle handle, const char* filename, memfile_operation op, void* arg)
1168 {
1169 var memdump_header_t header;
1170 {
1171 #if (defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))
1172 #if defined(HAVE_MMAP)
1173 local var bool use_mmap = true;
1174 #endif
1175 var off_t file_offset;
1176 #define set_file_offset(x) file_offset = (x)
1177 #define inc_file_offset(x) file_offset += (uintM)(x)
1178 #else
1179 #define set_file_offset(x)
1180 #define inc_file_offset(x)
1181 #endif
1182 #if defined(DEBUG_SPVW)
1183 #define FILE_LINE fprintf(stderr,"[%s:%d] ",__FILE__,__LINE__)
1184 #else
1185 #define FILE_LINE /*noop*/
1186 #endif
1187 #define ABORT_SYS do { FILE_LINE; goto abort_sys; } while(0)
1188 #define ABORT_INCOMPAT2 do { FILE_LINE; goto abort_incompat2; } while(0)
1189 #define ABORT_MEM do { FILE_LINE; goto abort_mem; } while(0)
1190 #define READ(buf,len) \
1191 do { \
1192 begin_system_call(); \
1193 { var ssize_t result = full_read(handle,(void*)buf,len); \
1194 end_system_call(); \
1195 if (result<0) ABORT_SYS; \
1196 if (result != (ssize_t)(len)) ABORT_INCOMPAT2; \
1197 inc_file_offset(len); \
1198 } \
1199 } while(0)
1200 begin_read:
1201 if (mem_searched) {set_file_offset(mem_start);}
1202 else {set_file_offset(0);}
1203 /* read basic information: */
1204 READ(&header,sizeof(header));
1205 if (header._magic != memdump_magic) {
1206 #ifdef UNIX
1207 /* try to unzip the file on the fly with GZIP. */
1208 var uintB* file_header = (uintB*)&header; /* use sizeof(header) >= 2 */
1209 if (file_header[0] == '#' && file_header[1] == '!') { /* executable magic ? */
1210 /* skip first text line */
1211 var char c;
1212 begin_system_call();
1213 if ( lseek(handle,-(off_t)sizeof(header),SEEK_CUR) <0)
1214 ABORT_SYS; /* in file, back to the start */
1215 do { READ(&c,1); } while (c!='\n');
1216 end_system_call();
1217 #if ((defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))) && defined(HAVE_MMAP)
1218 use_mmap = false; /* the file-offsets have been displaced! */
1219 #endif
1220 goto begin_read;
1221 }
1222 if (file_header[0] == 0x1F && file_header[1] == 0x8B) { /* gzip magic ? */
1223 /* open pipe, see make_pipe_input_stream in STREAM.D */
1224 var int handles[2];
1225 var int child;
1226 begin_system_call();
1227 if ( lseek(handle,-(off_t)sizeof(header),SEEK_CUR) <0)
1228 ABORT_SYS; /* in file, back to the start */
1229 if (pipe(handles) != 0)
1230 ABORT_SYS;
1231 if ((child = vfork()) ==0) {
1232 if ( dup2(handles[1],stdout_handle) >=0)
1233 if ( CLOSE(handles[1]) ==0)
1234 if ( CLOSE(handles[0]) ==0)
1235 if ( dup2(handle,stdin_handle) >=0) {
1236 /* be the File the input of the decompression */
1237 /* call decompressor. NB: "gzip -d" == "gunzip" */
1238 #if 0
1239 execl("/bin/sh","/bin/sh","-c","gzip -d -c",NULL);
1240 #else /* it works also without shell */
1241 execlp("gzip","gzip","-d","-c",NULL);
1242 #endif
1243 }
1244 _exit(-1);
1245 }
1246 if (child==-1) {
1247 CLOSE(handles[1]); CLOSE(handles[0]); ABORT_SYS;
1248 }
1249 if (CLOSE(handles[1]) !=0)
1250 ABORT_SYS;
1251 if (CLOSE(handle) != 0)
1252 ABORT_SYS;
1253 end_system_call();
1254 #if ((defined(SPVW_PURE_BLOCKS) && defined(SINGLEMAP_MEMORY)) || (defined(SPVW_MIXED_BLOCKS_STAGGERED) && defined(TRIVIALMAP_MEMORY))) && defined(HAVE_MMAP)
1255 use_mmap = false; /* mmap can not be done with a pipe! */
1256 #endif
1257 var bool result = memfile_handle_do_operation(handles[0],filename,op,arg); /* now, we read from the pipe */
1258 begin_system_call();
1259 wait2(child); /* remove zombie-child */
1260 end_system_call();
1261 return result;
1262 }
1263 #endif /* UNIX */
1264 ABORT_INCOMPAT2;
1265 }
1266 if (op == op_extract_mfih) {
1267 memcpy(arg,&header._mfihash[0],MFIH_LEN);
1268 goto close_and_return_true;
1269 }
1270 /* Now that we have read the header, we may goto abort_incompat1. */
1271 #define ABORT_INCOMPAT1 do { FILE_LINE; goto abort_incompat1; } while(0)
1272 if (header._memflags != memflags) ABORT_INCOMPAT1;
1273 /* Do NOT compare header._mfihash here. See the comment about is_mem_file_compatible. */
1274 if (header._oint_type_mask != oint_type_mask) ABORT_INCOMPAT1;
1275 if (header._oint_addr_mask != oint_addr_mask) ABORT_INCOMPAT1;
1276 #ifdef TYPECODES
1277 if (header._cons_type != cons_type) ABORT_INCOMPAT1;
1278 if (header._complex_type != complex_type) ABORT_INCOMPAT1;
1279 if (header._symbol_type != symbol_type) ABORT_INCOMPAT1;
1280 if (header._system_type != system_type) ABORT_INCOMPAT1;
1281 #endif
1282 if (header._varobject_alignment != varobject_alignment) ABORT_INCOMPAT1;
1283 if (header._hashtable_length != hashtable_length) ABORT_INCOMPAT1;
1284 if (header._pathname_length != pathname_length) ABORT_INCOMPAT1;
1285 if (header._intDsize != intDsize) ABORT_INCOMPAT1;
1286 if (header._fsubr_count != fsubr_count) ABORT_INCOMPAT1;
1287 if (header._pseudofun_count != pseudofun_count) ABORT_INCOMPAT1;
1288 if (header._symbol_count != symbol_count) ABORT_INCOMPAT1;
1289 if (header._page_alignment != page_alignment) ABORT_INCOMPAT1;
1290 #ifndef SPVW_MIXED_BLOCKS_OPPOSITE
1291 if (header._heapcount != heapcount) ABORT_INCOMPAT1;
1292 #endif
1293
1294 #if !defined(OLD_GC) && defined(MULTITHREAD)
1295 /* allocate per thread symvalues for the thread */
1296 {
1297 var uintL max_symvalues=
1298 (uintL)((header._per_thread_symvalues_count/SYMVALUES_PER_PAGE)+1) *
1299 SYMVALUES_PER_PAGE;
1300 /* no need to lock allthreads_lock before reallocation since we are the
1301 only thread running now */
1302 if (!realloc_threads_symvalues(max_symvalues))
1303 goto abort_mem;
1304 num_symvalues=header._per_thread_symvalues_count;
1305 if (maxnum_symvalues < max_symvalues)
1306 maxnum_symvalues = max_symvalues;
1307 }
1308 /* read the thread symvalues for the only thread */
1309 READ(allthreads.head->_ptr_symvalues,num_symvalues*sizeof(gcv_object_t));
1310 #endif
1311
1312 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
1313 /* Determine if there is enough memory.
1314 It's sufficient if and only if
1315 required room <= available room
1316 <==>
1317 header._mem_conses_end - header._mem_conses_start
1318 + header._mem_varobjects_end - header._mem_varobjects_start
1319 <= mem.conses.heap_end - mem.varobjects.heap_start
1320 Note that the left-hand side is the sum of two nonnegative values
1321 and does not overflow (since the memory image fit into the address
1322 range before it was saved). */
1323 if ((header._mem_conses_end - header._mem_conses_start)
1324 + (header._mem_varobjects_end - header._mem_varobjects_start)
1325 > mem.conses.heap_end - mem.varobjects.heap_start)
1326 ABORT_MEM;
1327 { /* calculate offsets (offset = new address - old address): */
1328 var sintM offset_varobjects = /* offset for objects of variable length */
1329 mem.varobjects.heap_start - header._mem_varobjects_start;
1330 var sintM offset_conses = /* offset for two-pointer-objects */
1331 mem.conses.heap_end - header._mem_conses_end;
1332 /* calculate new memory partitioning: */
1333 mem.varobjects.heap_end = header._mem_varobjects_end + offset_varobjects;
1334 mem.conses.heap_start = header._mem_conses_start + offset_conses;
1335 /* Note that these don't overflow nor get negative, because of the
1336 inequality that was already checked above:
1337
1338 header._mem_varobjects_start <= header._mem_varobjects_end
1339 <==>
1340 mem.varobjects.heap_start <= mem.varobjects.heap_end
1341
1342 header._mem_varobjects_end - header._mem_varobjects_start
1343 <= mem.conses.heap_end - mem.varobjects.heap_start
1344 <==>
1345 mem.varobjects.heap_end <= mem.conses.heap_end
1346
1347 header._mem_conses_end - header._mem_conses_start
1348 <= mem.conses.heap_end - mem.varobjects.heap_start
1349 <==>
1350 mem.varobjects.heap_start <= mem.conses.heap_start
1351
1352 header._mem_conses_start <= header._mem_conses_end
1353 <==>
1354 mem.conses.heap_start <= mem.conses.heap_end
1355
1356 Note that the varobjects and conses won't overlap, since,
1357 considerung the full strength of the inequality:
1358 header._mem_conses_end - header._mem_conses_start
1359 + header._mem_varobjects_end - header._mem_varobjects_start
1360 <= mem.conses.heap_end - mem.varobjects.heap_start
1361 <==>
1362 mem.varobjects.heap_end <= mem.conses.heap_start
1363 */
1364 /* prepare update: */
1365 offset_varobjects_o = (oint)offset_varobjects << (oint_addr_shift-addr_shift);
1366 offset_conses_o = (oint)offset_conses << (oint_addr_shift-addr_shift);
1367 }
1368 #endif /* SPVW_MIXED_BLOCKS_OPPOSITE */
1369 #ifdef SPVW_PURE_BLOCKS /* SINGLEMAP_MEMORY */
1370 if ((aint)(&subr_tab) != header._subr_tab_addr) ABORT_INCOMPAT1;
1371 if ((aint)(&symbol_tab) != header._symbol_tab_addr) ABORT_INCOMPAT1;
1372 #else
1373 offset_symbols_o = ((oint)(aint)(&symbol_tab) - (oint)header._symbol_tab_addr) << (oint_addr_shift-addr_shift);
1374 #ifdef TYPECODES
1375 old_symbol_tab_o = as_oint(type_pointer_object(symbol_type,header._symbol_tab_addr));
1376 #else
1377 old_symbol_tab_o = (oint)header._symbol_tab_addr;
1378 #endif /* TYPECODES */
1379 #endif /* SPVW_PURE_BLOCKS */
1380 /* initialize offset-of-SUBRs-table: */
1381 offset_subrs_count = 1+header._module_count;
1382 begin_system_call();
1383 offset_subrs = MALLOC(offset_subrs_count,offset_subrs_t);
1384 end_system_call();
1385 if (offset_subrs==NULL)
1386 ABORT_MEM;
1387 /* read module names and compare with the existing modules: */
1388 var DYNAMIC_ARRAY(old_modules,module_t*,1+header._module_count);
1389 {
1390 var DYNAMIC_ARRAY(module_names_buffer,char,header._module_names_size);
1391 READ(module_names_buffer,header._module_names_size);
1392 {
1393 var module_t* * old_module = &old_modules[0];
1394 var const char* old_name = &module_names_buffer[0];
1395 var uintC count;
1396 dotimespC(count,1+header._module_count, {
1397 var module_t* module;
1398 for_modules(all_modules, {
1399 if (asciz_equal(old_name,module->name))
1400 goto found_module;
1401 });
1402 /* old_name not found */
1403 ABORT_INCOMPAT1;
1404 found_module:
1405 /* Reading the module data from file initializes the module. */
1406 module->initialized = true;
1407 *old_module++ = module;
1408 old_name += asciz_length(old_name)+1;
1409 });
1410 }
1411 FREE_DYNAMIC_ARRAY(module_names_buffer);
1412 }
1413 /* read fsubr_tab, pseudofun_tab, symbol_tab: */
1414 READ(&old_fsubr_tab,sizeof(fsubr_tab));
1415 READ(&old_pseudofun_tab,sizeof(pseudofun_tab));
1416 READ(&symbol_tab,sizeof(symbol_tab));
1417 { /* for each module read subr_addr, subr_count, object_count, subr_tab,
1418 object_tab : */
1419 var module_t* * old_module = &old_modules[0];
1420 var offset_subrs_t* offset_subrs_ptr = &offset_subrs[0];
1421 var uintC count = 1+header._module_count;
1422 do {
1423 var subr_t* old_subr_addr;
1424 var uintC old_subr_count;
1425 var uintC old_object_count;
1426 READ(&old_subr_addr,sizeof(subr_t*));
1427 READ(&old_subr_count,sizeof(uintC));
1428 READ(&old_object_count,sizeof(uintC));
1429 if (old_subr_count != *(*old_module)->stab_size) ABORT_INCOMPAT1;
1430 if (old_object_count != *(*old_module)->otab_size) ABORT_INCOMPAT1;
1431 offset_subrs_ptr->low_o = as_oint(subr_tab_ptr_as_object(old_subr_addr));
1432 offset_subrs_ptr->high_o = as_oint(subr_tab_ptr_as_object(old_subr_addr+old_subr_count));
1433 offset_subrs_ptr->offset_o = as_oint(subr_tab_ptr_as_object((*old_module)->stab)) - offset_subrs_ptr->low_o;
1434 if (old_subr_count > 0) {
1435 var DYNAMIC_ARRAY(old_subr_tab,subr_t,old_subr_count);
1436 READ(old_subr_tab,old_subr_count*sizeof(subr_t));
1437 var subr_t* ptr1 = old_subr_tab;
1438 var subr_t* ptr2 = (*old_module)->stab;
1439 var uintC counter = old_subr_count;
1440 do {
1441 if (!( (ptr1->req_count == ptr2->req_count)
1442 && (ptr1->opt_count == ptr2->opt_count)
1443 && (ptr1->rest_flag == ptr2->rest_flag)
1444 && (ptr1->key_flag == ptr2->key_flag)
1445 && (ptr1->key_count == ptr2->key_count)))
1446 ABORT_INCOMPAT1;
1447 ptr2->name = ptr1->name; ptr2->keywords = ptr1->keywords;
1448 ptr2->argtype = ptr1->argtype;
1449 ptr1++; ptr2++;
1450 } while (--counter);
1451 FREE_DYNAMIC_ARRAY(old_subr_tab);
1452 }
1453 if (old_object_count > 0) {
1454 READ((*old_module)->otab,old_object_count*sizeof(gcv_object_t));
1455 }
1456 old_module++; offset_subrs_ptr++;
1457 } while (--count);
1458 }
1459 #undef ABORT_INCOMPAT1
1460 /* No more ABORT_INCOMPAT1 invocations beyond this point. */
1461 if (op == op_test_compatibility) {
1462 *(bool*)arg = true;
1463 goto close_and_return_true;
1464 }
1465 if (!(op == op_load)) NOTREACHED;
1466 /* op_load handling: Read or mmap the entire contents of the mem file into memory. */
1467 #ifdef SPVW_PURE_BLOCKS
1468 #ifdef SINGLEMAP_MEMORY_RELOCATE
1469 { /* read start- and end-addresses of each Heap and compare
1470 with mem.heaps[]: */
1471 var memdump_page_t old_pages[heapcount];
1472 var memdump_page_t* old_page;
1473 var uintL heapnr;
1474 READ(&old_pages,sizeof(old_pages));
1475 offset_heaps_all_zero = true;
1476 old_page = &old_pages[0];
1477 for (heapnr=0; heapnr<heapcount; heapnr++) {
1478 var Heap* heapptr = &mem.heaps[heapnr];
1479 if (old_page->_page_end - old_page->_page_start
1480 > heapptr->heap_hardlimit - heapptr->heap_limit)
1481 ABORT_MEM;
1482 heapptr->heap_start = heapptr->heap_limit;
1483 heapptr->heap_end = heapptr->heap_limit + (old_page->_page_end - old_page->_page_start);
1484 offset_heaps_o[heapnr] = (oint)heapptr->heap_start - (oint)old_page->_page_start;
1485 if (offset_heaps_o[heapnr] != 0)
1486 offset_heaps_all_zero = false;
1487 old_page++;
1488 }
1489 #if defined(HAVE_MMAP)
1490 if (!offset_heaps_all_zero)
1491 use_mmap = false;
1492 #endif
1493 }
1494 #else
1495 { /* take over start- and end-addresses of each heap in mem.heaps[] : */
1496 var uintL heapnr;
1497 var memdump_page_t old_pages[heapcount];
1498 var memdump_page_t* old_page;
1499 READ(&old_pages,sizeof(old_pages));
1500 old_page = &old_pages[0];
1501 for (heapnr=0; heapnr<heapcount; heapnr++) {
1502 map_heap(mem.heaps[heapnr],page, {
1503 page->page_start = old_page->_page_start;
1504 page->page_end = old_page->_page_end;
1505 old_page++;
1506 });
1507 }
1508 }
1509 #endif /* SINGLEMAP_MEMORY_RELOCATE */
1510 #endif /* SPVW_PURE_BLOCKS */
1511 #ifdef SPVW_MIXED_BLOCKS_STAGGERED
1512 { /* read start- and end-addresses of each heap and adjust
1513 the size in mem.heaps[] to the same length: */
1514 var uintL heapnr;
1515 var memdump_page_t old_pages[heapcount];
1516 var memdump_page_t* old_page;
1517 READ(&old_pages,sizeof(old_pages));
1518 old_page = &old_pages[0];
1519 for (heapnr=0; heapnr<heapcount; heapnr++) {
1520 map_heap(mem.heaps[heapnr],page, {
1521 page->page_end = page->page_start + (old_page->_page_end - old_page->_page_start);
1522 offset_heaps_o[heapnr] = (oint)(sintM)(page->page_start - old_page->_page_start) << (oint_addr_shift-addr_shift);
1523 old_page++;
1524 });
1525 }
1526 }
1527 #endif /* SPVW_MIXED_BLOCKS_STAGGERED */
1528 #if defined(SPVW_PURE_BLOCKS) && defined(GENERATIONAL_GC)
1529 {
1530 var uintL numphyspages[heapcount];
1531 var uintL heapnr;
1532 READ(&numphyspages,sizeof(numphyspages));
1533 for (heapnr=0; heapnr<heapcount; heapnr++) {
1534 var uintL count = numphyspages[heapnr];
1535 var Heap* heap = &mem.heaps[heapnr];
1536 if (count > 0) {
1537 var DYNAMIC_ARRAY(_physpages,memdump_physpage_state_t,count);
1538 var physpage_state_t* physpages;
1539 READ(_physpages,count*sizeof(memdump_physpage_state_t));
1540 physpages = MALLOC(count,physpage_state_t);
1541 if (physpages != NULL) {
1542 var uintL i;
1543 for (i=0; i<count; i++) {
1544 physpages[i].continued_addr = _physpages[i].continued_addr;
1545 physpages[i].continued_count = _physpages[i].continued_count;
1546 physpages[i].firstobject = _physpages[i].firstobject;
1547 physpages[i].protection = PROT_READ;
1548 physpages[i].cache_size = 0; physpages[i].cache = NULL;
1549 #if !defined(OLD_GC) && defined(MULTITHREAD)
1550 spinlock_init(&physpages[i].cache_lock);
1551 #endif
1552 }
1553 }
1554 FREE_DYNAMIC_ARRAY(_physpages);
1555 heap->physpages = physpages;
1556 } else {
1557 heap->physpages = NULL;
1558 }
1559 }
1560 }
1561 #endif /* SPVW_PURE_BLOCKS) && GENERATIONAL_GC */
1562 #ifdef SPVW_PAGES
1563 {
1564 var uintC total_pagecount;
1565 var uintC pagecounts[heapcount];
1566 /* initialize the pages-per-heap-table: */
1567 READ(&pagecounts,sizeof(pagecounts));
1568 { /* calculate total_pagecount: */
1569 var uintL heapnr;
1570 total_pagecount = 0;
1571 for (heapnr=0; heapnr<heapcount; heapnr++)
1572 total_pagecount += pagecounts[heapnr];
1573 }
1574 /* initialize offset-per-page-table: */
1575 begin_system_call();
1576 offset_pages = MALLOC(offset_pages_len,offset_pages_t);
1577 end_system_call();
1578 if (offset_pages==NULL)
1579 ABORT_MEM;
1580 {
1581 var uintL pagenr;
1582 for (pagenr=0; pagenr<offset_pages_len; pagenr++) {
1583 offset_pages[pagenr].old_page_start = ~0L;
1584 offset_pages[pagenr].offset_page_o = 0;
1585 }
1586 }
1587 /* read addresses and sizes of the pages and allocate pages: */
1588 var DYNAMIC_ARRAY(old_pages,memdump_page_t,total_pagecount);
1589 READ(old_pages,total_pagecount*sizeof(memdump_page_t));
1590 var DYNAMIC_ARRAY(new_pages,aint,total_pagecount);
1591 {
1592 var memdump_page_t* old_page_ptr = &old_pages[0];
1593 var aint* new_page_ptr = &new_pages[0];
1594 var uintL heapnr;
1595 for (heapnr=0; heapnr<heapcount; heapnr++) {
1596 var Pages* pages_ptr = &mem.heaps[heapnr].inuse;
1597 var uintC pagecount = pagecounts[heapnr];
1598 while (pagecount!=0) {
1599 var uintM need = old_page_ptr->_page_end - old_page_ptr->_page_start;
1600 var uintM misaligned = mem.heaps[heapnr].misaligned;
1601 var uintM size1 = round_up(misaligned+need,sizeof(cons_));
1602 if (size1 < std_page_size) { size1 = std_page_size; }
1603 {
1604 var uintM size2 = size1 + sizeof_NODE + (varobject_alignment-1);
1605 var aint addr = (aint)mymalloc(size2);
1606 var Pages page;
1607 if ((void*)addr == NULL)
1608 ABORT_MEM;
1609 #if !defined(AVL_SEPARATE)
1610 page = (Pages)addr;
1611 #else
1612 begin_system_call();
1613 page = (NODE*)malloc(sizeof(NODE));
1614 end_system_call();
1615 if (page == NULL)
1616 ABORT_MEM;
1617 #endif
1618 /* get page from operating system. */
1619 page->m_start = addr; page->m_length = size2;
1620 /* initialize: */
1621 page->page_start = page_start0(page) + misaligned;
1622 page->page_end = page->page_start + need;
1623 page->page_room = size1 - need;
1624 /* add to this heap: */
1625 *pages_ptr = AVL(AVLID,insert1)(page,*pages_ptr);
1626 *new_page_ptr = page->page_start;
1627 var aint old_page_start = old_page_ptr->_page_start;
1628 var aint old_page_end = old_page_ptr->_page_end;
1629 var oint offset_page_o = ((oint)page->page_start - (oint)old_page_start) << (oint_addr_shift-addr_shift);
1630 var uintL pagenr = pagenr_of(old_page_start & addr_mask);
1631 do {
1632 if (offset_pages[pagenr].old_page_start != ~0L) { abort(); }
1633 offset_pages[pagenr].old_page_start = old_page_start;
1634 offset_pages[pagenr].offset_page_o = offset_page_o;
1635 pagenr++;
1636 } while (pagenr < pagenr_of(old_page_end & addr_mask));
1637 }
1638 old_page_ptr++; new_page_ptr++;
1639 pagecount--;
1640 }
1641 }
1642 }
1643 { /* read content of the pages pages: */
1644 var memdump_page_t* old_page_ptr = &old_pages[0];
1645 var aint* new_page_ptr = &new_pages[0];
1646 while (total_pagecount != 0) {
1647 var uintM len = old_page_ptr->_page_end - old_page_ptr->_page_start;
1648 READ(*new_page_ptr,len);
1649 old_page_ptr++; new_page_ptr++;
1650 total_pagecount--;
1651 }
1652 }
1653 FREE_DYNAMIC_ARRAY(new_pages);
1654 FREE_DYNAMIC_ARRAY(old_pages);
1655 }
1656 #endif /* SPVW_PAGES */
1657 #if defined(SPVW_PURE_BLOCKS) || defined(SPVW_MIXED_BLOCKS_STAGGERED) /* SINGLEMAP_MEMORY || TRIVIALMAP_MEMORY && !SPVW_MIXED_BLOCKS_OPPOSITE */
1658 /* put alignment into practice: */
1659 READ_page_alignment(file_offset);
1660 { /* read content of the blocks: */
1661 var uintL heapnr;
1662 for (heapnr=0; heapnr<heapcount; heapnr++) {
1663 var Heap* heapptr = &mem.heaps[heapnr];
1664 var uintM len = heapptr->heap_end - heapptr->heap_start;
1665 var uintM misaligned =
1666 (is_varobject_heap(heapnr) ? varobjects_misaligned : 0);
1667 var uintM map_len = round_up(misaligned+len,map_pagesize);
1668 heapptr->heap_limit = (heapptr->heap_start-misaligned) + map_len;
1669 if (map_len > 0) {
1670 if (heapptr->heap_limit-1 > heapptr->heap_hardlimit-1)
1671 ABORT_MEM;
1672 #if defined(HAVE_MMAP)
1673 /* if possible, we put the initialization file into memory.
1674 This should accelerate the start and delay unnecessary
1675 loading until the first GC.
1676 the page_alignment is necessary for this purpose! */
1677 if (use_mmap) {
1678 if (filemap((void*)(heapptr->heap_start-misaligned),map_len,
1679 handle,file_offset)
1680 != (void*)(-1))
1681 {
1682 #if 0
1683 /* unnecessary, because mmap() needs no lseek()
1684 and only CLOSE(handle) follows afterwards. */
1685 if ( lseek(handle,map_len,SEEK_CUR) <0) ABORT_SYS;
1686 #endif
1687 inc_file_offset(map_len);
1688 goto block_done;
1689 } else {
1690 var int errcode = errno;
1691 fprintf(stderr,GETTEXTL("%s: Cannot map the initialization file `%s' into memory."),program_name,filename);
1692 errno_out(errcode);
1693 use_mmap = false;
1694 /* before continuing with READ(handle),
1695 an lseek() is poss. necessary. */
1696 if ( lseek(handle,file_offset,SEEK_SET) <0) ABORT_SYS;
1697 }
1698 }
1699 #endif /* HAVE_MMAP */
1700 if (zeromap((void*)(heapptr->heap_start-misaligned),map_len) <0)
1701 ABORT_MEM;
1702 #if varobjects_misaligned
1703 if (is_varobject_heap(heapnr)) {
1704 var uintB dummy[varobjects_misaligned];
1705 READ(&dummy[0],varobjects_misaligned);
1706 }
1707 #endif
1708 READ(heapptr->heap_start,len);
1709 READ_page_alignment(misaligned+len);
1710 block_done: ;
1711 }
1712 }
1713 }
1714 #if defined(HAVE_MMAP)
1715 if (use_mmap) { /* check the length of the mmap-ed files: */
1716 #ifdef UNIX
1717 var struct stat statbuf;
1718 if (fstat(handle,&statbuf) < 0) ABORT_SYS;
1719 /* executable size is appended to the image as size_t */
1720 if (statbuf.st_size < file_offset + sizeof(size_t)) ABORT_INCOMPAT2;
1721 #endif
1722 #ifdef WIN32_NATIVE
1723 var DWORD fsize_hi;
1724 var DWORD fsize_lo = GetFileSize(handle,&fsize_hi);
1725 if (fsize_lo == (DWORD)(-1) && GetLastError() != NO_ERROR) ABORT_SYS;
1726 var off_t fsize = ((uint64)fsize_hi << 32) | fsize_lo;
1727 /* executable size is appended to the image as size_t */
1728 if (fsize < file_offset + sizeof(size_t)) ABORT_INCOMPAT2;
1729 #endif
1730 }
1731 #endif /* HAVE_MMAP */
1732 #endif /* SPVW_PURE_BLOCKS || SPVW_MIXED_BLOCKS_STAGGERED */
1733 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
1734 { /* read objects of variable length: */
1735 var uintM len = header._mem_varobjects_end - header._mem_varobjects_start;
1736 #ifdef TRIVIALMAP_MEMORY
1737 var uintM map_len = round_up(len+varobjects_misaligned,map_pagesize);
1738 mem.varobjects.heap_limit = (mem.varobjects.heap_start-varobjects_misaligned) + map_len;
1739 if (zeromap((void*)(mem.varobjects.heap_start-varobjects_misaligned),map_len) <0)
1740 ABORT_MEM;
1741 #endif
1742 READ(mem.varobjects.heap_start,len);
1743 }
1744 { /* read conses: */
1745 var uintM len = header._mem_conses_end - header._mem_conses_start;
1746 #ifdef TRIVIALMAP_MEMORY
1747 var uintM map_len = round_up(len,map_pagesize);
1748 mem.conses.heap_limit = mem.conses.heap_end - map_len;
1749 if (zeromap((void*)mem.conses.heap_limit,map_len) <0)
1750 ABORT_MEM;
1751 #endif
1752 READ(mem.conses.heap_start,len);
1753 }
1754 #endif /* SPVW_MIXED_BLOCKS_OPPOSITE */
1755 #ifdef GENERATIONAL_GC
1756 { /* make the SIGSEGV-handler functional. */
1757 var uintL heapnr;
1758 for (heapnr=0; heapnr<heapcount; heapnr++) {
1759 var Heap* heapptr = &mem.heaps[heapnr];
1760 heapptr->heap_gen0_start = heapptr->heap_start;
1761 heapptr->heap_gen0_end = heapptr->heap_end;
1762 #ifndef SPVW_PURE_BLOCKS
1763 heapptr->physpages = NULL;
1764 #endif
1765 }
1766 }
1767 #endif
1768 /* traverse all LISP-objects and update: */
1769 #define update loadmem_update
1770 /* update program constants:
1771 we should not update aktenv - it is not initialized.
1772 in MT the current thread's _object_tab and _aktenv - they are
1773 already initialized */
1774 /* update_tables(); */
1775 update_subr_tab();
1776 update_symbol_tab();
1777 for_all_constobjs( update(objptr); ); /* update object_tab */
1778 #if !defined(OLD_GC) && defined(MULTITHREAD)
1779 /* and now the per thread symbol bindings of the thread */
1780 var gcv_object_t* objptr = allthreads.head->_ptr_symvalues;
1781 var uintC count;
1782 dotimespC(count,num_symvalues,{ update(objptr); objptr++; });
1783 #endif
1784 #ifdef SINGLEMAP_MEMORY_RELOCATE
1785 if (!offset_heaps_all_zero)
1786 #endif
1787 #if !defined(SPVW_PURE_BLOCKS) || defined(SINGLEMAP_MEMORY_RELOCATE)
1788 { /* update pointers in the cons-cells: */
1789 #define update_conspage update_conspage_normal
1790 update_conses();
1791 #undef update_conspage
1792 /* update pointers in the objects of variable length: */
1793 #define update_page update_page_normal
1794 #define update_hashtable_invalid true
1795 #define update_unrealloc false
1796 #define update_ss_unrealloc(ptr)
1797 #define update_in_unrealloc(ptr)
1798 #ifdef FOREIGN
1799 #define update_fpointer_invalid true
1800 #else
1801 #define update_fpointer_invalid false
1802 #endif
1803 #define update_fsubr_function true
1804 #define update_ht_invalid set_ht_invalid_if_needed
1805 #define update_fp_invalid mark_fp_invalid
1806 #define update_fs_function loadmem_update_fsubr
1807 update_varobjects();
1808 #undef update_fs_function
1809 #undef update_fp_invalid
1810 #undef update_ht_invalid
1811 #undef update_fsubr_function
1812 #undef update_fpointer_invalid
1813 #undef update_in_unrealloc
1814 #undef update_ss_unrealloc
1815 #undef update_unrealloc
1816 #undef update_hashtable_invalid
1817 #undef update_page
1818 }
1819 #endif /* SPVW_PURE_BLOCKS || SINGLEMAP_MEMORY_RELOCATE */
1820 #ifdef SINGLEMAP_MEMORY_RELOCATE
1821 else /* i.e. if (offset_heaps_all_zero) */
1822 #endif
1823 #ifdef SPVW_PURE_BLOCKS
1824 { /* update the pointers in the cons-cells and objects of variable
1825 length. There are only few of those pointers, and
1826 they were listed when the memimage was stored. */
1827 #if defined(HAVE_MMAP)
1828 if (use_mmap) {
1829 if ( lseek(handle,file_offset,SEEK_SET) <0) ABORT_SYS;
1830 }
1831 #endif
1832 var memdump_reloc_header_t rheader;
1833 READ(&rheader,sizeof(rheader));
1834 if (rheader.reloccount > 0) {
1835 var DYNAMIC_ARRAY(relocbuf,gcv_object_t*,rheader.reloccount);
1836 var gcv_object_t** relocbufptr = &relocbuf[0];
1837 var uintL count;
1838 READ(&relocbuf[0],rheader.reloccount*sizeof(gcv_object_t*));
1839 dotimespL(count,rheader.reloccount, { update(*relocbufptr++); });
1840 FREE_DYNAMIC_ARRAY(relocbuf);
1841 }
1842 if (rheader.htcount > 0) {
1843 var DYNAMIC_ARRAY(htbuf,Hashtable,rheader.htcount);
1844 var Hashtable* htbufptr = &htbuf[0];
1845 var uintL count;
1846 READ(&htbuf[0],rheader.htcount*sizeof(Hashtable));
1847 dotimespL(count,rheader.htcount, {
1848 var Hashtable ptr = *htbufptr++; set_ht_invalid_if_needed(ptr);
1849 });
1850 FREE_DYNAMIC_ARRAY(htbuf);
1851 }
1852 if (rheader.fpcount > 0) {
1853 var DYNAMIC_ARRAY(fpbuf,Record,rheader.fpcount);
1854 var Record* fpbufptr = &fpbuf[0];
1855 var uintL count;
1856 READ(&fpbuf[0],rheader.fpcount*sizeof(Record));
1857 dotimespL(count,rheader.fpcount, {
1858 var Record ptr = *fpbufptr++; mark_fp_invalid(ptr);
1859 });
1860 FREE_DYNAMIC_ARRAY(fpbuf);
1861 }
1862 if (rheader.fscount > 0) {
1863 var DYNAMIC_ARRAY(fsbuf,Fsubr,rheader.fscount);
1864 var Fsubr* fsbufptr = &fsbuf[0];
1865 var uintL count;
1866 READ(&fsbuf[0],rheader.fscount*sizeof(Fsubr));
1867 dotimespL(count,rheader.fscount, {
1868 var Fsubr fsubrptr = *fsbufptr++; loadmem_update_fsubr(fsubrptr);
1869 });
1870 FREE_DYNAMIC_ARRAY(fsbuf);
1871 }
1872 }
1873 #endif /* SPVW_PURE_BLOCKS */
1874 #undef update
1875 /* close file: */
1876 #undef READ
1877 begin_system_call();
1878 #ifdef UNIX
1879 if ( CLOSE(handle) <0) ABORT_SYS;
1880 #elif defined(WIN32_NATIVE)
1881 if (!CloseHandle(handle)) { handle = INVALID_HANDLE_VALUE; ABORT_SYS; }
1882 #endif
1883 end_system_call();
1884 #ifdef SPVW_PAGES
1885 begin_system_call(); free(offset_pages); end_system_call();
1886 recalc_space(false);
1887 #endif
1888 #if defined(SPVW_PURE_BLOCKS) || defined(TRIVIALMAP_MEMORY) || defined(GENERATIONAL_GC) /* SINGLEMAP_MEMORY || TRIVIALMAP_MEMORY || GENERATIONAL_GC */
1889 #ifdef GENERATIONAL_GC
1890 {
1891 var uintL heapnr;
1892 for (heapnr=0; heapnr<heapcount; heapnr++) {
1893 var Heap* heap = &mem.heaps[heapnr];
1894 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
1895 if (is_cons_heap(heapnr)) {
1896 heap->heap_start = heap->heap_gen1_end
1897 = heap->heap_start & -physpagesize;
1898 } else {
1899 heap->heap_gen1_start = heap->heap_end
1900 = ((heap->heap_end + (physpagesize-1)) & -physpagesize) + varobjects_misaligned;
1901 heap->heap_limit = heap->heap_end;
1902 }
1903 #else /* defined(SPVW_PURE_BLOCKS) || defined(SPVW_MIXED_BLOCKS_STAGGERED) */
1904 heap->heap_gen1_start = heap->heap_end
1905 = ((heap->heap_end + (physpagesize-1)) & -physpagesize)
1906 + (is_varobject_heap(heapnr) ? varobjects_misaligned : 0);
1907 heap->heap_limit = heap->heap_end;
1908 #endif /* SPVW_MIXED_BLOCKS_OPPOSITE */
1909 #ifdef SPVW_PURE_BLOCKS
1910 /* Don't need to rebuild the cache. */
1911 xmprotect_old_generation_cache(heapnr);
1912 #else
1913 if (!is_unused_heap(heapnr)) {
1914 #if !defined(OLD_GC)
1915 build_old_generation_cache(heapnr,NULL);
1916 #else
1917 build_old_generation_cache(heapnr);
1918 #endif
1919 }
1920 #endif
1921 }
1922 }
1923 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
1924 if (mem.varobjects.heap_end > mem.conses.heap_start)
1925 ABORT_MEM;
1926 #endif
1927 /* now wee need the SIGSEGV-handler. */
1928 install_segv_handler();
1929 #endif /* GENERATIONAL_GC */
1930 {
1931 var uintM space = used_space();
1932 set_total_room(space); /* we have plenty of time until the next GC */
1933 #ifdef GENERATIONAL_GC
1934 mem.last_gcend_space0 = space;
1935 mem.last_gcend_space1 = 0;
1936 #endif
1937 }
1938 #endif /* SPVW_PURE_BLOCKS || TRIVIALMAP_MEMORY || GENERATIONAL_GC */
1939 FREE_DYNAMIC_ARRAY(old_modules);
1940 begin_system_call(); free(offset_subrs); end_system_call();
1941 }
1942 /* declare open files as closed: */
1943 closed_all_files();
1944 #ifdef GENERATIONAL_GC
1945 O(gc_count) = Fixnum_0; /* so far no GCs: */
1946 #endif
1947 { /* Initialize markwatchset: */
1948 var uintM need = 0;
1949 var object L;
1950 for (L = O(all_weakpointers);
1951 !eq(L,Fixnum_0);
1952 L = ((Weakpointer)TheRecord(L))->wp_cdr)
1953 need += 1 + max_watchset_count(L);
1954 if (need > 0) {
1955 markwatchset_allocated = markwatchset_size = need;
1956 begin_system_call();
1957 markwatchset = (markwatch_t*)malloc(markwatchset_allocated*sizeof(markwatch_t));
1958 end_system_call();
1959 if (markwatchset==NULL)
1960 ABORT_MEM;
1961 }
1962 }
1963 { /* Delete cache of standard file streams. */
1964 O(standard_input_file_stream) = NIL;
1965 O(standard_output_file_stream) = NIL;
1966 O(standard_error_file_stream) = NIL;
1967 /* declare (MACHINE-TYPE), (MACHINE-VERSION), (MACHINE-INSTANCE)
1968 as unknown again: */
1969 O(machine_type_string) = NIL;
1970 O(machine_version_string) = NIL;
1971 O(machine_instance_string) = NIL;
1972 #ifdef GNU_GETTEXT
1973 /* delete cache of (LISP-IMPLEMENTATION-VERSION)
1974 (depends on (SYS::CURRENT-LANGUAGE) ): */
1975 O(lisp_implementation_version_string) = NIL;
1976 #endif
1977 }
1978 #if !defined(OLD_GC) && defined(MULTITHREAD)
1979 {
1980 /* mutex and exemption objects are loaded from the mem file but do not
1981 represent valid OS objects. We should recreate the OS objects here.
1982 This is especially true for mutexes that are part of packages. */
1983 var object list = O(all_mutexes);
1984 while (!endp(list)) {
1985 /* hope none of following to fail */
1986 TheMutex(Car(list))->xmu_system = (xmutex_t *)malloc(sizeof(xmutex_t));
1987 xmutex_init(TheMutex(Car(list))->xmu_system);
1988 list = Cdr(list);
1989 }
1990 list = O(all_exemptions);
1991 while (!endp(list)) {
1992 TheExemption(Car(list))->xco_system =
1993 (xcondition_t *)malloc(sizeof(xcondition_t));
1994 xcondition_init(TheExemption(Car(list))->xco_system);
1995 list = Cdr(list);
1996 }
1997 }
1998 #endif
1999 CHECK_AVL_CONSISTENCY();
2000 CHECK_GC_CONSISTENCY();
2001 CHECK_GC_UNMARKED(); CHECK_NULLOBJ(); CHECK_GC_CACHE(); CHECK_GC_GENERATIONAL(); SAVE_GC_DATA();
2002 CHECK_PACK_CONSISTENCY();
2003 { /* Retrieve misc. data from header. (Can trigger GC!) */
2004 #if 0
2005 char memdumptime[4+1+2+1+2 +1+ 2+1+2+1+2+1]; // YYYY-MM-DD HH:MM:SS
2006 sprintf(memdumptime,"%04u-%02u-%02u %02u:%02u:%02u",
2007 (uintL)posfixnum_to_V(header._dumptime.year),
2008 (uintL)posfixnum_to_V(header._dumptime.month),
2009 (uintL)posfixnum_to_V(header._dumptime.day),
2010 (uintL)posfixnum_to_V(header._dumptime.hours),
2011 (uintL)posfixnum_to_V(header._dumptime.minutes),
2012 (uintL)posfixnum_to_V(header._dumptime.seconds));
2013 #endif
2014 char memdumptime[10+1];
2015 sprintf(memdumptime,"%lu",(unsigned long)header._dumptime);
2016 O(memory_image_timestamp) = ascii_to_string(memdumptime);
2017 O(memory_image_host) = asciz_to_string(header._dumphost,
2018 Symbol_value(S(utf_8)));
2019 }
2020 return true;
2021 close_and_return_true:
2022 begin_system_call(); CLOSE_HANDLE(handle); end_system_call();
2023 return true;
2024 #undef ABORT_MEM
2025 #undef ABORT_INCOMPAT2
2026 #undef ABORT_SYS
2027 abort_sys: {
2028 var int abort_errno = OS_errno;
2029 fprintf(stderr,GETTEXTL("%s: operating system error during load of initialization file `%s'"),program_name,filename);
2030 errno_out(abort_errno);
2031 }
2032 goto abort_fail;
2033 abort_incompat1: /* found an incompatibility that is detectable by get_mem_file_interface_hash */
2034 if (op == op_test_compatibility) {
2035 *(bool*)arg = false;
2036 goto abort_fail;
2037 }
2038 {
2039 var uintB mfihash[MFIH_LEN];
2040 get_mem_file_interface_hash(&mfihash[0]);
2041 if (memcmp(&header._mfihash[0],&mfihash[0],MFIH_LEN) == 0) {
2042 /* Either a bug in get_mem_file_interface_hash or an SHA-1 collision (unlikely). */
2043 fprintf(stderr,GETTEXTL("%s: initialization file '%s' was not created by this version of CLISP runtime, although it carries the same hash code. Bug in function '%s'!!"),program_name,filename,"get_mem_file_interface_hash");
2044 fprint(stderr,"\n");
2045 goto abort_fail;
2046 }
2047 goto abort_incompat2;
2048 }
2049 abort_incompat2: /* found an incompatibility that is not detectable by get_mem_file_interface_hash */
2050 if (op == op_test_compatibility) {
2051 *(bool*)arg = false;
2052 goto abort_fail;
2053 }
2054 fprintf(stderr,GETTEXTL("%s: initialization file `%s' was not created by this version of CLISP runtime"),program_name,filename);
2055 fprint(stderr,"\n");
2056 goto abort_fail;
2057 abort_mem:
2058 fprintf(stderr,GETTEXTL("%s: not enough memory for initialization"),program_name);
2059 fprint(stderr,"\n");
2060 goto abort_fail;
2061 abort_fail:
2062 /* close the file beforehand. */
2063 begin_system_call(); CLOSE_HANDLE(handle); end_system_call();
2064 return false;
2065 }
2066
2067 /* Perform an operation on a mem file, given as a file name.
2068 < true if successful, false upon fatal error */
memfile_do_operation(const char * filename,memfile_operation op,void * arg)2069 local bool memfile_do_operation (const char* filename, memfile_operation op, void* arg)
2070 {
2071 #if defined(UNIX)
2072 #define INVALID_HANDLE_P(handle) (handle<0)
2073 #elif defined(WIN32_NATIVE)
2074 #define INVALID_HANDLE_P(handle) (handle == INVALID_HANDLE)
2075 #else
2076 #error missing INVALID_HANDLE_P()
2077 #endif
2078 var Handle handle;
2079 begin_system_call();
2080 handle = open_filename(filename);
2081 if (INVALID_HANDLE_P(handle)) { /* try filename.mem */
2082 var DYNAMIC_ARRAY(filename_mem,char,strlen(filename)+4);
2083 strcpy(filename_mem,filename);
2084 strcat(filename_mem,".mem");
2085 handle = open_filename(filename_mem);
2086 FREE_DYNAMIC_ARRAY(filename_mem);
2087 if (INVALID_HANDLE_P(handle)) goto abort1;
2088 }
2089 end_system_call();
2090 #undef INVALID_HANDLE_P
2091 return memfile_handle_do_operation(handle,filename,op,arg);
2092 abort1: {
2093 var int abort_errno = OS_errno;
2094 fprintf(stderr,GETTEXTL("%s: operating system error during load of initialization file `%s'"),program_name,filename);
2095 errno_out(abort_errno);
2096 }
2097 goto abort_fail;
2098 abort_fail:
2099 /* first close file, if it had been opened successfully.
2100 (Thus, now really all errors are ignored!) */
2101 if (handle != INVALID_HANDLE) {
2102 begin_system_call(); CLOSE_HANDLE(handle); end_system_call();
2103 }
2104 return false;
2105 }
2106
2107 /* UP, loads memory image from disk
2108 loadmem(filename);
2109 destroys all LISP-data. */
loadmem(const char * filename)2110 local void loadmem (const char* filename)
2111 {
2112 if (!memfile_do_operation(filename,op_load,NULL)) {
2113 quit_instantly(1);
2114 }
2115 }
2116
extract_mem_file_interface_hash(uintB buf[MFIH_LEN],const char * filename)2117 local void extract_mem_file_interface_hash (uintB buf[MFIH_LEN],
2118 const char* filename)
2119 {
2120 if (!memfile_do_operation(filename,op_extract_mfih,buf)) {
2121 quit_instantly(1);
2122 }
2123 }
2124
is_mem_file_compatible(const char * filename)2125 local bool is_mem_file_compatible (const char* filename)
2126 {
2127 bool compat;
2128 if (!memfile_do_operation(filename,op_test_compatibility,&compat)) {
2129 quit_instantly(1);
2130 }
2131 return compat;
2132 }
2133
loadmem_from_executable(void)2134 local int loadmem_from_executable (void) {
2135 var char* executable_name = get_executable_name();
2136 var Handle handle = open_filename(executable_name);
2137 var int success = 1;
2138 if (handle != INVALID_HANDLE) { /* just in case ... */
2139 find_memdump(handle);
2140 if (mem_start != (size_t)-1) { /* found! */
2141 lseek(handle,mem_start,SEEK_SET);
2142 if (!memfile_handle_do_operation(handle,executable_name,op_load,NULL)) {
2143 quit_instantly(1);
2144 }
2145 success = 0;
2146 }
2147 CLOSE_HANDLE(handle);
2148 }
2149 return success;
2150 }
2151