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"
50 #include "pseudo-atomic.h"
54 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
58 unsigned char build_id
[] =
59 // The suffix added to build-id indicates which flavor of C compiler was used.
60 // This enforces that when you put :MSAN in your Lisp features, you don't
61 // omit "-fsanitize=memory -DMEMORY_SANITIZE" from CFLAGS and LINKFLAGS.
62 // (Some Lisp features affect C flags, but not this one.)
63 // It is important for out-of-tree builds: once they work, you can produce
64 // two trees of artifacts from identical sources *including* the build-id.inc
65 // (but not including "local-target-features.lisp-expr"), and end up with two
66 // Lisp cores and two C runtimes. The extra suffix avoids accidental mismatch.
67 #include "../../output/build-id.inc"
68 #ifdef MEMORY_SANITIZER
74 open_binary(char *filename
, int mode
)
76 #ifdef LISP_FEATURE_WIN32
80 return open(filename
, mode
);
84 static struct runtime_options
*
85 read_runtime_options(int fd
)
87 os_vm_size_t optarray
[RUNTIME_OPTIONS_WORDS
];
88 struct runtime_options
*options
= NULL
;
90 if (read(fd
, optarray
, RUNTIME_OPTIONS_WORDS
* sizeof(os_vm_size_t
)) !=
91 RUNTIME_OPTIONS_WORDS
* sizeof(size_t)) {
95 if ((RUNTIME_OPTIONS_MAGIC
!= optarray
[0]) || (0 == optarray
[1])) {
99 options
= successful_malloc(sizeof(struct runtime_options
));
101 options
->dynamic_space_size
= optarray
[2];
102 options
->thread_control_stack_size
= optarray
[3];
108 maybe_initialize_runtime_options(int fd
)
110 struct runtime_options
*new_runtime_options
;
111 off_t end_offset
= sizeof(lispobj
) +
112 sizeof(os_vm_offset_t
) +
113 (RUNTIME_OPTIONS_WORDS
* sizeof(size_t));
115 lseek(fd
, -end_offset
, SEEK_END
);
117 if ((new_runtime_options
= read_runtime_options(fd
))) {
118 runtime_options
= new_runtime_options
;
122 #if defined(LISP_FEATURE_LINUX) && defined(LISP_FEATURE_IMMOBILE_CODE)
124 extern __attribute__((weak
)) lispobj __lisp_code_start
, __lisp_code_end
;
129 /* Search 'filename' for an embedded core. An SBCL core has, at the
130 * end of the file, a trailer containing optional saved runtime
131 * options, the start of the core (an os_vm_offset_t), and a final
132 * signature word (the lispobj CORE_MAGIC). If this trailer is found
133 * at the end of the file, the start of the core can be determined
134 * from the core size.
136 * If an embedded core is present, this returns the offset into the
137 * file to load the core from, or -1 if no core is present. */
139 search_for_embedded_core(char *filename
)
141 extern size_t search_for_elf_core(int, os_vm_offset_t
*);
143 os_vm_offset_t lispobj_size
= sizeof(lispobj
);
144 os_vm_offset_t trailer_size
= lispobj_size
+ sizeof(os_vm_offset_t
);
145 os_vm_offset_t core_start
;
148 if ((fd
= open_binary(filename
, O_RDONLY
)) < 0)
151 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
153 if (header
== CORE_MAGIC
) {
154 /* This file is a real core, not an embedded core. Return 0 to
155 * indicate where the core starts, and do not look for runtime
156 * options in this case. */
160 if (lseek(fd
, -lispobj_size
, SEEK_END
) < 0)
162 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
165 if (header
== CORE_MAGIC
) {
166 if (lseek(fd
, -trailer_size
, SEEK_END
) < 0)
168 if (read(fd
, &core_start
, sizeof(os_vm_offset_t
)) < 0)
171 if (lseek(fd
, core_start
, SEEK_SET
) < 0)
174 if (read(fd
, &header
, (size_t)lispobj_size
) < lispobj_size
)
177 if (header
!= CORE_MAGIC
)
180 maybe_initialize_runtime_options(fd
);
189 size_t core_size
= search_for_elf_core(fd
, &core_start
);
191 int announce
= !lisp_startup_options
.noinform
;
193 fprintf(stderr
, "Lisp core in ELF section: %lx:%lx\n", core_start
, core_start
+ core_size
);
194 // FIXME: saving options at the end of the core is terrible.
195 // They should be in an optional core entry.
196 off_t options_offset
= core_start
+ core_size
197 - (2+RUNTIME_OPTIONS_WORDS
) * sizeof (lispobj
);
198 struct runtime_options
*new_runtime_options
;
199 lseek(fd
, options_offset
, SEEK_SET
);
200 if ((new_runtime_options
= read_runtime_options(fd
))) {
201 runtime_options
= new_runtime_options
;
212 #ifndef LISP_FEATURE_HPUX
213 #define load_core_bytes(fd, where, addr, len) os_map(fd, where, addr, len)
215 #define load_core_bytes(fd, where, addr, len) copy_core_bytes(fd, where, addr, len)
216 /* If more platforms don't support overlapping mmap rename this
217 * def to something like ifdef nommapoverlap */
218 /* currently hpux only */
219 static void copy_core_bytes(int fd
, os_vm_offset_t offset
,
220 os_vm_address_t addr
, int len
)
222 unsigned char buf
[4096];
224 int old_fd
= lseek(fd
, 0, SEEK_CUR
);
227 fprintf(stderr
, "cant copy a slice of core because slice-length is not of page size(4096)\n");
231 fprintf(stderr
, "cant perform lseek() on corefile\n");
233 lseek(fd
, offset
, SEEK_SET
);
235 fprintf(stderr
, "cant perform lseek(%u,%lu,SEEK_SET) on corefile\n", fd
, offset
);
237 for(x
= 0; x
< len
; x
+= 4096){
238 c
= read(fd
, buf
, 4096);
240 fprintf(stderr
, "cant read memory area from corefile at position %lu, got %d\n", offset
+ x
, c
);
243 memcpy(addr
+x
, buf
, 4096);
245 os_flush_icache(addr
, len
);
249 #ifndef LISP_FEATURE_SB_CORE_COMPRESSION
250 # define inflate_core_bytes(fd,offset,addr,len) \
251 lose("This runtime was not built with zlib-compressed core support... aborting\n")
253 # define ZLIB_BUFFER_SIZE (1u<<16)
254 static void inflate_core_bytes(int fd
, os_vm_offset_t offset
,
255 os_vm_address_t addr
, int len
)
258 unsigned char* buf
= successful_malloc(ZLIB_BUFFER_SIZE
);
261 # ifdef LISP_FEATURE_WIN32
262 /* Ensure the memory is committed so zlib doesn't segfault trying to
264 os_validate_recommit(addr
, len
);
267 if (-1 == lseek(fd
, offset
, SEEK_SET
)) {
268 lose("Unable to lseek() on corefile\n");
271 stream
.zalloc
= NULL
;
273 stream
.opaque
= NULL
;
275 stream
.next_in
= buf
;
277 ret
= inflateInit(&stream
);
279 lose("zlib error %i\n", ret
);
281 stream
.next_out
= (void*)addr
;
282 stream
.avail_out
= len
;
284 ssize_t count
= read(fd
, buf
, ZLIB_BUFFER_SIZE
);
286 lose("unable to read core file (errno = %i)\n", errno
);
287 stream
.next_in
= buf
;
288 stream
.avail_in
= count
;
289 if (count
== 0) break;
290 ret
= inflate(&stream
, Z_NO_FLUSH
);
295 if (stream
.avail_out
== 0)
296 lose("Runaway gzipped core directory... aborting\n");
297 if (stream
.avail_in
> 0)
298 lose("zlib inflate returned without fully"
299 "using up input buffer... aborting\n");
302 lose("zlib inflate error: %i\n", ret
);
305 } while (ret
!= Z_STREAM_END
);
307 if (stream
.avail_out
> 0) {
308 if (stream
.avail_out
>= os_vm_page_size
)
309 fprintf(stderr
, "Warning: gzipped core directory significantly"
310 "shorter than expected (%lu bytes)", (unsigned long)stream
.avail_out
);
311 /* Is this needed? */
312 memset(stream
.next_out
, 0, stream
.avail_out
);
318 # undef ZLIB_BUFFER_SIZE
322 /* range[0] is dynamic space, ranges[1] and [2] are immobile spaces */
328 int n_relocs_abs
; // absolute
329 int n_relocs_rel
; // relative
332 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
333 #define adjust_word(ignore,thing) thing
334 #define relocate_heap(ignore)
336 #include "genesis/gc-tables.h"
337 #include "genesis/hash-table.h"
338 #include "genesis/layout.h"
339 #include "genesis/vector.h"
341 static inline sword_t
calc_adjustment(struct heap_adjust
* adj
, lispobj x
)
343 if (adj
->range
[0].start
<= x
&& x
< adj
->range
[0].end
)
344 return adj
->range
[0].delta
;
345 #ifdef LISP_FEATURE_IMMOBILE_SPACE
346 if (adj
->range
[1].start
<= x
&& x
< adj
->range
[1].end
)
347 return adj
->range
[1].delta
;
348 if (adj
->range
[2].start
<= x
&& x
< adj
->range
[2].end
)
349 return adj
->range
[2].delta
;
354 // Return the adjusted value of 'word' without testing whether it looks
355 // like a pointer. But do test whether it points to a relocatable space.
356 static inline lispobj
adjust_word(struct heap_adjust
* adj
, lispobj word
) {
357 return word
+ calc_adjustment(adj
, word
);
360 #define SHOW_SPACE_RELOCATION 0
361 #if SHOW_SPACE_RELOCATION > 1
362 # define FIXUP(expr, addr) fprintf(stderr, "%p: (a) %lx", addr, *(long*)(addr)), \
363 expr, fprintf(stderr, " -> %lx\n", *(long*)(addr)), ++adj->n_relocs_abs
364 # define FIXUP32(expr, addr) fprintf(stderr, "%p: (a) %x", addr, *(int*)(addr)), \
365 expr, fprintf(stderr, " -> %x\n", *(int*)(addr)), ++adj->n_relocs_abs
366 # define FIXUP_rel(expr, addr) fprintf(stderr, "%p: (r) %x", addr, *(int*)(addr)), \
367 expr, fprintf(stderr, " -> %x\n", *(int*)(addr)), ++adj->n_relocs_rel
368 #elif SHOW_SPACE_RELOCATION
369 # define FIXUP(expr, addr) expr, ++adj->n_relocs_abs
370 # define FIXUP32(expr, addr) expr, ++adj->n_relocs_abs
371 # define FIXUP_rel(expr, addr) expr, ++adj->n_relocs_rel
373 # define FIXUP(expr, addr) expr
374 # define FIXUP32(expr, addr) expr
375 # define FIXUP_rel(expr, addr) expr
378 // Fix the word at 'where' without testing whether it looks pointer-like.
379 // Avoid writing if there is no adjustment.
380 static inline void adjust_word_at(lispobj
* where
, struct heap_adjust
* adj
) {
381 lispobj word
= *where
;
382 sword_t adjustment
= calc_adjustment(adj
, word
);
384 FIXUP(*where
= word
+ adjustment
, where
);
387 // Adjust the words in range [where,where+n_words)
388 // skipping any words that have non-pointer nature.
389 static void adjust_pointers(lispobj
*where
, sword_t n_words
, struct heap_adjust
* adj
)
392 for (i
=0;i
<n_words
;++i
) {
393 lispobj word
= where
[i
];
395 if (is_lisp_pointer(word
) && (adjustment
= calc_adjustment(adj
, word
)) != 0) {
396 FIXUP(where
[i
] = word
+ adjustment
, where
+i
);
402 #include "unaligned.h"
403 static void __attribute__((unused
))
404 adjust_code_refs(struct heap_adjust
* adj
, lispobj fixups
, struct code
* code
)
406 struct varint_unpacker unpacker
;
407 varint_unpacker_init(&unpacker
, fixups
);
408 char* instructions
= (char*)((lispobj
*)code
+ code_header_words(code
->header
));
409 int prev_loc
= 0, loc
;
410 while (varint_unpack(&unpacker
, &loc
) && loc
!= 0) {
411 // For extra compactness, each loc is relative to the prior,
412 // so that the magnitudes are smaller.
415 void* fixup_where
= instructions
+ loc
;
416 lispobj ptr
= UNALIGNED_LOAD32(fixup_where
);
417 lispobj adjusted
= ptr
+ calc_adjustment(adj
, ptr
);
419 FIXUP32(UNALIGNED_STORE32(fixup_where
, adjusted
), fixup_where
);
423 static inline void fix_fun_header_layout(lispobj
* fun
, struct heap_adjust
* adj
)
425 #if defined(LISP_FEATURE_COMPACT_INSTANCE_HEADER) && defined(LISP_FEATURE_64_BIT)
426 lispobj ptr
= function_layout(fun
);
427 lispobj adjusted
= adjust_word(adj
, ptr
);
429 FIXUP(set_function_layout(fun
, adjusted
), fun
);
433 static void relocate_space(uword_t start
, lispobj
* end
, struct heap_adjust
* adj
)
435 lispobj
*where
= (lispobj
*)start
;
439 lispobj layout
, adjusted_layout
, bitmap
;
443 adj
->n_relocs_abs
= adj
->n_relocs_rel
= 0;
444 for ( ; where
< end
; where
+= nwords
) {
445 header_word
= *where
;
446 if (is_cons_half(header_word
)) {
447 adjust_pointers(where
, 2, adj
);
451 widetag
= widetag_of(header_word
);
452 nwords
= sizetab
[widetag
](where
);
454 case FUNCALLABLE_INSTANCE_WIDETAG
:
455 // Special note on the word at where[1] in funcallable instances:
456 // - If no immobile code, then the word points to read-only space,
457 /// hence needs no adjustment.
458 // - Otherwise, the word might point to a relocated range,
459 // either the instance itself, or a trampoline in immobile space.
460 adjust_word_at(where
+1, adj
);
461 case INSTANCE_WIDETAG
:
462 layout
= (widetag
== FUNCALLABLE_INSTANCE_WIDETAG
) ?
463 funinstance_layout(where
) : instance_layout(where
);
464 adjusted_layout
= adjust_word(adj
, layout
);
465 // Do not alter the layout as stored in the instance if non-compact
466 // header. instance_scan() will do it if necessary.
467 #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
468 if (adjusted_layout
!= layout
)
469 instance_layout(where
) = adjusted_layout
;
471 bitmap
= LAYOUT(adjusted_layout
)->bitmap
;
472 gc_assert(fixnump(bitmap
)
473 || widetag_of(*native_pointer(bitmap
))==BIGNUM_WIDETAG
);
474 // If the post-adjustment address of 'layout' is higher than 'where',
475 // then the layout's pointer slots need adjusting.
476 // This is true regardless of whether the core was mapped at a higher
477 // or lower address than desired.
478 if (is_lisp_pointer(bitmap
) && adjusted_layout
> (lispobj
)where
) {
479 // Do not write back the adjusted bitmap pointer. Each heap word
480 // must be touched at most once. When the layout itself gets scanned,
481 // the bitmap slot will be rewritten if needed.
482 bitmap
= adjust_word(adj
, bitmap
);
485 instance_scan((void(*)(lispobj
*,sword_t
,uword_t
))adjust_pointers
,
486 where
+1, nwords
-1, bitmap
, (uintptr_t)adj
);
489 adjust_pointers(where
+1, 2, adj
);
490 // 'raw_addr' doesn't satisfy is_lisp_pointer() for x86,
491 // so adjust_pointers() would ignore it. Therefore we need to
492 // forcibly adjust it.
493 #ifndef LISP_FEATURE_IMMOBILE_CODE
494 adjust_word_at(where
+3, adj
);
495 #elif defined(LISP_FEATURE_X86_64)
496 // the offset from fdefns to code can change if:
497 // - static space fdefn -> immobile space code and immobile space moved
498 // - immobile spaces changed relative position
499 if ((delta
= calc_adjustment(adj
, fdefn_callee_lispobj((struct fdefn
*)where
)))) {
500 void* prel32
= 1 + (char*)(where
+3);
501 FIXUP_rel(UNALIGNED_STORE32(prel32
, UNALIGNED_LOAD32(prel32
) + delta
),
506 case CODE_HEADER_WIDETAG
:
507 // Fixup the constant pool. The word at where+1 is a fixnum.
508 adjust_pointers(where
+2, code_header_words(header_word
)-2, adj
);
509 // Fixup all embedded simple-funs
510 code
= (struct code
*)where
;
511 for_each_simple_fun(i
, f
, code
, 1, {
512 fix_fun_header_layout((lispobj
*)f
, adj
);
513 #if FUN_SELF_FIXNUM_TAGGED
514 if (f
->self
!= (lispobj
)f
->code
)
515 FIXUP(f
->self
= (lispobj
)f
->code
, &f
->self
);
517 adjust_pointers(SIMPLE_FUN_SCAV_START(f
), SIMPLE_FUN_SCAV_NWORDS(f
), adj
);
519 // Compute the address where the code "was" as the first argument
520 // by negating the adjustment for 'where'.
521 // Can't call calc_adjustment to get the negative of the adjustment!
522 gencgc_apply_code_fixups((struct code
*)((char*)where
- adj
->range
[1].delta
),
524 #ifdef LISP_FEATURE_IMMOBILE_SPACE
525 // Now that the packed integer comprising the list of fixup locations
526 // has been fixed-up (if necessary), apply them to the code.
527 if (code
->fixups
!= 0)
528 adjust_code_refs(adj
, code
->fixups
, code
);
531 case CLOSURE_WIDETAG
:
532 fix_fun_header_layout(where
, adj
);
533 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
534 // For x86[-64], the closure fun appears to be a fixnum,
535 // and might need adjustment unless pointing to immobile code.
536 // Then fall into the general case; where[1] won't get re-adjusted
537 // because it doesn't satisfy is_lisp_pointer().
538 adjust_word_at(where
+1, adj
);
541 // Vectors require extra care because of EQ-based hashing.
542 case SIMPLE_VECTOR_WIDETAG
:
543 if (is_vector_subtype(*where
, VectorValidHashing
)) {
544 struct vector
* v
= (struct vector
*)where
;
545 gc_assert(v
->length
> 0 &&
546 !(v
->length
& make_fixnum(1)) && // length must be even
547 lowtag_of(v
->data
[0]) == INSTANCE_POINTER_LOWTAG
);
548 lispobj
* data
= (lispobj
*)v
->data
;
549 adjust_pointers(&data
[0], 1, adj
); // adjust the hash-table structure
550 boolean needs_rehash
= 0;
551 lispobj
*where
= &data
[2], *end
= &data
[fixnum_value(v
->length
)];
552 // Adjust the elements, checking for need to rehash.
553 for ( ; where
< end
; where
+= 2) {
554 lispobj ptr
= *where
; // key
555 if (is_lisp_pointer(ptr
) && (delta
= calc_adjustment(adj
, ptr
)) != 0) {
556 FIXUP(*where
= ptr
+ delta
, where
);
559 ptr
= where
[1]; // value
560 if (is_lisp_pointer(ptr
) && (delta
= calc_adjustment(adj
, ptr
)) != 0)
561 FIXUP(where
[1] = ptr
+ delta
, where
+1);
563 if (needs_rehash
) // set v->data[1], the need-to-rehash bit
564 data
[1] = make_fixnum(1);
567 // All the array header widetags.
568 case SIMPLE_ARRAY_WIDETAG
:
569 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
570 case COMPLEX_CHARACTER_STRING_WIDETAG
:
572 case COMPLEX_BASE_STRING_WIDETAG
:
573 case COMPLEX_VECTOR_NIL_WIDETAG
:
574 case COMPLEX_BIT_VECTOR_WIDETAG
:
575 case COMPLEX_VECTOR_WIDETAG
:
576 case COMPLEX_ARRAY_WIDETAG
:
577 // And the rest of the purely descriptor objects.
579 case VALUE_CELL_WIDETAG
:
580 case WEAK_POINTER_WIDETAG
:
582 case COMPLEX_WIDETAG
:
587 if ((delta
= calc_adjustment(adj
, where
[1])) != 0) {
589 "WARNING: SAP at %p -> %p in relocatable core\n",
590 where
, (void*)where
[1]);
591 FIXUP(where
[1] += delta
, where
+1);
595 #ifndef LISP_FEATURE_64_BIT
596 case SINGLE_FLOAT_WIDETAG
:
598 case DOUBLE_FLOAT_WIDETAG
:
599 case COMPLEX_SINGLE_FLOAT_WIDETAG
:
600 case COMPLEX_DOUBLE_FLOAT_WIDETAG
:
601 #ifdef SIMD_PACK_WIDETAG
602 case SIMD_PACK_WIDETAG
:
606 if (other_immediate_lowtag_p(widetag
)
607 && specialized_vector_widetag_p(widetag
))
610 lose("Unrecognized heap object: @%p: %lx\n", where
, header_word
);
612 adjust_pointers(where
+1, nwords
-1, adj
);
614 #if SHOW_SPACE_RELOCATION
615 fprintf(stderr
, "space @ %p: fixed %d absolute + %d relative pointers\n",
616 (lispobj
*)start
, adj
->n_relocs_abs
, adj
->n_relocs_rel
);
620 void relocate_heap(struct heap_adjust
* adj
)
622 if (!lisp_startup_options
.noinform
|| SHOW_SPACE_RELOCATION
) {
624 for (i
= 0; i
< adj
->n_ranges
; ++i
)
625 if (adj
->range
[i
].delta
)
626 fprintf(stderr
, "NOTE: Relocating [%p:%p] into [%p:%p]\n",
627 (char*)adj
->range
[i
].start
,
628 (char*)adj
->range
[i
].end
,
629 (char*)adj
->range
[i
].start
+ adj
->range
[i
].delta
,
630 (char*)adj
->range
[i
].end
+ adj
->range
[i
].delta
);
632 relocate_space(STATIC_SPACE_START
, static_space_free_pointer
, adj
);
633 #ifdef LISP_FEATURE_IMMOBILE_SPACE
634 relocate_space(FIXEDOBJ_SPACE_START
, fixedobj_free_pointer
, adj
);
635 SYMBOL(FUNCTION_LAYOUT
)->value
= \
636 adjust_word(adj
, SYMBOL(FUNCTION_LAYOUT
)->value
>> 32) << 32;
638 relocate_space(DYNAMIC_SPACE_START
, (lispobj
*)get_alloc_pointer(), adj
);
640 #ifdef LISP_FEATURE_IMMOBILE_SPACE
641 // Pointers within varyobj space to varyobj space do not need adjustment
642 // so remove any delta before performing the relocation pass on this space.
644 if (&__lisp_code_start
)
645 adj
->range
[2].delta
= 0;
647 relocate_space(VARYOBJ_SPACE_START
, varyobj_free_pointer
, adj
);
652 int merge_core_pages
= -1;
655 set_adjustment(struct heap_adjust
* adj
,
657 uword_t desired_addr
,
660 int j
= adj
->n_ranges
;
662 adj
->range
[j
].start
= (lispobj
)desired_addr
;
663 adj
->range
[j
].end
= (lispobj
)desired_addr
+ len
;
664 adj
->range
[j
].delta
= actual_addr
- desired_addr
;
669 process_directory(int count
, struct ndir_entry
*entry
,
670 int fd
, os_vm_offset_t file_offset
,
671 struct heap_adjust
* adj
)
673 extern void immobile_space_coreparse(uword_t
,uword_t
);
676 size_t desired_size
; // size wanted, ORed with 1 if addr must be <2GB
677 // Values from the core file:
678 uword_t len
; // length in bytes, as an integral multiple of os_vm_page_size
680 lispobj
** pfree_pointer
; // pointer to x_free_pointer
681 } spaces
[MAX_CORE_SPACE_ID
+1] = {
682 {0, 0, 0, 0}, // blank for space ID 0
683 #ifdef LISP_FEATURE_GENCGC
684 {dynamic_space_size
, 0, DYNAMIC_SPACE_START
, 0},
688 // This order is determined by constants in compiler/generic/genesis
689 {0, 0, STATIC_SPACE_START
, &static_space_free_pointer
},
690 {0, 0, READ_ONLY_SPACE_START
, &read_only_space_free_pointer
},
691 #ifdef LISP_FEATURE_IMMOBILE_SPACE
692 {FIXEDOBJ_SPACE_SIZE
| 1, 0,
693 FIXEDOBJ_SPACE_START
, &fixedobj_free_pointer
},
694 {1, 0, VARYOBJ_SPACE_START
, &varyobj_free_pointer
}
699 if (&__lisp_code_start
) {
700 VARYOBJ_SPACE_START
= (uword_t
)&__lisp_code_start
;
701 varyobj_free_pointer
= &__lisp_code_end
;
702 uword_t aligned_end
= ALIGN_UP((uword_t
)&__lisp_code_end
, IMMOBILE_CARD_BYTES
);
703 varyobj_space_size
= aligned_end
- VARYOBJ_SPACE_START
;
704 spaces
[IMMOBILE_VARYOBJ_CORE_SPACE_ID
].len
= varyobj_space_size
;
705 gc_assert(varyobj_free_pointer
>= (lispobj
*)VARYOBJ_SPACE_START
);
706 #if !ENABLE_PAGE_PROTECTION
707 printf("Lisp code present in executable @ %lx:%lx (freeptr=%p)\n",
708 (uword_t
)&__lisp_code_start
, aligned_end
, varyobj_free_pointer
);
710 // unprotect the pages
711 os_protect((void*)VARYOBJ_SPACE_START
, varyobj_space_size
, OS_VM_PROT_ALL
);
714 #ifdef LISP_FEATURE_IMMOBILE_SPACE
716 spaces
[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
].desired_size
+= VARYOBJ_SPACE_SIZE
;
720 for ( ; --count
>= 0; ++entry
) {
721 sword_t id
= entry
->identifier
;
722 uword_t addr
= entry
->address
;
723 int compressed
= id
& DEFLATED_CORE_SPACE_ID_FLAG
;
725 if (id
< 1 || id
> MAX_CORE_SPACE_ID
)
726 lose("unknown space ID %ld addr %p\n", id
, addr
);
728 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
729 int enforce_address
= 1;
730 #elif defined(LISP_FEATURE_IMMOBILE_SPACE)
731 // Enforce address of readonly, static, immobile varyobj
732 int enforce_address
= id
!= DYNAMIC_CORE_SPACE_ID
733 && id
!= IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
734 && id
!= IMMOBILE_VARYOBJ_CORE_SPACE_ID
;
736 // Enforce address of readonly and static spaces.
737 int enforce_address
= id
!= DYNAMIC_CORE_SPACE_ID
;
740 // We'd like to enforce proper alignment of 'addr' but there's
741 // a problem: dynamic space has a stricter requirement (usually 32K)
742 // than code space (4K). So don't assert the alignment.
743 if (enforce_address
) {
745 #ifdef LISP_FEATURE_CHENEYGC
746 if (id
== DYNAMIC_CORE_SPACE_ID
) {
747 if ((fail
= (addr
!= DYNAMIC_0_SPACE_START
) &&
748 (addr
!= DYNAMIC_1_SPACE_START
)) != 0)
749 fprintf(stderr
, "in core: %p; in runtime: %p or %p\n",
751 (void*)DYNAMIC_0_SPACE_START
,
752 (void*)DYNAMIC_1_SPACE_START
);
755 if ((fail
= (addr
!= spaces
[id
].base
)) != 0)
756 fprintf(stderr
, "in core: %p; in runtime: %p\n",
757 (void*)addr
, (void*)spaces
[id
].base
);
759 "DYNAMIC", "STATIC", "READ_ONLY", "IMMOBILE", "IMMOBILE"
762 lose("core/runtime address mismatch: %s_SPACE_START", names
[id
-1]);
764 spaces
[id
].base
= addr
;
765 uword_t len
= os_vm_page_size
* entry
->page_count
;
766 if (id
== DYNAMIC_CORE_SPACE_ID
&& len
> dynamic_space_size
) {
767 lose("dynamic space too small for core: %luKiB required, %luKiB available.\n",
768 (unsigned long)len
>> 10,
769 (unsigned long)dynamic_space_size
>> 10);
772 spaces
[id
].len
= len
;
773 uword_t
__attribute__((unused
)) aligned_start
;
774 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
775 // Try to map at address requested by the core file.
776 size_t request
= spaces
[id
].desired_size
;
777 int sub_2gb_flag
= (request
& 1);
778 request
&= ~(size_t)1;
779 #ifdef LISP_FEATURE_IMMOBILE_SPACE
780 if (id
== IMMOBILE_VARYOBJ_CORE_SPACE_ID
)
781 // Pretend an os_validate() happened based on the address that
782 // would be obtained by a constant offset from fixedobj space
783 addr
= FIXEDOBJ_SPACE_START
+ FIXEDOBJ_SPACE_SIZE
;
787 addr
= (uword_t
)os_validate(sub_2gb_flag
? MOVABLE_LOW
: MOVABLE
,
788 (os_vm_address_t
)addr
, request
);
790 #ifdef LISP_FEATURE_IMMOBILE_SPACE
791 case IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
:
792 case IMMOBILE_VARYOBJ_CORE_SPACE_ID
:
793 if (addr
+ request
> 0x80000000)
794 lose("Won't map immobile space above 2GB");
795 if (id
== IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
)
796 FIXEDOBJ_SPACE_START
= addr
;
798 VARYOBJ_SPACE_START
= addr
;
801 case DYNAMIC_CORE_SPACE_ID
:
802 aligned_start
= ALIGN_UP(addr
, GENCGC_CARD_BYTES
);
803 /* Misalignment can happen only if card size exceeds OS page.
804 * Drop one card to avoid overrunning the allocated space */
805 if (aligned_start
> addr
) // not card-aligned
806 dynamic_space_size
-= GENCGC_CARD_BYTES
;
807 DYNAMIC_SPACE_START
= addr
= aligned_start
;
810 #endif /* LISP_FEATURE_RELOCATABLE_HEAP */
812 sword_t offset
= os_vm_page_size
* (1 + entry
->data_page
);
814 inflate_core_bytes(fd
, offset
+ file_offset
, (os_vm_address_t
)addr
, len
);
816 load_core_bytes(fd
, offset
+ file_offset
, (os_vm_address_t
)addr
, len
);
819 #ifdef MADV_MERGEABLE
820 if ((merge_core_pages
== 1)
821 || ((merge_core_pages
== -1) && compressed
)) {
822 madvise((void *)addr
, len
, MADV_MERGEABLE
);
826 lispobj
*free_pointer
= (lispobj
*) addr
+ entry
->nwords
;
829 // varyobj free ptr is already nonzero if Lisp code in executable
830 if (!*spaces
[id
].pfree_pointer
)
831 *spaces
[id
].pfree_pointer
= free_pointer
;
833 case DYNAMIC_CORE_SPACE_ID
:
834 #ifdef LISP_FEATURE_CHENEYGC
835 /* 'addr' is the actual address if relocatable.
836 * For cheneygc, this will be whatever the GC was using
837 * at the time the core was saved.
838 * For gencgc this is #defined as DYNAMIC_SPACE_START */
839 current_dynamic_space
= (lispobj
*)addr
;
841 set_alloc_pointer((lispobj
)free_pointer
);
843 anon_dynamic_space_start
= (os_vm_address_t
)(addr
+ len
);
844 /* This assertion safeguards the test in zero_pages_with_mmap()
845 * which trusts that if addr > anon_dynamic_space_start
846 * then addr did not come from any file mapping. */
847 gc_assert((lispobj
)anon_dynamic_space_start
> STATIC_SPACE_END
);
851 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
852 set_adjustment(adj
, DYNAMIC_SPACE_START
, // actual
853 spaces
[DYNAMIC_CORE_SPACE_ID
].base
, // expected
854 spaces
[DYNAMIC_CORE_SPACE_ID
].len
);
855 #ifdef LISP_FEATURE_IMMOBILE_SPACE
856 set_adjustment(adj
, FIXEDOBJ_SPACE_START
, // actual
857 spaces
[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
].base
, // expected
858 spaces
[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
].len
);
859 set_adjustment(adj
, VARYOBJ_SPACE_START
, // actual
860 spaces
[IMMOBILE_VARYOBJ_CORE_SPACE_ID
].base
, // expected
861 spaces
[IMMOBILE_VARYOBJ_CORE_SPACE_ID
].len
);
863 if (adj
->range
[0].delta
| adj
->range
[1].delta
| adj
->range
[2].delta
)
867 #ifdef LISP_FEATURE_IMMOBILE_SPACE
868 /* Now determine page characteristics (such as object spacing)
869 * after relocation, because we need to know which objects are layouts
870 * based on knowing layout-of-layout. The test for that is dependent
871 * on what it's address should be, not what it was in the file */
872 immobile_space_coreparse(spaces
[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
].len
,
873 spaces
[IMMOBILE_VARYOBJ_CORE_SPACE_ID
].len
);
876 * | varyobj space | .... other random stuff ... | fixedobj space | ...
877 * then the lower bound is A, the upper bound is D,
878 * the max_offset is the distance from A to D,
879 * and the excluded middle is the range spanned by B to C.
884 struct range range1
=
885 {FIXEDOBJ_SPACE_START
, FIXEDOBJ_SPACE_START
+ FIXEDOBJ_SPACE_SIZE
};
886 struct range range2
=
887 {VARYOBJ_SPACE_START
, VARYOBJ_SPACE_START
+ VARYOBJ_SPACE_SIZE
};
888 if (range2
.start
< range1
.start
) { // swap
889 struct range temp
= range1
;
893 immobile_space_lower_bound
= range1
.start
;
894 immobile_space_max_offset
= range2
.end
- range1
.start
;
895 immobile_range_1_max_offset
= range1
.end
- range1
.start
;
896 immobile_range_2_min_offset
= range2
.start
- range1
.start
;
898 #ifdef LISP_FEATURE_X86_64
899 tune_asm_routines_for_microarch(); // before WPing immobile space
904 load_core_file(char *file
, os_vm_offset_t file_offset
)
907 core_entry_elt_t val
, *ptr
;
908 os_vm_size_t len
, remaining_len
;
909 int fd
= open_binary(file
, O_RDONLY
);
911 lispobj initial_function
= NIL
;
912 struct heap_adjust adj
;
913 memset(&adj
, 0, sizeof adj
);
915 FSHOW((stderr
, "/entering load_core_file(%s)\n", file
));
917 fprintf(stderr
, "could not open file \"%s\"\n", file
);
922 lseek(fd
, file_offset
, SEEK_SET
);
923 header
= calloc(os_vm_page_size
, 1);
925 count
= read(fd
, header
, os_vm_page_size
);
926 if (count
< (ssize_t
) os_vm_page_size
) {
927 lose("premature end of core file\n");
929 SHOW("successfully read first page of core");
934 if (val
!= CORE_MAGIC
) {
935 lose("invalid magic number in core: 0x%lx should have been 0x%x.\n",
939 SHOW("found CORE_MAGIC");
941 #define WORD_FMTX OS_VM_SIZE_FMTX
942 for ( ; ; ptr
+= remaining_len
) {
945 remaining_len
= len
- 2; /* (-2 to cancel the two ++ operations) */
946 FSHOW((stderr
, "/val=0x%"WORD_FMTX
", remaining_len=0x%"WORD_FMTX
"\n",
947 val
, remaining_len
));
951 case END_CORE_ENTRY_TYPE_CODE
:
954 return initial_function
;
956 case BUILD_ID_CORE_ENTRY_TYPE_CODE
:
957 SHOW("BUILD_ID_CORE_ENTRY_TYPE_CODE case");
959 os_vm_size_t stringlen
= *ptr
++;
961 gc_assert(remaining_len
* sizeof (core_entry_elt_t
) >= stringlen
);
962 if (sizeof build_id
== stringlen
+1 && !memcmp(ptr
, build_id
, stringlen
))
964 /* .core files are not binary-compatible between
965 * builds because we can't easily detect whether the
966 * sources were patched between the time the
967 * dumping-the-.core runtime was built and the time
968 * that the loading-the-.core runtime was built.
970 * (We could easily detect whether version.lisp-expr
971 * was changed, but people experimenting with patches
972 * don't necessarily update version.lisp-expr.) */
974 "core was built for runtime \"%.*s\" but this is \"%s\"\n",
975 (int)stringlen
, (char*)ptr
, build_id
);
976 lose("can't load .core for different runtime, sorry\n");
979 case NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE
:
980 SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case");
981 process_directory(remaining_len
/ NDIR_ENTRY_LENGTH
,
982 (struct ndir_entry
*)ptr
, fd
, file_offset
,
986 case INITIAL_FUN_CORE_ENTRY_TYPE_CODE
:
987 SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case");
988 initial_function
= adjust_word(&adj
, (lispobj
)*ptr
);
991 #ifdef LISP_FEATURE_GENCGC
992 case PAGE_TABLE_CORE_ENTRY_TYPE_CODE
:
994 extern void gc_allocate_ptes();
995 extern boolean
gc_load_corefile_ptes(char data
[], ssize_t
,
996 page_index_t
, page_index_t
*);
997 // Allocation of PTEs is delayed 'til now so that calloc() doesn't
998 // consume addresses that would have been taken by a mapped space.
1000 core_entry_elt_t n_ptes
= ptr
[0];
1001 os_vm_size_t remaining
= ptr
[1];
1002 gc_assert(remaining
>= sizeof (struct corefile_pte
) * n_ptes
);
1003 os_vm_size_t fdoffset
= (ptr
[2] + 1) * os_vm_page_size
;
1004 page_index_t page
= 0;
1007 // A corefile_pte is 10 bytes for x86-64
1008 // Process an integral number of ptes on each read.
1009 os_vm_size_t chunksize
= sizeof (struct corefile_pte
)
1010 * (sizeof data
/ sizeof (struct corefile_pte
));
1011 lseek(fd
, fdoffset
+ file_offset
, SEEK_SET
);
1012 while ((bytes_read
= read(fd
, data
,
1013 remaining
< chunksize
? remaining
: chunksize
)) > 0
1014 && gc_load_corefile_ptes(data
, bytes_read
, n_ptes
, &page
))
1015 remaining
-= bytes_read
;
1020 lose("unknown core file entry: 0x%"WORD_FMTX
"\n", val
);
1025 #include "genesis/hash-table.h"
1026 #include "genesis/vector.h"
1027 #include "genesis/cons.h"
1028 os_vm_address_t
get_asm_routine_by_name(const char* name
)
1030 #ifdef LISP_FEATURE_IMMOBILE_CODE
1031 struct code
* code
= (struct code
*)VARYOBJ_SPACE_START
;
1033 struct code
* code
= (struct code
*)READ_ONLY_SPACE_START
;
1035 if (lowtag_of(code
->debug_info
) == LIST_POINTER_LOWTAG
) {
1036 struct hash_table
* ht
=
1037 (struct hash_table
*)native_pointer(CONS(code
->debug_info
)->car
);
1038 struct vector
* table
= VECTOR(ht
->table
);
1041 for (i
=2 ; i
< fixnum_value(table
->length
) ; i
+= 2)
1042 if (lowtag_of(sym
= table
->data
[i
]) == OTHER_POINTER_LOWTAG
1043 && widetag_of(SYMBOL(sym
)->header
) == SYMBOL_WIDETAG
1044 && !strcmp(name
, (char*)(VECTOR(SYMBOL(sym
)->name
)->data
)))
1045 return ALIGN_UP(offsetof(struct code
,constants
), 2*N_WORD_BYTES
)
1046 + fixnum_value(CONS(table
->data
[i
+1])->car
) + (os_vm_address_t
)code
;
1047 // Something is wrong if we have a hashtable but find nothing.
1048 fprintf(stderr
, "WARNING: get_asm_routine_by_name(%s) failed\n",
1054 void asm_routine_poke(const char* routine
, int offset
, char byte
)
1056 char *address
= (char *)get_asm_routine_by_name(routine
);
1058 address
[offset
] = byte
;