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 <stdio.h>
  18 #include <stdlib.h>
  19 #include <string.h>
  20 #include <sys/file.h>
  21 #include <sys/types.h>
  22 #include <sys/stat.h>
  23 #include <fcntl.h>
  24 #include <unistd.h>
  25
  26 #include "sbcl.h"
  27 #include "os.h"
  28 #include "runtime.h"
  29 #include "globals.h"
  30 #include "core.h"
  31 #include "arch.h"
  32 #include "interr.h"
  33 #include "thread.h"
  34
  35 #include "validate.h"
  36 #include "gc-internal.h"
  37
  38 /* lutex stuff */
  39 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
  40 #include "genesis/sap.h"
  41 #include "pthread-lutex.h"
  42 #endif
  43
  44 #include <errno.h>
  45
  46 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
  47 # include <zlib.h>
  48 #endif
  49
  50 unsigned char build_id[] =
  51 #include "../../output/build-id.tmp"
  52 ;
  53
  54 int
  55 open_binary(char *filename, int mode)
  56 {
  57 #ifdef LISP_FEATURE_WIN32
  58     mode |= O_BINARY;
  59 #endif
  60
  61     return open(filename, mode);
  62 }
  63
  64
  65 static struct runtime_options *
  66 read_runtime_options(int fd)
  67 {
  68     size_t optarray[RUNTIME_OPTIONS_WORDS];
  69     struct runtime_options *options = NULL;
  70
  71     if (read(fd, optarray, RUNTIME_OPTIONS_WORDS * sizeof(size_t)) !=
  72         RUNTIME_OPTIONS_WORDS * sizeof(size_t)) {
  73         return NULL;
  74     }
  75
  76     if ((RUNTIME_OPTIONS_MAGIC != optarray[0]) || (0 == optarray[1])) {
  77         return NULL;
  78     }
  79
  80     options = successful_malloc(sizeof(struct runtime_options));
  81
  82     options->dynamic_space_size = optarray[2];
  83     options->thread_control_stack_size = optarray[3];
  84
  85     return options;
  86 }
  87
  88 void
  89 maybe_initialize_runtime_options(int fd)
  90 {
  91     struct runtime_options *new_runtime_options;
  92     off_t end_offset = sizeof(lispobj) +
  93         sizeof(os_vm_offset_t) +
  94         (RUNTIME_OPTIONS_WORDS * sizeof(size_t));
  95
  96     lseek(fd, -end_offset, SEEK_END);
  97
  98     if (new_runtime_options = read_runtime_options(fd)) {
  99         runtime_options = new_runtime_options;
 100     }
 101 }
 102
 103 /* Search 'filename' for an embedded core.  An SBCL core has, at the
 104  * end of the file, a trailer containing optional saved runtime
 105  * options, the start of the core (an os_vm_offset_t), and a final
 106  * signature word (the lispobj CORE_MAGIC).  If this trailer is found
 107  * at the end of the file, the start of the core can be determined
 108  * from the core size.
 109  *
 110  * If an embedded core is present, this returns the offset into the
 111  * file to load the core from, or -1 if no core is present. */
 112 os_vm_offset_t
 113 search_for_embedded_core(char *filename)
 114 {
 115     lispobj header;
 116     os_vm_offset_t lispobj_size = sizeof(lispobj);
 117     os_vm_offset_t trailer_size = lispobj_size + sizeof(os_vm_offset_t);
 118     os_vm_offset_t core_start, pos;
 119     int fd = -1;
 120
 121     if ((fd = open_binary(filename, O_RDONLY)) < 0)
 122         goto lose;
 123
 124     if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 125         goto lose;
 126     if (header == CORE_MAGIC) {
 127         /* This file is a real core, not an embedded core.  Return 0 to
 128          * indicate where the core starts, and do not look for runtime
 129          * options in this case. */
 130         return 0;
 131     }
 132
 133     if (lseek(fd, -lispobj_size, SEEK_END) < 0)
 134         goto lose;
 135     if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 136         goto lose;
 137
 138     if (header == CORE_MAGIC) {
 139         if (lseek(fd, -trailer_size, SEEK_END) < 0)
 140             goto lose;
 141         if (read(fd, &core_start, sizeof(os_vm_offset_t)) < 0)
 142             goto lose;
 143
 144         if (lseek(fd, core_start, SEEK_SET) < 0)
 145             goto lose;
 146         pos = lseek(fd, 0, SEEK_CUR);
 147
 148         if (read(fd, &header, (size_t)lispobj_size) < lispobj_size)
 149             goto lose;
 150
 151         if (header != CORE_MAGIC)
 152             goto lose;
 153
 154         maybe_initialize_runtime_options(fd);
 155
 156         close(fd);
 157         return pos;
 158     }
 159
 160 lose:
 161     if (fd != -1)
 162         close(fd);
 163
 164     return -1;
 165 }
 166
 167 /* If more platforms doesn't support overlapping mmap rename this
 168  * def to something like ifdef nommapoverlap */
 169 /* currently hpux only */
 170 #ifdef LISP_FEATURE_HPUX
 171 os_vm_address_t copy_core_bytes(int fd, os_vm_offset_t offset,
 172                                 os_vm_address_t addr, int len)
 173 {
 174   unsigned char buf[4096];
 175   int c,x;
 176   int old_fd = lseek(fd, 0, SEEK_CUR);
 177
 178   if(len & (4096-1)){
 179     fprintf(stderr, "cant copy a slice of core because slice-length is not of page size(4096)\n");
 180     exit(-1);
 181   }
 182   if(old_fd < 0){
 183     fprintf(stderr, "cant perform lseek() on corefile\n");
 184   }
 185   lseek(fd, offset, SEEK_SET);
 186   if(fd < 0){
 187     fprintf(stderr, "cant perform lseek(%u,%lu,SEEK_SET) on corefile\n", fd, offset);
 188   }
 189   for(x = 0; x < len; x += 4096){
 190     c = read(fd, buf, 4096);
 191     if(c != 4096){
 192       fprintf(stderr, "cant read memory area from corefile at position %lu, got %d\n", offset + x, c);
 193       exit(-1);
 194     }
 195     memcpy(addr+x, buf, 4096);
 196   }
 197   os_flush_icache(addr, len);
 198   return addr;
 199 }
 200 #endif
 201
 202 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
 203 # define ZLIB_BUFFER_SIZE (1u<<16)
 204 os_vm_address_t inflate_core_bytes(int fd, os_vm_offset_t offset,
 205                                    os_vm_address_t addr, int len)
 206 {
 207     z_stream stream;
 208     unsigned char buf[ZLIB_BUFFER_SIZE];
 209     int ret;
 210
 211     if (-1 == lseek(fd, offset, SEEK_SET)) {
 212         lose("Unable to lseek() on corefile\n");
 213     }
 214
 215     stream.zalloc = NULL;
 216     stream.zfree = NULL;
 217     stream.opaque = NULL;
 218     stream.avail_in = 0;
 219     stream.next_in = buf;
 220
 221     ret = inflateInit(&stream);
 222     if (ret != Z_OK)
 223         lose("zlib error %i\n", ret);
 224
 225     stream.next_out  = (void*)addr;
 226     stream.avail_out = len;
 227     do {
 228         ssize_t count = read(fd, buf, sizeof(buf));
 229         if (count < 0)
 230             lose("unable to read core file (errno = %i)\n", errno);
 231         stream.next_in = buf;
 232         stream.avail_in = count;
 233         if (count == 0) break;
 234         ret = inflate(&stream, Z_NO_FLUSH);
 235         switch (ret) {
 236         case Z_STREAM_END:
 237             break;
 238         case Z_OK:
 239             if (stream.avail_out == 0)
 240                 lose("Runaway gzipped core directory... aborting\n");
 241             if (stream.avail_in > 0)
 242                 lose("zlib inflate returned without fully"
 243                      "using up input buffer... aborting\n");
 244             break;
 245         default:
 246             lose("zlib inflate error: %i\n", ret);
 247             break;
 248         }
 249     } while (ret != Z_STREAM_END);
 250
 251     if (stream.avail_out > 0) {
 252         if (stream.avail_out >= os_vm_page_size)
 253             fprintf(stderr, "Warning: gzipped core directory significantly"
 254                     "shorter than expected (%lu bytes)", (unsigned long)stream.avail_out);
 255         /* Is this needed? */
 256         memset(stream.next_out, 0, stream.avail_out);
 257     }
 258
 259     inflateEnd(&stream);
 260     return addr;
 261 }
 262 # undef ZLIB_BUFFER_SIZE
 263 #endif
 264
 265 static void
 266 process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset)
 267 {
 268     struct ndir_entry *entry;
 269     int compressed;
 270
 271     FSHOW((stderr, "/process_directory(..), count=%d\n", count));
 272
 273     for (entry = (struct ndir_entry *) ptr; --count>= 0; ++entry) {
 274         compressed = 0;
 275         long id = entry->identifier;
 276         if (id <= (MAX_CORE_SPACE_ID | DEFLATED_CORE_SPACE_ID_FLAG)) {
 277             if (id & DEFLATED_CORE_SPACE_ID_FLAG)
 278                 compressed = 1;
 279             id &= ~(DEFLATED_CORE_SPACE_ID_FLAG);
 280         }
 281         long offset = os_vm_page_size * (1 + entry->data_page);
 282         os_vm_address_t addr =
 283             (os_vm_address_t) (os_vm_page_size * entry->address);
 284         lispobj *free_pointer = (lispobj *) addr + entry->nwords;
 285         unsigned long len = os_vm_page_size * entry->page_count;
 286         if (len != 0) {
 287             os_vm_address_t real_addr;
 288             FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n",
 289                    (long)len, (long)len, (unsigned long)addr));
 290             if (compressed) {
 291 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
 292                 real_addr = inflate_core_bytes(fd, offset + file_offset, addr, len);
 293 #else
 294                 lose("This runtime was not built with zlib-compressed core support... aborting\n");
 295 #endif
 296             } else {
 297 #ifdef LISP_FEATURE_HPUX
 298                 real_addr = copy_core_bytes(fd, offset + file_offset, addr, len);
 299 #else
 300                 real_addr = os_map(fd, offset + file_offset, addr, len);
 301 #endif
 302             }
 303             if (real_addr != addr) {
 304                 lose("file mapped in wrong place! "
 305                      "(0x%08x != 0x%08lx)\n",
 306                      real_addr,
 307                      addr);
 308             }
 309         }
 310
 311         FSHOW((stderr, "/space id = %ld, free pointer = 0x%lx\n",
 312                id, (unsigned long)free_pointer));
 313
 314         switch (id) {
 315         case DYNAMIC_CORE_SPACE_ID:
 316             if (len > dynamic_space_size) {
 317                 fprintf(stderr,
 318                         "dynamic space too small for core: %ldKiB required, %ldKiB available.\n",
 319                         len >> 10,
 320                         (long)dynamic_space_size >> 10);
 321                 exit(1);
 322             }
 323 #ifdef LISP_FEATURE_GENCGC
 324             if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) {
 325                 fprintf(stderr, "in core: 0x%lx; in runtime: 0x%lx \n",
 326                         (long)addr, (long)DYNAMIC_SPACE_START);
 327                 lose("core/runtime address mismatch: DYNAMIC_SPACE_START\n");
 328             }
 329 #else
 330             if ((addr != (os_vm_address_t)DYNAMIC_0_SPACE_START) &&
 331                 (addr != (os_vm_address_t)DYNAMIC_1_SPACE_START)) {
 332                 fprintf(stderr, "in core: 0x%lx; in runtime: 0x%lx or 0x%lx\n",
 333                         (long)addr,
 334                         (long)DYNAMIC_0_SPACE_START,
 335                         (long)DYNAMIC_1_SPACE_START);
 336                 lose("warning: core/runtime address mismatch: DYNAMIC_SPACE_START\n");
 337             }
 338 #endif
 339 #if defined(ALLOCATION_POINTER)
 340             SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer,0);
 341 #else
 342             dynamic_space_free_pointer = free_pointer;
 343 #endif
 344             /* For stop-and-copy GC, this will be whatever the GC was
 345              * using at the time. With GENCGC, this will always be
 346              * space 0. (We checked above that for GENCGC,
 347              * addr==DYNAMIC_SPACE_START.) */
 348             current_dynamic_space = (lispobj *)addr;
 349             break;
 350         case STATIC_CORE_SPACE_ID:
 351             if (addr != (os_vm_address_t)STATIC_SPACE_START) {
 352                 fprintf(stderr, "in core: 0x%lx - in runtime: 0x%lx\n",
 353                         (long)addr, (long)STATIC_SPACE_START);
 354                 lose("core/runtime address mismatch: STATIC_SPACE_START\n");
 355             }
 356             break;
 357         case READ_ONLY_CORE_SPACE_ID:
 358             if (addr != (os_vm_address_t)READ_ONLY_SPACE_START) {
 359                 fprintf(stderr, "in core: 0x%lx - in runtime: 0x%lx\n",
 360                         (long)addr, (long)READ_ONLY_SPACE_START);
 361                 lose("core/runtime address mismatch: READ_ONLY_SPACE_START\n");
 362             }
 363             break;
 364         default:
 365             lose("unknown space ID %ld addr 0x%lx\n", id, (long)addr);
 366         }
 367     }
 368 }
 369
 370 lispobj
 371 load_core_file(char *file, os_vm_offset_t file_offset)
 372 {
 373     lispobj *header, val, len, *ptr, remaining_len;
 374     int fd = open_binary(file, O_RDONLY);
 375     unsigned int count;
 376
 377     lispobj initial_function = NIL;
 378     FSHOW((stderr, "/entering load_core_file(%s)\n", file));
 379     if (fd < 0) {
 380         fprintf(stderr, "could not open file \"%s\"\n", file);
 381         perror("open");
 382         exit(1);
 383     }
 384
 385     lseek(fd, file_offset, SEEK_SET);
 386     header = calloc(os_vm_page_size / sizeof(u32), sizeof(u32));
 387
 388     count = read(fd, header, os_vm_page_size);
 389     if (count < os_vm_page_size) {
 390         lose("premature end of core file\n");
 391     }
 392     SHOW("successfully read first page of core");
 393
 394     ptr = header;
 395     val = *ptr++;
 396
 397     if (val != CORE_MAGIC) {
 398         lose("invalid magic number in core: 0x%lx should have been 0x%x.\n",
 399              val,
 400              CORE_MAGIC);
 401     }
 402     SHOW("found CORE_MAGIC");
 403
 404     while (val != END_CORE_ENTRY_TYPE_CODE) {
 405         val = *ptr++;
 406         len = *ptr++;
 407         remaining_len = len - 2; /* (-2 to cancel the two ++ operations) */
 408         FSHOW((stderr, "/val=0x%ld, remaining_len=0x%ld\n",
 409                (long)val, (long)remaining_len));
 410
 411         switch (val) {
 412
 413         case END_CORE_ENTRY_TYPE_CODE:
 414             SHOW("END_CORE_ENTRY_TYPE_CODE case");
 415             break;
 416
 417         case VERSION_CORE_ENTRY_TYPE_CODE:
 418             SHOW("VERSION_CORE_ENTRY_TYPE_CODE case");
 419             if (*ptr != SBCL_CORE_VERSION_INTEGER) {
 420                 lose("core file version (%d) != runtime library version (%d)\n",
 421                      *ptr,
 422                      SBCL_CORE_VERSION_INTEGER);
 423             }
 424             break;
 425
 426         case BUILD_ID_CORE_ENTRY_TYPE_CODE:
 427             SHOW("BUILD_ID_CORE_ENTRY_TYPE_CODE case");
 428             {
 429                 unsigned int i;
 430
 431                 FSHOW((stderr, "build_id[]=\"%s\"\n", build_id));
 432                 FSHOW((stderr, "remaining_len = %d\n", remaining_len));
 433                 if (remaining_len != strlen((const char *)build_id))
 434                     goto losing_build_id;
 435                 for (i = 0; i < remaining_len; ++i) {
 436                     FSHOW((stderr, "ptr[%d] = char = %d, expected=%d\n",
 437                            i, ptr[i], build_id[i]));
 438                     if (ptr[i] != build_id[i])
 439                         goto losing_build_id;
 440                 }
 441                 break;
 442             losing_build_id:
 443                 /* .core files are not binary-compatible between
 444                  * builds because we can't easily detect whether the
 445                  * sources were patched between the time the
 446                  * dumping-the-.core runtime was built and the time
 447                  * that the loading-the-.core runtime was built.
 448                  *
 449                  * (We could easily detect whether version.lisp-expr
 450                  * was changed, but people experimenting with patches
 451                  * don't necessarily update version.lisp-expr.) */
 452
 453                 lose("can't load .core for different runtime, sorry\n");
 454             }
 455
 456         case NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE:
 457             SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case");
 458             process_directory(fd,
 459                               ptr,
 460 #ifndef LISP_FEATURE_ALPHA
 461                               remaining_len / (sizeof(struct ndir_entry) /
 462                                                sizeof(long)),
 463 #else
 464                               remaining_len / (sizeof(struct ndir_entry) /
 465                                                sizeof(u32)),
 466 #endif
 467                               file_offset);
 468             break;
 469
 470         case INITIAL_FUN_CORE_ENTRY_TYPE_CODE:
 471             SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case");
 472             initial_function = (lispobj)*ptr;
 473             break;
 474
 475 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
 476         case LUTEX_TABLE_CORE_ENTRY_TYPE_CODE:
 477             SHOW("LUTEX_TABLE_CORE_ENTRY_TYPE_CODE case");
 478             {
 479                 size_t n_lutexes = *ptr;
 480                 size_t fdoffset = (*(ptr + 1) + 1) * (os_vm_page_size);
 481                 size_t data_length = n_lutexes * sizeof(struct sap *);
 482                 struct lutex **lutexes_to_resurrect = malloc(data_length);
 483                 long bytes_read;
 484
 485                 lseek(fd, fdoffset + file_offset, SEEK_SET);
 486
 487                 FSHOW((stderr, "attempting to read %ld lutexes from core\n", n_lutexes));
 488                 bytes_read = read(fd, lutexes_to_resurrect, data_length);
 489
 490                 /* XXX */
 491                 if (bytes_read != data_length) {
 492                     lose("Could not read the lutex table");
 493                 }
 494                 else {
 495                     int i;
 496
 497                     for (i=0; i<n_lutexes; ++i) {
 498                         struct lutex *lutex = lutexes_to_resurrect[i];
 499
 500                         FSHOW((stderr, "re-init'ing lutex @ %p\n", lutex));
 501                         lutex_init((tagged_lutex_t) lutex);
 502                     }
 503
 504                     free(lutexes_to_resurrect);
 505                 }
 506                 break;
 507             }
 508 #endif
 509
 510 #ifdef LISP_FEATURE_GENCGC
 511         case PAGE_TABLE_CORE_ENTRY_TYPE_CODE:
 512         {
 513             size_t size = *ptr;
 514             size_t fdoffset = (*(ptr+1) + 1) * (os_vm_page_size);
 515             size_t offset = 0;
 516             long bytes_read;
 517             unsigned long data[4096];
 518             unsigned long word;
 519             lseek(fd, fdoffset + file_offset, SEEK_SET);
 520             while ((bytes_read = read(fd, data, (size < 4096 ? size : 4096 )))
 521                     > 0)
 522             {
 523                 int i = 0;
 524                 size -= bytes_read;
 525                 while (bytes_read) {
 526                     bytes_read -= sizeof(long);
 527                     /* Ignore all zeroes. The size of the page table
 528                      * core entry was rounded up to os_vm_page_size
 529                      * during the save, and might now have more
 530                      * elements than the page table.
 531                      *
 532                      * The low bits of each word are allocation flags.
 533                      */
 534                     if (word=data[i]) {
 535                         page_table[offset].region_start_offset = word & ~0x03;
 536                         page_table[offset].allocated = word & 0x03;
 537                     }
 538                     i++;
 539                     offset++;
 540                 }
 541             }
 542
 543             gencgc_partial_pickup = 1;
 544             break;
 545         }
 546 #endif
 547         default:
 548             lose("unknown core file entry: %ld\n", (long)val);
 549         }
 550
 551         ptr += remaining_len;
 552         FSHOW((stderr, "/new ptr=%lx\n", (unsigned long)ptr));
 553     }
 554     SHOW("about to free(header)");
 555     free(header);
 556     SHOW("returning from load_core_file(..)");
 557     return initial_function;
 558 }
 559