src/runtime/coreparse.c

   1 /*
   2  * A saved SBCL system is a .core file; the code here helps us accept
   3  * such a file as input.
   4  */
   5
   6 /*
   7  * This software is part of the SBCL system. See the README file for
   8  * more information.
   9  *
  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.
  15  */
  16
  17 #include "sbcl.h"
  18
  19 #ifndef LISP_FEATURE_WIN32
  20 #ifdef LISP_FEATURE_LINUX
  21 /* For madvise */
  22 #define _BSD_SOURCE
  23 #include <sys/mman.h>
  24 #undef _BSD_SOURCE
  25 #else
  26 #include <sys/mman.h>
  27 #endif
  28 #endif
  29
  30 #include <stdio.h>
  31 #include <stdlib.h>
  32 #include <string.h>
  33 #include <sys/file.h>
  34 #include <sys/types.h>
  35 #include <sys/stat.h>
  36 #include <fcntl.h>
  37 #include <unistd.h>
  38
  39 #include "os.h"
  40 #include "runtime.h"
  41 #include "globals.h"
  42 #include "core.h"
  43 #include "arch.h"
  44 #include "interr.h"
  45 #include "thread.h"
  46
  47 #include "validate.h"
  48 #include "gc-internal.h"
  49 #include "runtime-options.h"
  50 #include "pseudo-atomic.h"
  51
  52 #include <errno.h>
  53
  54 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
  55 # include <zlib.h>
  56 #endif
  57
  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
  69 "-msan"
  70 #endif
  71 ;
  72
  73 int
  74 open_binary(char *filename, int mode)
  75 {
  76 #ifdef LISP_FEATURE_WIN32
  77     mode |= O_BINARY;
  78 #endif
  79
  80     return open(filename, mode);
  81 }
  82
  83
  84 static struct runtime_options *
  85 read_runtime_options(int fd)
  86 {
  87     os_vm_size_t optarray[RUNTIME_OPTIONS_WORDS];
  88     struct runtime_options *options = NULL;
  89
  90     if (read(fd, optarray, RUNTIME_OPTIONS_WORDS * sizeof(os_vm_size_t)) !=
  91         RUNTIME_OPTIONS_WORDS * sizeof(size_t)) {
  92         return NULL;
  93     }
  94
  95     if ((RUNTIME_OPTIONS_MAGIC != optarray[0]) || (0 == optarray[1])) {
  96         return NULL;
  97     }
  98
  99     options = successful_malloc(sizeof(struct runtime_options));
 100
 101     options->dynamic_space_size = optarray[2];
 102     options->thread_control_stack_size = optarray[3];
 103
 104     return options;
 105 }
 106
 107 void
 108 maybe_initialize_runtime_options(int fd)
 109 {
 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));
 114
 115     lseek(fd, -end_offset, SEEK_END);
 116
 117     if ((new_runtime_options = read_runtime_options(fd))) {
 118         runtime_options = new_runtime_options;
 119     }
 120 }
 121
 122 /* Search 'filename' for an embedded core.  An SBCL core has, at the
 123  * end of the file, a trailer containing optional saved runtime
 124  * options, the start of the core (an os_vm_offset_t), and a final
 125  * signature word (the lispobj CORE_MAGIC).  If this trailer is found
 126  * at the end of the file, the start of the core can be determined
 127  * from the core size.
 128  *
 129  * If an embedded core is present, this returns the offset into the
 130  * file to load the core from, or -1 if no core is present. */
 131 os_vm_offset_t
 132 search_for_embedded_core(char *filename)
 133 {
 134     lispobj header;
 135     os_vm_offset_t lispobj_size = sizeof(lispobj);
 136     os_vm_offset_t trailer_size = lispobj_size + sizeof(os_vm_offset_t);
 137     os_vm_offset_t core_start, pos;
 138     int fd = -1;
 139
 140     if ((fd = open_binary(filename, O_RDONLY)) < 0)
 141         goto lose;
 142
 143     if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 144         goto lose;
 145     if (header == CORE_MAGIC) {
 146         /* This file is a real core, not an embedded core.  Return 0 to
 147          * indicate where the core starts, and do not look for runtime
 148          * options in this case. */
 149         return 0;
 150     }
 151
 152     if (lseek(fd, -lispobj_size, SEEK_END) < 0)
 153         goto lose;
 154     if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 155         goto lose;
 156
 157     if (header == CORE_MAGIC) {
 158         if (lseek(fd, -trailer_size, SEEK_END) < 0)
 159             goto lose;
 160         if (read(fd, &core_start, sizeof(os_vm_offset_t)) < 0)
 161             goto lose;
 162
 163         if (lseek(fd, core_start, SEEK_SET) < 0)
 164             goto lose;
 165         pos = lseek(fd, 0, SEEK_CUR);
 166
 167         if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 168             goto lose;
 169
 170         if (header != CORE_MAGIC)
 171             goto lose;
 172
 173         maybe_initialize_runtime_options(fd);
 174
 175         close(fd);
 176         return pos;
 177     }
 178
 179 lose:
 180     if (fd != -1)
 181         close(fd);
 182
 183     return -1;
 184 }
 185
 186 #ifndef LISP_FEATURE_HPUX
 187 #define load_core_bytes(fd, where, addr, len) os_map(fd, where, addr, len)
 188 #else
 189 #define load_core_bytes(fd, where, addr, len) copy_core_bytes(fd, where, addr, len)
 190 /* If more platforms don't support overlapping mmap rename this
 191  * def to something like ifdef nommapoverlap */
 192 /* currently hpux only */
 193 static void copy_core_bytes(int fd, os_vm_offset_t offset,
 194                             os_vm_address_t addr, int len)
 195 {
 196   unsigned char buf[4096];
 197   int c,x;
 198   int old_fd = lseek(fd, 0, SEEK_CUR);
 199
 200   if(len & (4096-1)){
 201     fprintf(stderr, "cant copy a slice of core because slice-length is not of page size(4096)\n");
 202     exit(-1);
 203   }
 204   if(old_fd < 0){
 205     fprintf(stderr, "cant perform lseek() on corefile\n");
 206   }
 207   lseek(fd, offset, SEEK_SET);
 208   if(fd < 0){
 209     fprintf(stderr, "cant perform lseek(%u,%lu,SEEK_SET) on corefile\n", fd, offset);
 210   }
 211   for(x = 0; x < len; x += 4096){
 212     c = read(fd, buf, 4096);
 213     if(c != 4096){
 214       fprintf(stderr, "cant read memory area from corefile at position %lu, got %d\n", offset + x, c);
 215       exit(-1);
 216     }
 217     memcpy(addr+x, buf, 4096);
 218   }
 219   os_flush_icache(addr, len);
 220 }
 221 #endif
 222
 223 #ifndef LISP_FEATURE_SB_CORE_COMPRESSION
 224 # define inflate_core_bytes(fd,offset,addr,len) \
 225     lose("This runtime was not built with zlib-compressed core support... aborting\n")
 226 #else
 227 # define ZLIB_BUFFER_SIZE (1u<<16)
 228 static void inflate_core_bytes(int fd, os_vm_offset_t offset,
 229                                os_vm_address_t addr, int len)
 230 {
 231     z_stream stream;
 232     unsigned char* buf = successful_malloc(ZLIB_BUFFER_SIZE);
 233     int ret;
 234
 235 # ifdef LISP_FEATURE_WIN32
 236     /* Ensure the memory is committed so zlib doesn't segfault trying to
 237        inflate. */
 238     os_validate_recommit(addr, len);
 239 # endif
 240
 241     if (-1 == lseek(fd, offset, SEEK_SET)) {
 242         lose("Unable to lseek() on corefile\n");
 243     }
 244
 245     stream.zalloc = NULL;
 246     stream.zfree = NULL;
 247     stream.opaque = NULL;
 248     stream.avail_in = 0;
 249     stream.next_in = buf;
 250
 251     ret = inflateInit(&stream);
 252     if (ret != Z_OK)
 253         lose("zlib error %i\n", ret);
 254
 255     stream.next_out  = (void*)addr;
 256     stream.avail_out = len;
 257     do {
 258         ssize_t count = read(fd, buf, ZLIB_BUFFER_SIZE);
 259         if (count < 0)
 260             lose("unable to read core file (errno = %i)\n", errno);
 261         stream.next_in = buf;
 262         stream.avail_in = count;
 263         if (count == 0) break;
 264         ret = inflate(&stream, Z_NO_FLUSH);
 265         switch (ret) {
 266         case Z_STREAM_END:
 267             break;
 268         case Z_OK:
 269             if (stream.avail_out == 0)
 270                 lose("Runaway gzipped core directory... aborting\n");
 271             if (stream.avail_in > 0)
 272                 lose("zlib inflate returned without fully"
 273                      "using up input buffer... aborting\n");
 274             break;
 275         default:
 276             lose("zlib inflate error: %i\n", ret);
 277             break;
 278         }
 279     } while (ret != Z_STREAM_END);
 280
 281     if (stream.avail_out > 0) {
 282         if (stream.avail_out >= os_vm_page_size)
 283             fprintf(stderr, "Warning: gzipped core directory significantly"
 284                     "shorter than expected (%lu bytes)", (unsigned long)stream.avail_out);
 285         /* Is this needed? */
 286         memset(stream.next_out, 0, stream.avail_out);
 287     }
 288
 289     inflateEnd(&stream);
 290     free(buf);
 291 }
 292 # undef ZLIB_BUFFER_SIZE
 293 #endif
 294
 295 struct heap_adjust {
 296     /* range[0] is immobile space, range [1] is dynamic space */
 297     struct range {
 298         lispobj start, end;
 299         sword_t delta;
 300     } range[2];
 301 };
 302
 303 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
 304 #define adjust_word(ignore,thing) thing
 305 #define relocate_heap(ignore)
 306 #else
 307 #include "genesis/gc-tables.h"
 308 #include "genesis/hash-table.h"
 309 #include "genesis/layout.h"
 310 #include "genesis/vector.h"
 311
 312 static inline sword_t calc_adjustment(struct heap_adjust* adj, lispobj x)
 313 {
 314 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 315     if (adj->range[0].start <= x && x < adj->range[0].end)
 316         return adj->range[0].delta;
 317 #endif
 318     if (adj->range[1].start <= x && x < adj->range[1].end)
 319         return adj->range[1].delta;
 320     return 0;
 321 }
 322
 323 // Return the adjusted value of 'word' without testing whether it looks
 324 // like a pointer. But do test whether it points to a relocatable space.
 325 static inline lispobj adjust_word(struct heap_adjust* adj, lispobj word) {
 326     return word + calc_adjustment(adj, word);
 327 }
 328
 329 // Adjust the words in range [where,where+n_words)
 330 // skipping any words that have non-pointer nature.
 331 static void adjust_pointers(lispobj *where, sword_t n_words, struct heap_adjust* adj)
 332 {
 333     long i;
 334     for (i=0;i<n_words;++i) {
 335         lispobj word = where[i];
 336         sword_t adjustment;
 337         if (is_lisp_pointer(word) && (adjustment = calc_adjustment(adj, word)) != 0) {
 338             where[i] += adjustment;
 339         }
 340     }
 341 }
 342
 343 #include "var-io.h"
 344 #include "unaligned.h"
 345 static void __attribute__((unused))
 346 adjust_code_refs(struct heap_adjust* adj, lispobj fixups, struct code* code)
 347 {
 348     struct varint_unpacker unpacker;
 349     varint_unpacker_init(&unpacker, fixups);
 350     char* instructions = (char*)((lispobj*)code + code_header_words(code->header));
 351     int prev_loc = 0, loc;
 352     while (varint_unpack(&unpacker, &loc) && loc != 0) {
 353         // For extra compactness, each loc is relative to the prior,
 354         // so that the magnitudes are smaller.
 355         loc += prev_loc;
 356         prev_loc = loc;
 357         int* fixup_where = (int*)(instructions + loc);
 358         lispobj ptr = UNALIGNED_LOAD32(fixup_where);
 359         UNALIGNED_STORE32(fixup_where, ptr + calc_adjustment(adj, ptr));
 360     }
 361 }
 362
 363 #if defined(LISP_FEATURE_COMPACT_INSTANCE_HEADER) && defined(LISP_FEATURE_64_BIT)
 364 #define FIX_FUN_HEADER_LAYOUT(fun) \
 365   set_function_layout(fun, adjust_word(adj, function_layout(fun)))
 366 #else
 367 #define FIX_FUN_HEADER_LAYOUT(f) {}
 368 #endif
 369
 370 static void relocate_space(uword_t start, lispobj* end, struct heap_adjust* adj)
 371 {
 372     lispobj *where = (lispobj*)start;
 373     lispobj header_word;
 374     int widetag;
 375     long nwords;
 376     lispobj layout, adjusted_layout, bitmap;
 377     struct code* code;
 378     sword_t delta;
 379
 380     for ( ; where < end ; where += nwords ) {
 381         header_word = *where;
 382         if (is_cons_half(header_word)) {
 383             adjust_pointers(where, 2, adj);
 384             nwords = 2;
 385             continue;
 386         }
 387         widetag = widetag_of(header_word);
 388         nwords = sizetab[widetag](where);
 389         switch (widetag) {
 390         case FUNCALLABLE_INSTANCE_WIDETAG:
 391             // Special note on the word at where[1] in funcallable instances:
 392             // - If no immobile code, then the word points to read-only space,
 393             ///  hence needs no adjustment.
 394             // - Otherwise, the word might point to a relocated range,
 395             //   either the instance itself, or a trampoline in immobile space.
 396             where[1] = adjust_word(adj, where[1]);
 397         case INSTANCE_WIDETAG:
 398             layout = (widetag == FUNCALLABLE_INSTANCE_WIDETAG) ?
 399                 funinstance_layout(where) : instance_layout(where);
 400             adjusted_layout = adjust_word(adj, layout);
 401             // Do not alter the layout as stored in the instance if non-compact
 402             // header. instance_scan() will do it if necessary.
 403 #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
 404             if (adjusted_layout != layout)
 405                 instance_layout(where) = adjusted_layout;
 406 #endif
 407             bitmap = LAYOUT(adjusted_layout)->bitmap;
 408             gc_assert(fixnump(bitmap)
 409                       || widetag_of(*native_pointer(bitmap))==BIGNUM_WIDETAG);
 410             // If the post-adjustment address of 'layout' is higher than 'where',
 411             // then the layout's pointer slots need adjusting.
 412             // This is true regardless of whether the core was mapped at a higher
 413             // or lower address than desired.
 414             if (is_lisp_pointer(bitmap) && adjusted_layout > (lispobj)where) {
 415                 // Do not write back the adjusted bitmap pointer. Each heap word
 416                 // must be touched at most once. When the layout itself gets scanned,
 417                 // the bitmap slot will be rewritten if needed.
 418                 bitmap = adjust_word(adj, bitmap);
 419             }
 420
 421             instance_scan((void(*)(lispobj*,sword_t,uword_t))adjust_pointers,
 422                           where+1, nwords-1, bitmap, (uintptr_t)adj);
 423             continue;
 424         case FDEFN_WIDETAG:
 425             adjust_pointers(where+1, 2, adj);
 426             // 'raw_addr' doesn't satisfy is_lisp_pointer() for x86,
 427             // so adjust_pointers() would ignore it. Therefore we need to
 428             // forcibly adjust it.
 429 #ifndef LISP_FEATURE_IMMOBILE_CODE
 430             where[3] = adjust_word(adj, where[3]);
 431 #elif defined(LISP_FEATURE_X86_64)
 432             // static space to immobile space JMP needs adjustment
 433             if (STATIC_SPACE_START <= (uintptr_t)where && (uintptr_t)where < STATIC_SPACE_END) {
 434                 delta = calc_adjustment(adj, fdefn_callee_lispobj((struct fdefn*)where));
 435                 if (delta != 0)
 436                     *(int*)(1+(char*)(where+3)) += delta;
 437             }
 438 #endif
 439             continue;
 440         case CODE_HEADER_WIDETAG:
 441             // Fixup the constant pool. The word at where+1 is a fixnum.
 442             adjust_pointers(where+2, code_header_words(header_word)-2, adj);
 443             // Fixup all embedded simple-funs
 444             code = (struct code*)where;
 445             for_each_simple_fun(i, f, code, 1, {
 446                 FIX_FUN_HEADER_LAYOUT((lispobj*)f);
 447                 f->self = adjust_word(adj, f->self);
 448                 adjust_pointers(SIMPLE_FUN_SCAV_START(f), SIMPLE_FUN_SCAV_NWORDS(f), adj);
 449             });
 450             // Compute the address where the code "was" as the first argument
 451             // by negating the adjustment for 'where'.
 452             // Can't call calc_adjustment to get the negative of the adjustment!
 453             gencgc_apply_code_fixups((struct code*)((char*)where - adj->range[1].delta),
 454                                      code);
 455 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 456             // Now that the packed integer comprising the list of fixup locations
 457             // has been fixed-up (if necessary), apply them to the code.
 458             if (code->fixups != 0)
 459                 adjust_code_refs(adj, code->fixups, code);
 460 #endif
 461             continue;
 462         case CLOSURE_WIDETAG:
 463             FIX_FUN_HEADER_LAYOUT(where);
 464 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 465             // For x86[-64], the closure fun appears to be a fixnum,
 466             // and might need adjustment unless pointing to immobile code.
 467             // Then fall into the general case; where[1] won't get re-adjusted
 468             // because it doesn't satisfy is_lisp_pointer().
 469             where[1] = adjust_word(adj, where[1]);
 470 #endif
 471             break;
 472         // Vectors require extra care because of EQ-based hashing.
 473         case SIMPLE_VECTOR_WIDETAG:
 474           if (is_vector_subtype(*where, VectorValidHashing)) {
 475               struct vector* v = (struct vector*)where;
 476               gc_assert(v->length > 0 &&
 477                         !(v->length & make_fixnum(1)) && // length must be even
 478                         lowtag_of(v->data[0]) == INSTANCE_POINTER_LOWTAG);
 479               lispobj* data = (lispobj*)v->data;
 480               adjust_pointers(&data[0], 1, adj); // adjust the hash-table structure
 481               boolean needs_rehash = 0;
 482               int i;
 483               // Adjust the elements, checking for need to rehash.
 484               // v->data[1] is the unbound marker (a non-pointer)
 485               for (i = fixnum_value(v->length)-1 ; i>=2 ; --i) {
 486                   lispobj ptr = data[i];
 487                   if (is_lisp_pointer(ptr) && (delta = calc_adjustment(adj, ptr)) != 0) {
 488                       data[i] += delta;
 489                       needs_rehash = 1;
 490                   }
 491               }
 492               if (needs_rehash)
 493                   data[1] = make_fixnum(1);
 494               continue;
 495           }
 496         // All the array header widetags.
 497         case SIMPLE_ARRAY_WIDETAG:
 498 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
 499         case COMPLEX_CHARACTER_STRING_WIDETAG:
 500 #endif
 501         case COMPLEX_BASE_STRING_WIDETAG:
 502         case COMPLEX_VECTOR_NIL_WIDETAG:
 503         case COMPLEX_BIT_VECTOR_WIDETAG:
 504         case COMPLEX_VECTOR_WIDETAG:
 505         case COMPLEX_ARRAY_WIDETAG:
 506         // And the rest of the purely descriptor objects.
 507         case SYMBOL_WIDETAG:
 508         case VALUE_CELL_WIDETAG:
 509         case WEAK_POINTER_WIDETAG:
 510         case RATIO_WIDETAG:
 511         case COMPLEX_WIDETAG:
 512             break;
 513
 514         // Other
 515         case SAP_WIDETAG:
 516             if ((delta = calc_adjustment(adj, where[1])) != 0) {
 517                 fprintf(stderr,
 518                         "WARNING: SAP at %p -> %p in relocatable core\n",
 519                         where, (void*)where[1]);
 520                 where[1] += delta;
 521             }
 522             continue;
 523         case BIGNUM_WIDETAG:
 524 #ifndef LISP_FEATURE_64_BIT
 525         case SINGLE_FLOAT_WIDETAG:
 526 #endif
 527         case DOUBLE_FLOAT_WIDETAG:
 528         case COMPLEX_SINGLE_FLOAT_WIDETAG:
 529         case COMPLEX_DOUBLE_FLOAT_WIDETAG:
 530 #ifdef SIMD_PACK_WIDETAG
 531         case SIMD_PACK_WIDETAG:
 532 #endif
 533             continue;
 534         default:
 535           if (other_immediate_lowtag_p(widetag)
 536               && specialized_vector_widetag_p(widetag))
 537               continue;
 538           else
 539               lose("Unrecognized heap object: @%p: %lx\n", where, header_word);
 540         }
 541         adjust_pointers(where+1, nwords-1, adj);
 542     }
 543 }
 544
 545 #define SHOW_SPACE_RELOCATION 0
 546 void relocate_heap(struct heap_adjust* adj)
 547 {
 548     if (SHOW_SPACE_RELOCATION) {
 549 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 550         fprintf(stderr, "Relocating immobile space from [%p:%p] to [%p:%p]\n",
 551                 (char*)adj->range[0].start,
 552                 (char*)adj->range[0].end,
 553                 (char*)FIXEDOBJ_SPACE_START,
 554                 (char*)FIXEDOBJ_SPACE_START+(adj->range[0].end-adj->range[0].start));
 555 #endif
 556         fprintf(stderr, "Relocating dynamic space from [%p:%p] to [%p:%p]\n",
 557                 (char*)adj->range[1].start,
 558                 (char*)adj->range[1].end,
 559                 (char*)DYNAMIC_SPACE_START,
 560                 (char*)DYNAMIC_SPACE_START+(adj->range[1].end-adj->range[1].start));
 561     }
 562     relocate_space(STATIC_SPACE_START, static_space_free_pointer, adj);
 563 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 564     relocate_space(FIXEDOBJ_SPACE_START, fixedobj_free_pointer, adj);
 565     relocate_space(VARYOBJ_SPACE_START, varyobj_free_pointer, adj);
 566     SYMBOL(FUNCTION_LAYOUT)->value = \
 567         adjust_word(adj, SYMBOL(FUNCTION_LAYOUT)->value >> 32) << 32;
 568 #endif
 569     relocate_space(DYNAMIC_SPACE_START, (lispobj*)get_alloc_pointer(), adj);
 570 }
 571 #endif
 572
 573 int merge_core_pages = -1;
 574
 575 static void
 576 process_directory(int count, struct ndir_entry *entry,
 577                   int fd, os_vm_offset_t file_offset,
 578                   struct heap_adjust* adj)
 579 {
 580     extern void immobile_space_coreparse(uword_t,uword_t);
 581
 582     struct {
 583         size_t desired_size; // size wanted, ORed with 1 if addr must be <2GB
 584         // Values from the core file:
 585         uword_t len; // length in bytes, as an integral multiple of os_vm_page_size
 586         uword_t base;
 587         lispobj** pfree_pointer; // pointer to x_free_pointer
 588     } spaces[MAX_CORE_SPACE_ID+1] = {
 589         {0, 0, 0, 0}, // blank for space ID 0
 590 #ifdef LISP_FEATURE_GENCGC
 591         {dynamic_space_size, 0, DYNAMIC_SPACE_START, 0},
 592 #else
 593         {0, 0, 0, 0},
 594 #endif
 595         // This order is determined by constants in compiler/generic/genesis
 596         {0, 0, STATIC_SPACE_START, &static_space_free_pointer},
 597         {0, 0, READ_ONLY_SPACE_START, &read_only_space_free_pointer},
 598 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 599         {(FIXEDOBJ_SPACE_SIZE+VARYOBJ_SPACE_SIZE) | 1, 0,
 600             FIXEDOBJ_SPACE_START, &fixedobj_free_pointer},
 601         {1, 0, VARYOBJ_SPACE_START, &varyobj_free_pointer}
 602 #endif
 603     };
 604
 605     for ( ; --count>= 0; ++entry) {
 606         sword_t id = entry->identifier;
 607         uword_t addr = (1024 * entry->address); // multiplier as per core.h
 608         int compressed = id & DEFLATED_CORE_SPACE_ID_FLAG;
 609         id -= compressed;
 610         if (id < 1 || id > MAX_CORE_SPACE_ID)
 611             lose("unknown space ID %ld addr %p\n", id, addr);
 612
 613 #ifndef LISP_FEATURE_RELOCATABLE_HEAP
 614         int enforce_address = 1;
 615 #elif defined(LISP_FEATURE_IMMOBILE_SPACE)
 616         // Enforce address of readonly, static, immobile varyobj
 617         int enforce_address = id != DYNAMIC_CORE_SPACE_ID
 618           && id != IMMOBILE_FIXEDOBJ_CORE_SPACE_ID
 619           && id != IMMOBILE_VARYOBJ_CORE_SPACE_ID;
 620 #else
 621         // Enforce address of readonly and static spaces.
 622         int enforce_address = id != DYNAMIC_CORE_SPACE_ID;
 623 #endif
 624         if (enforce_address) {
 625             int fail;
 626 #ifdef LISP_FEATURE_CHENEYGC
 627             if (id == DYNAMIC_CORE_SPACE_ID) {
 628                 if ((fail = (addr != DYNAMIC_0_SPACE_START) &&
 629                             (addr != DYNAMIC_1_SPACE_START)) != 0)
 630                     fprintf(stderr, "in core: %p; in runtime: %p or %p\n",
 631                             (void*)addr,
 632                             (void*)DYNAMIC_0_SPACE_START,
 633                             (void*)DYNAMIC_1_SPACE_START);
 634             } else
 635 #endif
 636             if ((fail = (addr != spaces[id].base)) != 0)
 637                 fprintf(stderr, "in core: %p; in runtime: %p\n",
 638                         (void*)addr, (void*)spaces[id].base);
 639             char *names[] = {
 640               "DYNAMIC", "STATIC", "READ_ONLY", "IMMOBILE", "IMMOBILE"
 641             };
 642             if (fail)
 643                 lose("core/runtime address mismatch: %s_SPACE_START", names[id-1]);
 644         }
 645         spaces[id].base = addr;
 646         uword_t len = os_vm_page_size * entry->page_count;
 647         spaces[id].len = len;
 648         if (id == DYNAMIC_CORE_SPACE_ID && len > dynamic_space_size) {
 649             lose("dynamic space too small for core: %luKiB required, %luKiB available.\n",
 650                  (unsigned long)len >> 10,
 651                  (unsigned long)dynamic_space_size >> 10);
 652         }
 653         if (len != 0) {
 654             uword_t __attribute__((unused)) aligned_start;
 655 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
 656             // Try to map at address requested by the core file.
 657             size_t request = spaces[id].desired_size;
 658             int sub_2gb_flag = (request & 1);
 659             request &= ~(size_t)1;
 660 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 661             if (id == IMMOBILE_VARYOBJ_CORE_SPACE_ID)
 662                 // Pretend an os_validate() happened based on the address that
 663                 // would be obtained by a constant offset from fixedobj space
 664                 addr = FIXEDOBJ_SPACE_START + FIXEDOBJ_SPACE_SIZE;
 665             else
 666 #endif
 667             if (request)
 668                 addr = (uword_t)os_validate(sub_2gb_flag ? MOVABLE_LOW : MOVABLE,
 669                                             (os_vm_address_t)addr, request);
 670             switch (id) {
 671 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 672             case IMMOBILE_FIXEDOBJ_CORE_SPACE_ID:
 673             case IMMOBILE_VARYOBJ_CORE_SPACE_ID:
 674                 if (addr + request > 0x80000000)
 675                     lose("Won't map immobile space above 2GB");
 676                 if (id == IMMOBILE_FIXEDOBJ_CORE_SPACE_ID)
 677                     FIXEDOBJ_SPACE_START = addr;
 678                 else
 679                     VARYOBJ_SPACE_START = addr;
 680                 break;
 681 #endif
 682             case DYNAMIC_CORE_SPACE_ID:
 683                 aligned_start = ALIGN_UP(addr, GENCGC_CARD_BYTES);
 684                 /* Misalignment can happen only if card size exceeds OS page.
 685                  * Drop one card to avoid overrunning the allocated space */
 686                 if (aligned_start > addr) // not card-aligned
 687                     dynamic_space_size -= GENCGC_CARD_BYTES;
 688 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 689                 // FIXME: is this invariant still needed?
 690                 if (addr < FIXEDOBJ_SPACE_START || addr < VARYOBJ_SPACE_START)
 691                     lose("Won't map dynamic space below immobile space");
 692 #endif
 693                 DYNAMIC_SPACE_START = addr = aligned_start;
 694                 break;
 695             }
 696 #endif /* LISP_FEATURE_RELOCATABLE_HEAP */
 697
 698             sword_t offset = os_vm_page_size * (1 + entry->data_page);
 699             if (compressed)
 700                 inflate_core_bytes(fd, offset + file_offset, (os_vm_address_t)addr, len);
 701             else
 702                 load_core_bytes(fd, offset + file_offset, (os_vm_address_t)addr, len);
 703         }
 704
 705 #ifdef MADV_MERGEABLE
 706         if ((merge_core_pages == 1)
 707             || ((merge_core_pages == -1) && compressed)) {
 708             madvise((void *)addr, len, MADV_MERGEABLE);
 709         }
 710 #endif
 711
 712         lispobj *free_pointer = (lispobj *) addr + entry->nwords;
 713         switch (id) {
 714         default:
 715             *spaces[id].pfree_pointer = free_pointer;
 716             break;
 717         case DYNAMIC_CORE_SPACE_ID:
 718 #ifdef LISP_FEATURE_CHENEYGC
 719             /* 'addr' is the actual address if relocatable.
 720              * For cheneygc, this will be whatever the GC was using
 721              * at the time the core was saved.
 722              * For gencgc this is #defined as DYNAMIC_SPACE_START */
 723             current_dynamic_space = (lispobj *)addr;
 724 #endif
 725             set_alloc_pointer((lispobj)free_pointer);
 726
 727             anon_dynamic_space_start = (os_vm_address_t)(addr + len);
 728             /* This assertion safeguards the test in zero_pages_with_mmap()
 729              * which trusts that if addr > anon_dynamic_space_start
 730              * then addr did not come from any file mapping. */
 731             gc_assert((lispobj)anon_dynamic_space_start > STATIC_SPACE_END);
 732         }
 733     }
 734
 735 #ifdef LISP_FEATURE_RELOCATABLE_HEAP
 736 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 737     if (FIXEDOBJ_SPACE_START != spaces[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID].base) {
 738         adj->range[0].start = spaces[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID].base;
 739         adj->range[0].end   = adj->range[0].start + FIXEDOBJ_SPACE_SIZE
 740             + spaces[IMMOBILE_VARYOBJ_CORE_SPACE_ID].len;
 741         adj->range[0].delta = FIXEDOBJ_SPACE_START - adj->range[0].start;
 742     }
 743 #endif
 744     if (DYNAMIC_SPACE_START != spaces[DYNAMIC_CORE_SPACE_ID].base) {
 745         adj->range[1].start = spaces[DYNAMIC_CORE_SPACE_ID].base;
 746         adj->range[1].end   = adj->range[1].start + spaces[DYNAMIC_CORE_SPACE_ID].len;
 747         adj->range[1].delta = DYNAMIC_SPACE_START - adj->range[1].start;
 748     }
 749     if (adj->range[0].delta | adj->range[1].delta)
 750         relocate_heap(adj);
 751 #endif
 752
 753 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 754     /* Now determine page characteristics (such as object spacing)
 755      * after relocation, because we need to know which objects are layouts
 756      * based on knowing layout-of-layout.  The test for that is dependent
 757      * on what it's address should be, not what it was in the file */
 758     immobile_space_coreparse(spaces[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID].len,
 759                              spaces[IMMOBILE_VARYOBJ_CORE_SPACE_ID].len);
 760     /* Suppose we have:
 761      *   A               B                             C                D
 762      *   | varyobj space | .... other random stuff ... | fixedobj space | ...
 763      * then the lower bound is A, the upper bound is D,
 764      * the max_offset is the distance from A to D,
 765      * and the excluded middle is the range spanned by B to C.
 766      */
 767     struct range {
 768         uword_t start, end;
 769     };
 770     struct range range1 =
 771         {FIXEDOBJ_SPACE_START, FIXEDOBJ_SPACE_START + FIXEDOBJ_SPACE_SIZE};
 772     struct range range2 =
 773         {VARYOBJ_SPACE_START, VARYOBJ_SPACE_START + VARYOBJ_SPACE_SIZE};
 774     if (range2.start < range1.start) { // swap
 775         struct range temp = range1;
 776         range1 = range2;
 777         range2 = temp;
 778     }
 779     immobile_space_lower_bound  = range1.start;
 780     immobile_space_max_offset   = range2.end - range1.start;
 781     immobile_range_1_max_offset = range1.end - range1.start;
 782     immobile_range_2_min_offset = range2.start - range1.start;
 783 #endif
 784 #ifdef LISP_FEATURE_X86_64
 785     tune_asm_routines_for_microarch(); // before WPing immobile space
 786 #endif
 787 }
 788
 789 lispobj
 790 load_core_file(char *file, os_vm_offset_t file_offset)
 791 {
 792     void *header;
 793     core_entry_elt_t val, *ptr;
 794     os_vm_size_t len, remaining_len;
 795     int fd = open_binary(file, O_RDONLY);
 796     ssize_t count;
 797     lispobj initial_function = NIL;
 798     struct heap_adjust adj;
 799     memset(&adj, 0, sizeof adj);
 800
 801     FSHOW((stderr, "/entering load_core_file(%s)\n", file));
 802     if (fd < 0) {
 803         fprintf(stderr, "could not open file \"%s\"\n", file);
 804         perror("open");
 805         exit(1);
 806     }
 807
 808     lseek(fd, file_offset, SEEK_SET);
 809     header = calloc(os_vm_page_size, 1);
 810
 811     count = read(fd, header, os_vm_page_size);
 812     if (count < (ssize_t) os_vm_page_size) {
 813         lose("premature end of core file\n");
 814     }
 815     SHOW("successfully read first page of core");
 816
 817     ptr = header;
 818     val = *ptr++;
 819
 820     if (val != CORE_MAGIC) {
 821         lose("invalid magic number in core: 0x%lx should have been 0x%x.\n",
 822              val,
 823              CORE_MAGIC);
 824     }
 825     SHOW("found CORE_MAGIC");
 826
 827 #define WORD_FMTX OS_VM_SIZE_FMTX
 828     for ( ; ; ptr += remaining_len) {
 829         val = *ptr++;
 830         len = *ptr++;
 831         remaining_len = len - 2; /* (-2 to cancel the two ++ operations) */
 832         FSHOW((stderr, "/val=0x%"WORD_FMTX", remaining_len=0x%"WORD_FMTX"\n",
 833                val, remaining_len));
 834
 835         switch (val) {
 836
 837         case END_CORE_ENTRY_TYPE_CODE:
 838             free(header);
 839             close(fd);
 840             return initial_function;
 841
 842         case BUILD_ID_CORE_ENTRY_TYPE_CODE:
 843             SHOW("BUILD_ID_CORE_ENTRY_TYPE_CODE case");
 844             {
 845                 os_vm_size_t stringlen = *ptr++;
 846                 --remaining_len;
 847                 gc_assert(remaining_len * sizeof (core_entry_elt_t) >= stringlen);
 848                 if (sizeof build_id == stringlen+1 && !memcmp(ptr, build_id, stringlen))
 849                     break;
 850                 /* .core files are not binary-compatible between
 851                  * builds because we can't easily detect whether the
 852                  * sources were patched between the time the
 853                  * dumping-the-.core runtime was built and the time
 854                  * that the loading-the-.core runtime was built.
 855                  *
 856                  * (We could easily detect whether version.lisp-expr
 857                  * was changed, but people experimenting with patches
 858                  * don't necessarily update version.lisp-expr.) */
 859                 fprintf(stderr,
 860                         "core was built for runtime \"%.*s\" but this is \"%s\"\n",
 861                         (int)stringlen, (char*)ptr, build_id);
 862                 lose("can't load .core for different runtime, sorry\n");
 863             }
 864
 865         case NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE:
 866             SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case");
 867             process_directory(remaining_len / NDIR_ENTRY_LENGTH,
 868                               (struct ndir_entry*)ptr, fd, file_offset,
 869                               &adj);
 870             break;
 871
 872         case INITIAL_FUN_CORE_ENTRY_TYPE_CODE:
 873             SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case");
 874             initial_function = adjust_word(&adj, (lispobj)*ptr);
 875             break;
 876
 877 #ifdef LISP_FEATURE_GENCGC
 878         case PAGE_TABLE_CORE_ENTRY_TYPE_CODE:
 879         {
 880             extern void gc_allocate_ptes();
 881             extern boolean gc_load_corefile_ptes(char data[], ssize_t,
 882                                                  page_index_t, page_index_t*);
 883             // Allocation of PTEs is delayed 'til now so that calloc() doesn't
 884             // consume addresses that would have been taken by a mapped space.
 885             gc_allocate_ptes();
 886             os_vm_size_t remaining = *ptr;
 887             os_vm_size_t fdoffset = (*(ptr+1) + 1) * (os_vm_page_size);
 888             page_index_t page = 0, npages;
 889             ssize_t bytes_read;
 890             char data[8192];
 891             // A corefile_pte is 10 bytes for x86-64
 892             // Process an integral number of ptes on each read.
 893             os_vm_size_t chunksize = sizeof (struct corefile_pte)
 894                 * (sizeof data / sizeof (struct corefile_pte));
 895             lseek(fd, fdoffset + file_offset, SEEK_SET);
 896             bytes_read = read(fd, &npages, sizeof npages);
 897             gc_assert(bytes_read == sizeof npages);
 898             remaining -= sizeof npages;
 899             while ((bytes_read = read(fd, data,
 900                                       remaining < chunksize ? remaining : chunksize)) > 0
 901                    && gc_load_corefile_ptes(data, bytes_read, npages, &page))
 902                 remaining -= bytes_read;
 903
 904             gencgc_partial_pickup = 1;
 905             break;
 906         }
 907 #endif
 908         default:
 909             lose("unknown core file entry: 0x%"WORD_FMTX"\n", val);
 910         }
 911     }
 912 }
 913
 914 #include "genesis/hash-table.h"
 915 #include "genesis/vector.h"
 916 #include "genesis/cons.h"
 917 os_vm_address_t get_asm_routine_by_name(const char* name)
 918 {
 919 #ifdef LISP_FEATURE_IMMOBILE_CODE
 920     struct code* code = (struct code*)VARYOBJ_SPACE_START;
 921 #else
 922     struct code* code = (struct code*)READ_ONLY_SPACE_START;
 923 #endif
 924     if (lowtag_of(code->debug_info) == LIST_POINTER_LOWTAG) {
 925         struct hash_table* ht =
 926             (struct hash_table*)native_pointer(CONS(code->debug_info)->car);
 927         struct vector* table = VECTOR(ht->table);
 928         lispobj sym;
 929         int i;
 930         for (i=2 ; i < fixnum_value(table->length) ; i += 2)
 931             if (lowtag_of(sym = table->data[i]) == OTHER_POINTER_LOWTAG
 932                 && widetag_of(SYMBOL(sym)->header) == SYMBOL_WIDETAG
 933                 && !strcmp(name, (char*)(VECTOR(SYMBOL(sym)->name)->data)))
 934                 return ALIGN_UP(offsetof(struct code,constants), 2*N_WORD_BYTES)
 935                     + fixnum_value(CONS(table->data[i+1])->car) + (os_vm_address_t)code;
 936         // Something is wrong if we have a hashtable but find nothing.
 937         fprintf(stderr, "WARNING: get_asm_routine_by_name(%s) failed\n",
 938                 name);
 939     }
 940     return NULL;
 941 }
 942
 943 void asm_routine_poke(const char* routine, int offset, char byte)
 944 {
 945     char *address = (char *)get_asm_routine_by_name(routine);
 946     if (address)
 947         address[offset] = byte;
 948 }