2 * A saved SBCL system is a .core file; the code here helps us accept
3 * such a file as input.
7 * This software is part of the SBCL system. See the README file for
10 * This software is derived from the CMU CL system, which was
11 * written at Carnegie Mellon University and released into the
12 * public domain. The software is in the public domain and is
13 * provided with absolutely no warranty. See the COPYING and CREDITS
14 * files for more information.
19 #ifndef LISP_FEATURE_WIN32
20 #ifdef LISP_FEATURE_LINUX
34 #include <sys/types.h>
48 #include "gc-internal.h"
49 #include "runtime-options.h"
53 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
57 unsigned char build_id
[] =
58 #include "../../output/build-id.tmp"
62 open_binary(char *filename
, int mode
)
64 #ifdef LISP_FEATURE_WIN32
68 return open(filename
, mode
);
72 static struct runtime_options
*
73 read_runtime_options(int fd
)
75 os_vm_size_t optarray
[RUNTIME_OPTIONS_WORDS
];
76 struct runtime_options
*options
= NULL
;
78 if (read(fd
, optarray
, RUNTIME_OPTIONS_WORDS
* sizeof(os_vm_size_t
)) !=
79 RUNTIME_OPTIONS_WORDS
* sizeof(size_t)) {
83 if ((RUNTIME_OPTIONS_MAGIC
!= optarray
[0]) || (0 == optarray
[1])) {
87 options
= successful_malloc(sizeof(struct runtime_options
));
89 options
->dynamic_space_size
= optarray
[2];
90 options
->thread_control_stack_size
= optarray
[3];
96 maybe_initialize_runtime_options(int fd
)
98 struct runtime_options
*new_runtime_options
;
99 off_t end_offset
= sizeof(lispobj
) +
100 sizeof(os_vm_offset_t
) +
101 (RUNTIME_OPTIONS_WORDS
* sizeof(size_t));
103 lseek(fd
, -end_offset
, SEEK_END
);
105 if ((new_runtime_options
= read_runtime_options(fd
))) {
106 runtime_options
= new_runtime_options
;
110 /* Search 'filename' for an embedded core. An SBCL core has, at the
111 * end of the file, a trailer containing optional saved runtime
112 * options, the start of the core (an os_vm_offset_t), and a final
113 * signature word (the lispobj CORE_MAGIC). If this trailer is found
114 * at the end of the file, the start of the core can be determined
115 * from the core size.
117 * If an embedded core is present, this returns the offset into the
118 * file to load the core from, or -1 if no core is present. */
120 search_for_embedded_core(char *filename
)
123 os_vm_offset_t lispobj_size
= sizeof(lispobj
);
124 os_vm_offset_t trailer_size
= lispobj_size
+ sizeof(os_vm_offset_t
);
125 os_vm_offset_t core_start
, pos
;
128 if ((fd
= open_binary(filename
, O_RDONLY
)) < 0)
131 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
133 if (header
== CORE_MAGIC
) {
134 /* This file is a real core, not an embedded core. Return 0 to
135 * indicate where the core starts, and do not look for runtime
136 * options in this case. */
140 if (lseek(fd
, -lispobj_size
, SEEK_END
) < 0)
142 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
145 if (header
== CORE_MAGIC
) {
146 if (lseek(fd
, -trailer_size
, SEEK_END
) < 0)
148 if (read(fd
, &core_start
, sizeof(os_vm_offset_t
)) < 0)
151 if (lseek(fd
, core_start
, SEEK_SET
) < 0)
153 pos
= lseek(fd
, 0, SEEK_CUR
);
155 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
158 if (header
!= CORE_MAGIC
)
161 maybe_initialize_runtime_options(fd
);
174 #ifndef LISP_FEATURE_HPUX
175 #define load_core_bytes(fd, where, addr, len) os_map(fd, where, addr, len)
177 #define load_core_bytes(fd, where, addr, len) copy_core_bytes(fd, where, addr, len)
178 /* If more platforms don't support overlapping mmap rename this
179 * def to something like ifdef nommapoverlap */
180 /* currently hpux only */
181 static void copy_core_bytes(int fd
, os_vm_offset_t offset
,
182 os_vm_address_t addr
, int len
)
184 unsigned char buf
[4096];
186 int old_fd
= lseek(fd
, 0, SEEK_CUR
);
189 fprintf(stderr
, "cant copy a slice of core because slice-length is not of page size(4096)\n");
193 fprintf(stderr
, "cant perform lseek() on corefile\n");
195 lseek(fd
, offset
, SEEK_SET
);
197 fprintf(stderr
, "cant perform lseek(%u,%lu,SEEK_SET) on corefile\n", fd
, offset
);
199 for(x
= 0; x
< len
; x
+= 4096){
200 c
= read(fd
, buf
, 4096);
202 fprintf(stderr
, "cant read memory area from corefile at position %lu, got %d\n", offset
+ x
, c
);
205 memcpy(addr
+x
, buf
, 4096);
207 os_flush_icache(addr
, len
);
211 #ifndef LISP_FEATURE_SB_CORE_COMPRESSION
212 # define inflate_core_bytes(fd,offset,addr,len) \
213 lose("This runtime was not built with zlib-compressed core support... aborting\n")
215 # define ZLIB_BUFFER_SIZE (1u<<16)
216 static void inflate_core_bytes(int fd
, os_vm_offset_t offset
,
217 os_vm_address_t addr
, int len
)
220 unsigned char* buf
= successful_malloc(ZLIB_BUFFER_SIZE
);
223 # ifdef LISP_FEATURE_WIN32
224 /* Ensure the memory is committed so zlib doesn't segfault trying to
226 os_validate_recommit(addr
, len
);
229 if (-1 == lseek(fd
, offset
, SEEK_SET
)) {
230 lose("Unable to lseek() on corefile\n");
233 stream
.zalloc
= NULL
;
235 stream
.opaque
= NULL
;
237 stream
.next_in
= buf
;
239 ret
= inflateInit(&stream
);
241 lose("zlib error %i\n", ret
);
243 stream
.next_out
= (void*)addr
;
244 stream
.avail_out
= len
;
246 ssize_t count
= read(fd
, buf
, ZLIB_BUFFER_SIZE
);
248 lose("unable to read core file (errno = %i)\n", errno
);
249 stream
.next_in
= buf
;
250 stream
.avail_in
= count
;
251 if (count
== 0) break;
252 ret
= inflate(&stream
, Z_NO_FLUSH
);
257 if (stream
.avail_out
== 0)
258 lose("Runaway gzipped core directory... aborting\n");
259 if (stream
.avail_in
> 0)
260 lose("zlib inflate returned without fully"
261 "using up input buffer... aborting\n");
264 lose("zlib inflate error: %i\n", ret
);
267 } while (ret
!= Z_STREAM_END
);
269 if (stream
.avail_out
> 0) {
270 if (stream
.avail_out
>= os_vm_page_size
)
271 fprintf(stderr
, "Warning: gzipped core directory significantly"
272 "shorter than expected (%lu bytes)", (unsigned long)stream
.avail_out
);
273 /* Is this needed? */
274 memset(stream
.next_out
, 0, stream
.avail_out
);
280 # undef ZLIB_BUFFER_SIZE
283 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
284 #define adjust_word(x) x
286 #include "genesis/gc-tables.h"
287 #include "genesis/hash-table.h"
288 #include "genesis/layout.h"
289 #include "genesis/vector.h"
290 static lispobj expected_range_start
, expected_range_end
;
291 static sword_t heap_adjustment
;
293 /* Define this in CFLAGS as 1 to deliberately mess up the mapped address */
294 #ifndef MOCK_MMAP_FAILURE
295 #define MOCK_MMAP_FAILURE 0
298 #if !MOCK_MMAP_FAILURE
299 #define maybe_fuzz_address(x) x
301 /// "Pseudo-randomly" alter requested address for testing purposes so that
302 /// we can test interesting scenarios such as:
303 /// - partially overlapping ranges for the desired and actual space
304 /// - aligned to OS page but misaligned for GC card
305 #define maybe_fuzz_address(x) fuzz_address(x)
309 uword_t
fuzz_address(uword_t addr
)
316 if ((pathname
= getenv("SBCL_FAKE_MMAP_INSTRUCTION_FILE")) == NULL
) {
317 fprintf(stderr
, "WARNING: image built with MOCK_MMAP_FAILURE\n");
318 fprintf(stderr
, " but no mock configuration data found.\n");
321 if ((f
= fopen(pathname
, "r+")) == NULL
) {
322 // If the file can't be found, don't silently ignore it,
323 // because if the relocator "worked" you don't want to get all happy
324 // that it worked only to find that it didn't actually perform relocation.
325 fprintf(stderr
, "Could not read 'fakemap' file\n");
328 ignore_value(fgets(line
, sizeof line
, f
));
329 line_number
= atoi(line
);
331 for (i
= 0 ; i
<= line_number
; ++i
) {
333 ok
= fgets(line
, sizeof line
, f
) != NULL
&& line
[0] != '\n';
334 if (i
== line_number
- 1)
335 result
= strtol(line
, 0, 16);
337 // fprintf(stderr, "*** Rewinding fake mmap instructions\n");
343 fprintf(f
, "%02d", 1+line_number
);
345 fprintf(stderr
, "//dynamic space @ %p\n", (void*)result
);
350 static inline boolean
needs_adjusting(lispobj x
)
352 return (expected_range_start
<= x
&& x
< expected_range_end
);
355 // Return the adjusted value of 'word' without testing whether it looks
356 // like a pointer. But do test whether it points to the dynamic space.
357 static inline lispobj
adjust_word(lispobj word
)
359 return (needs_adjusting(word
) ? heap_adjustment
: 0) + word
;
362 // Adjust the words in range [where,where+n_words)
363 // skipping any words that have non-pointer nature.
364 static void adjust_pointers(lispobj
*where
, long n_words
)
367 for (i
=0;i
<n_words
;++i
) {
368 lispobj word
= where
[i
], adjusted
;
369 if (is_lisp_pointer(word
) && (adjusted
= adjust_word(word
)) != word
) {
375 static void fixup_space(lispobj
* where
, uword_t len
)
377 lispobj
*end
= (lispobj
*)((char*)where
+ len
);
381 lispobj layout
, layout_slots_adjustp
, bitmap
;
384 for ( ; where
< end
; where
+= nwords
) {
385 header_word
= *where
;
386 if (is_cons_half(header_word
)) {
387 adjust_pointers(where
, 2);
391 widetag
= widetag_of(header_word
);
392 nwords
= sizetab
[widetag
](where
);
394 case INSTANCE_WIDETAG
:
395 case FUNCALLABLE_INSTANCE_WIDETAG
:
396 // Special note on the word at where[1] in funcallable instances:
397 // - If the instance lives in immobile space and has a self-contained
398 // trampoline, that word does not need adjustment.
399 // - If the instance does not have a self-contained trampoline,
400 // then the word points to read-only space hence needs no adjustment.
401 layout
= (widetag
== FUNCALLABLE_INSTANCE_WIDETAG
) ?
402 fin_layout(where
) : instance_layout(where
);
403 // Possibly adjust, but do not alter the in-memory value of, this layout.
404 // instance_scan_interleaved() on this instance will actually adjust
405 // the layout slot if needed.
406 bitmap
= LAYOUT(adjust_word(layout
))->bitmap
;
408 // If the layout of this instance resides at a higher address
409 // than the instance itself, then the layout's pointer slots were
410 // not fixed up yet. This is true regardless of whether the core
411 // was mapped at a higher or lower address than desired.
412 // i.e. If we haven't yet scanned the layout in this fixup pass, and if
413 // it resides in the expected dynamic space range, then it needs adjusting.
414 layout_slots_adjustp
= layout
> (lispobj
)where
&& needs_adjusting(layout
);
416 // If the layout has not itself been adjusted, then its bitmap,
417 // if not a fixnum, needs (nondestructive) adjustment.
418 if (!fixnump(bitmap
) && layout_slots_adjustp
)
419 bitmap
= adjust_word(bitmap
);
421 instance_scan(adjust_pointers
, where
+1, nwords
-1, bitmap
);
424 adjust_pointers(where
+1, 2);
425 // 'raw_addr' doesn't satisfy is_lisp_pointer() for x86,
426 // so adjust_pointers() would ignore it. Force adjustment if
427 // it points to dynamic space. For x86-64 with IMMOBILE_CODE,
428 // the fdefn can only point to immobile space,
429 // and it does so via a JMP instruction, so we must ignore it,
430 // lest it accidentally be adjusted (if somehow the next 8 bytes
431 // when interpreted as a word seemed to point to dynamic space
432 // though in fact it's an opcode followed by a 4 byte displacement).
433 // For all others, just adjust it here for uniformity.
434 #ifndef LISP_FEATURE_IMMOBILE_CODE
435 where
[3] = adjust_word(where
[3]);
438 case CODE_HEADER_WIDETAG
:
439 // Fixup the constant pool. The word at where+1 is a fixnum.
440 adjust_pointers(where
+2, code_header_words(header_word
)-2);
441 // Fixup all embedded simple-funs
442 code
= (struct code
*)where
;
443 for_each_simple_fun(i
, f
, code
, 1, {
444 f
->self
= adjust_word(f
->self
);
445 adjust_pointers(SIMPLE_FUN_SCAV_START(f
), SIMPLE_FUN_SCAV_NWORDS(f
));
447 // Compute the address where the code "was" as the first argument
448 gencgc_apply_code_fixups((struct code
*)((char*)where
- heap_adjustment
),
450 #ifdef LISP_FEATURE_IMMOBILE_SPACE
451 // Now that the packed integer comprising the list of fixup locations
452 // has been fixed-up (if necessary), apply them to the code.
453 if (code
->fixups
!= 0)
454 fixup_immobile_refs(adjust_word
, code
->fixups
, code
);
457 case CLOSURE_WIDETAG
:
458 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
459 // For x86[-64], the closure fun appears to be a fixnum,
460 // and might need adjustment unless pointing to immobile code.
461 // Then fall into the general case; where[1] won't get re-adjusted
462 // because it doesn't satisfy is_lisp_pointer().
463 where
[1] = adjust_word(where
[1]);
466 // Vectors require extra care because of EQ-based hashing.
467 case SIMPLE_VECTOR_WIDETAG
:
468 if ((HeaderValue(*where
) & 0xFF) == subtype_VectorValidHashing
) {
469 struct vector
* v
= (struct vector
*)where
;
470 gc_assert(v
->length
> 0 &&
471 !(fixnum_value(v
->length
) & 1) && // length must be even
472 lowtag_of(v
->data
[0]) == INSTANCE_POINTER_LOWTAG
);
473 lispobj
* data
= (lispobj
*)v
->data
;
474 adjust_pointers(&data
[0], 1); // adjust the hash-table structure
475 boolean needs_rehash
= 0;
477 // Adjust the elements, checking for need to rehash.
478 // v->data[1] is the unbound marker (a non-pointer)
479 for (i
= fixnum_value(v
->length
)-1 ; i
>=2 ; --i
) {
480 lispobj ptr
= data
[i
];
481 if (is_lisp_pointer(ptr
) && needs_adjusting(ptr
)) {
482 data
[i
] += heap_adjustment
;
487 struct hash_table
*ht
= (struct hash_table
*)native_pointer(v
->data
[0]);
488 ht
->needs_rehash_p
= T
;
492 // All the array header widetags.
493 case SIMPLE_ARRAY_WIDETAG
:
494 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
495 case COMPLEX_CHARACTER_STRING_WIDETAG
:
497 case COMPLEX_BASE_STRING_WIDETAG
:
498 case COMPLEX_VECTOR_NIL_WIDETAG
:
499 case COMPLEX_BIT_VECTOR_WIDETAG
:
500 case COMPLEX_VECTOR_WIDETAG
:
501 case COMPLEX_ARRAY_WIDETAG
:
502 // And the rest of the purely descriptor objects.
504 case VALUE_CELL_WIDETAG
:
505 case WEAK_POINTER_WIDETAG
:
507 case COMPLEX_WIDETAG
:
512 if (needs_adjusting(where
[1])) {
514 "WARNING: SAP at %p -> %p in relocatable core\n",
515 where
, (void*)where
[1]);
516 where
[1] += heap_adjustment
;
520 #ifndef LISP_FEATURE_64_BIT
521 case SINGLE_FLOAT_WIDETAG
:
523 case DOUBLE_FLOAT_WIDETAG
:
524 case COMPLEX_SINGLE_FLOAT_WIDETAG
:
525 case COMPLEX_DOUBLE_FLOAT_WIDETAG
:
526 #ifdef SIMD_PACK_WIDETAG
527 case SIMD_PACK_WIDETAG
:
531 if (other_immediate_lowtag_p(widetag
)
532 && specialized_vector_widetag_p(widetag
))
535 lose("Unrecognized heap object: @%p: %lx\n", where
, header_word
);
537 adjust_pointers(where
+1, nwords
-1);
541 void relocate_heap(lispobj
* want
, lispobj
* got
, uword_t len
)
543 expected_range_start
= (lispobj
)want
;
544 expected_range_end
= (lispobj
)want
+ len
;
545 heap_adjustment
= (lispobj
)got
- (lispobj
)want
;
546 #if MOCK_MMAP_FAILURE
547 fprintf(stderr
, "Relocating heap from [%p:%p] to [%p:%p]\n",
548 want
, (char*)want
+len
, got
, (char*)got
+len
);
551 fixup_space((lispobj
*)STATIC_SPACE_START
, STATIC_SPACE_SIZE
);
552 #ifdef LISP_FEATURE_IMMOBILE_SPACE
553 fixup_space((lispobj
*)IMMOBILE_SPACE_START
, IMMOBILE_SPACE_SIZE
);
555 fixup_space((lispobj
*)got
, len
); // the dynamic space itself
559 int merge_core_pages
= -1;
562 process_directory(int fd
, lispobj
*ptr
, int count
, os_vm_offset_t file_offset
)
564 extern void immobile_space_coreparse(uword_t
,uword_t
);
565 extern void write_protect_immobile_space();
566 struct ndir_entry
*entry
;
569 uword_t len
; // length in pages
571 lispobj
** pfree_pointer
; // pointer to x_free_pointer
572 } spaces
[MAX_CORE_SPACE_ID
+1] = {
573 {0, 0, 0}, // blank for space ID 0
574 #ifdef LISP_FEATURE_GENCGC
575 {0, DYNAMIC_SPACE_START
, 0},
579 // This order is determined by constants in compiler/generic/genesis
580 {0, STATIC_SPACE_START
, &static_space_free_pointer
},
581 {0, READ_ONLY_SPACE_START
, &read_only_space_free_pointer
},
582 #ifdef LISP_FEATURE_IMMOBILE_SPACE
583 {0, IMMOBILE_SPACE_START
, &immobile_fixedobj_free_pointer
},
584 {0, IMMOBILE_VARYOBJ_SUBSPACE_START
, &immobile_space_free_pointer
}
588 for (entry
= (struct ndir_entry
*) ptr
; --count
>= 0; ++entry
) {
589 sword_t id
= entry
->identifier
;
590 uword_t addr
= (os_vm_page_size
* entry
->address
);
591 int compressed
= id
& DEFLATED_CORE_SPACE_ID_FLAG
;
593 if (id
< 1 || id
> MAX_CORE_SPACE_ID
)
594 lose("unknown space ID %ld addr %p\n", id
, addr
);
596 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
597 int enforce_address
= 1;
599 // Only enforce other spaces' addresses
600 int enforce_address
= id
!= DYNAMIC_CORE_SPACE_ID
;
602 if (enforce_address
) {
604 #ifdef LISP_FEATURE_CHENEYGC
605 if (id
== DYNAMIC_CORE_SPACE_ID
) {
606 if ((fail
= (addr
!= DYNAMIC_0_SPACE_START
) &&
607 (addr
!= DYNAMIC_1_SPACE_START
)) != 0)
608 fprintf(stderr
, "in core: %p; in runtime: %p or %p\n",
610 (void*)DYNAMIC_0_SPACE_START
,
611 (void*)DYNAMIC_1_SPACE_START
);
614 if ((fail
= (addr
!= spaces
[id
].base
)) != 0)
615 fprintf(stderr
, "in core: %p; in runtime: %p\n",
616 (void*)addr
, (void*)spaces
[id
].base
);
618 "DYNAMIC", "STATIC", "READ_ONLY", "IMMOBILE", "IMMOBILE"
621 lose("core/runtime address mismatch: %s_SPACE_START", names
[id
-1]);
623 spaces
[id
].base
= (uword_t
)addr
;
624 uword_t len
= os_vm_page_size
* entry
->page_count
;
625 spaces
[id
].len
= len
;
626 if (id
== DYNAMIC_CORE_SPACE_ID
&& len
> dynamic_space_size
) {
627 lose("dynamic space too small for core: %luKiB required, %luKiB available.\n",
628 (unsigned long)len
>> 10,
629 (unsigned long)dynamic_space_size
>> 10);
632 uword_t
__attribute__((unused
)) aligned_start
;
633 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
634 // Try to map at address requested by the core file.
635 if (id
== DYNAMIC_CORE_SPACE_ID
) {
636 addr
= (uword_t
)os_validate(MOVABLE
,
637 (os_vm_address_t
)maybe_fuzz_address(addr
),
639 aligned_start
= CEILING(addr
, GENCGC_CARD_BYTES
);
640 /* Misalignment can happen only if card size exceeds OS page.
641 * Drop one card to avoid overrunning the allocated space */
642 if (aligned_start
> addr
) // not card-aligned
643 dynamic_space_size
-= GENCGC_CARD_BYTES
;
644 DYNAMIC_SPACE_START
= addr
= aligned_start
;
646 #endif /* LISP_FEATURE_RELOCATABLE_HEAP */
648 sword_t offset
= os_vm_page_size
* (1 + entry
->data_page
);
650 inflate_core_bytes(fd
, offset
+ file_offset
, (os_vm_address_t
)addr
, len
);
652 load_core_bytes(fd
, offset
+ file_offset
, (os_vm_address_t
)addr
, len
);
655 #ifdef MADV_MERGEABLE
656 if ((merge_core_pages
== 1)
657 || ((merge_core_pages
== -1) && compressed
)) {
658 madvise((void *)addr
, len
, MADV_MERGEABLE
);
662 lispobj
*free_pointer
= (lispobj
*) addr
+ entry
->nwords
;
665 *spaces
[id
].pfree_pointer
= free_pointer
;
667 case DYNAMIC_CORE_SPACE_ID
:
668 /* 'addr' is the actual address if relocatable.
669 * For cheneygc, this will be whatever the GC was using
670 * at the time the core was saved.
671 * For gencgc we don't look at current_dynamic_space */
672 current_dynamic_space
= (lispobj
*)addr
;
674 /* FIXME: why not use set_alloc_pointer() ? */
675 #if defined(ALLOCATION_POINTER)
676 SetSymbolValue(ALLOCATION_POINTER
, (lispobj
)free_pointer
,0);
678 dynamic_space_free_pointer
= free_pointer
;
680 anon_dynamic_space_start
= (os_vm_address_t
)(addr
+ len
);
681 /* This assertion safeguards the test in zero_pages_with_mmap()
682 * which trusts that if addr > anon_dynamic_space_start
683 * then addr did not come from any file mapping. */
684 gc_assert((lispobj
)anon_dynamic_space_start
> STATIC_SPACE_END
);
688 #ifdef LISP_FEATURE_IMMOBILE_SPACE
689 immobile_space_coreparse(spaces
[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
].len
,
690 spaces
[IMMOBILE_VARYOBJ_CORE_SPACE_ID
].len
);
692 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
693 if (DYNAMIC_SPACE_START
!= spaces
[DYNAMIC_CORE_SPACE_ID
].base
)
694 relocate_heap((lispobj
*)spaces
[DYNAMIC_CORE_SPACE_ID
].base
,
695 (lispobj
*)DYNAMIC_SPACE_START
,
696 spaces
[DYNAMIC_CORE_SPACE_ID
].len
);
698 #ifdef LISP_FEATURE_X86_64
699 tune_asm_routines_for_microarch(); // before WPing immobile space
701 #ifdef LISP_FEATURE_IMMOBILE_SPACE
702 /* Delayed until after dynamic space has been mapped so that writes
703 * to immobile space due to core relocation don't fault. */
704 write_protect_immobile_space();
709 load_core_file(char *file
, os_vm_offset_t file_offset
)
712 #ifndef LISP_FEATURE_ALPHA
717 os_vm_size_t len
, remaining_len
;
718 int fd
= open_binary(file
, O_RDONLY
);
720 lispobj initial_function
= NIL
;
722 FSHOW((stderr
, "/entering load_core_file(%s)\n", file
));
724 fprintf(stderr
, "could not open file \"%s\"\n", file
);
729 lseek(fd
, file_offset
, SEEK_SET
);
730 header
= calloc(os_vm_page_size
, 1);
732 count
= read(fd
, header
, os_vm_page_size
);
733 if (count
< (ssize_t
) os_vm_page_size
) {
734 lose("premature end of core file\n");
736 SHOW("successfully read first page of core");
741 if (val
!= CORE_MAGIC
) {
742 lose("invalid magic number in core: 0x%lx should have been 0x%x.\n",
746 SHOW("found CORE_MAGIC");
748 while (val
!= END_CORE_ENTRY_TYPE_CODE
) {
751 remaining_len
= len
- 2; /* (-2 to cancel the two ++ operations) */
752 FSHOW((stderr
, "/val=0x%"WORD_FMTX
", remaining_len=0x%"WORD_FMTX
"\n",
753 val
, remaining_len
));
757 case END_CORE_ENTRY_TYPE_CODE
:
758 SHOW("END_CORE_ENTRY_TYPE_CODE case");
761 case BUILD_ID_CORE_ENTRY_TYPE_CODE
:
762 SHOW("BUILD_ID_CORE_ENTRY_TYPE_CODE case");
766 FSHOW((stderr
, "build_id[]=\"%s\"\n", build_id
));
767 FSHOW((stderr
, "remaining_len = %d\n", remaining_len
));
768 if (remaining_len
!= strlen((const char *)build_id
))
769 goto losing_build_id
;
770 for (i
= 0; i
< remaining_len
; ++i
) {
771 FSHOW((stderr
, "ptr[%d] = char = %d, expected=%d\n",
772 i
, ptr
[i
], build_id
[i
]));
773 if (ptr
[i
] != build_id
[i
])
774 goto losing_build_id
;
778 /* .core files are not binary-compatible between
779 * builds because we can't easily detect whether the
780 * sources were patched between the time the
781 * dumping-the-.core runtime was built and the time
782 * that the loading-the-.core runtime was built.
784 * (We could easily detect whether version.lisp-expr
785 * was changed, but people experimenting with patches
786 * don't necessarily update version.lisp-expr.) */
788 fprintf(stderr
, "core was built for runtime '");
789 for (i
= 0; i
< remaining_len
; ++i
) putc(ptr
[i
], stderr
);
790 fprintf(stderr
, "' but this is '%s'\n", build_id
);
791 lose("can't load .core for different runtime, sorry\n");
794 case NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE
:
795 SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case");
796 process_directory(fd
,
798 #ifndef LISP_FEATURE_ALPHA
799 remaining_len
/ (sizeof(struct ndir_entry
) /
802 remaining_len
/ (sizeof(struct ndir_entry
) /
808 case INITIAL_FUN_CORE_ENTRY_TYPE_CODE
:
809 SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case");
810 initial_function
= adjust_word((lispobj
)*ptr
);
813 #ifdef LISP_FEATURE_GENCGC
814 case PAGE_TABLE_CORE_ENTRY_TYPE_CODE
:
816 extern void gc_allocate_ptes();
817 // Allocation of PTEs is delayed 'til now so that calloc() doesn't
818 // consume addresses that would have been taken by a mapped space.
820 os_vm_size_t remaining
= *ptr
;
821 os_vm_size_t fdoffset
= (*(ptr
+1) + 1) * (os_vm_page_size
);
822 page_index_t page
= 0, npages
;
825 // A corefile_pte is 10 bytes for x86-64
826 // Process an integral number of ptes on each read.
827 os_vm_size_t chunksize
= sizeof (struct corefile_pte
)
828 * (sizeof data
/ sizeof (struct corefile_pte
));
829 lseek(fd
, fdoffset
+ file_offset
, SEEK_SET
);
830 bytes_read
= read(fd
, &npages
, sizeof npages
);
831 gc_assert(bytes_read
== sizeof npages
);
832 remaining
-= sizeof npages
;
833 while ((bytes_read
= read(fd
, data
,
834 remaining
< chunksize
? remaining
: chunksize
)) > 0) {
837 remaining
-= bytes_read
;
839 bytes_read
-= sizeof(struct corefile_pte
);
840 /* Ignore all zeroes. The size of the page table
841 * core entry was rounded up to os_vm_page_size
842 * during the save, and might now have more
843 * elements than the page table.
845 * The low bits of each word are allocation flags.
847 struct corefile_pte pte
;
848 memcpy(&pte
, data
+i
*sizeof (struct corefile_pte
), sizeof pte
);
849 set_page_bytes_used(page
, pte
.bytes_used
);
850 set_page_scan_start_offset(page
, pte
.sso
& ~0x03);
851 page_table
[page
].allocated
= pte
.sso
& 0x03;
852 if (++page
== npages
) // break out of both loops
859 gencgc_partial_pickup
= 1;
864 lose("unknown core file entry: 0x%"WORD_FMTX
"\n", val
);
867 ptr
+= remaining_len
;
868 FSHOW((stderr
, "/new ptr=0x%"WORD_FMTX
"\n", ptr
));
870 SHOW("about to free(header)");
873 SHOW("returning from load_core_file(..)");
874 return initial_function
;
877 #include "genesis/hash-table.h"
878 #include "genesis/vector.h"
879 os_vm_address_t
get_asm_routine_by_name(const char* name
)
881 lispobj routines
= SYMBOL(ASSEMBLER_ROUTINES
)->value
;
882 if (lowtag_of(routines
) == INSTANCE_POINTER_LOWTAG
) {
883 struct hash_table
* ht
= (struct hash_table
*)native_pointer(routines
);
884 struct vector
* table
= VECTOR(ht
->table
);
887 for (i
=2 ; i
< fixnum_value(table
->length
) ; i
+= 2) {
888 sym
= table
->data
[i
];
889 if (lowtag_of(sym
) == OTHER_POINTER_LOWTAG
890 && widetag_of(SYMBOL(sym
)->header
) == SYMBOL_WIDETAG
891 && !strcmp(name
, (char*)(VECTOR(SYMBOL(sym
)->name
)->data
)))
892 return (os_vm_address_t
)fixnum_value(table
->data
[i
+1]);
894 // Something is wrong if we have a hashtable but find nothing.
895 fprintf(stderr
, "WARNING: get_asm_routine_by_name(%s) failed\n",
901 void asm_routine_poke(const char* routine
, int offset
, char byte
)
903 char *address
= (char *)get_asm_routine_by_name(routine
);
905 address
[offset
] = byte
;