x86-64: Initial checkin of support for loading a core from ELF sections

Quickstart for the impatient (assuming you've already done a full build):
 % (cd src/runtime ; make shrinkwrap-sbcl)
 % src/runtime/shrinkwrap-sbcl

This approach relies on the immobile code feature and is very different
from the patch series circulated on sbcl-devel.

First a native '.core' file is saved, then it is separated (by a Lisp program
into two pieces): code components and all else.  Immobile code components
get written out as assembly source code to make the system assembler do all
the heavy lifting of adding DWARF info without which gdb would have problems.

All other spaces are written into a '.o' file directly. The '.s' and '.o' files
are then linked with the rest of the C runtime. Linking will move the immobile
code space arbitrarily, but it is position-independent code.  The space is at
that time fixed in size to the minimum required to hold its contents.

Important note: ELFinated core files can not load fasl files.  I plan to allow
for that by having COMPILE-FILE write code destined for dynamic space.
And eventually we will emit linker relocations so that coreparse does not
need to determine where the immobile code resides and perform startup-time
relocation (unless it could not get map the other spaces where expected).

As just one example of what you can do, using the shrinkwrap-sbcl target you can
get a sane (other than every source file being named "shrinkwrap-sbcl.s" allegedly)
backtrace from a C debugger. Apparently '.file' directives aren't enough.
(gdb) bt
> #0  0x00007f31fb8cfc40 in __poll_nocancel () at ../sysdeps/unix/syscall-template.S:81
> sbcl#1  0x00000000005906c8 in sb-unix:unix-simple-poll () at shrinkwrap-sbcl.s:22953
> sbcl#2  0x000000000058e355 in sb-sys:wait-until-fd-usable () at shrinkwrap-sbcl.s:22686
> sbcl#3  0x00000000005b7380 in sb-impl::refill-input-buffer () at shrinkwrap-sbcl.s:27806
> sbcl#4  0x0000000000e3e32e in sb-impl::input-char/utf-8 () at shrinkwrap-sbcl.s:340954
> sbcl#5  0x000000000052688b in (lambda # in sb-impl::get-external-format)_2 () at shrinkwrap-sbcl.s:9488
> sbcl#6  0x00000000005c22cc in cl:read-char () at shrinkwrap-sbcl.s:28818

src/runtime/Config.x86-64-linux

@@ -45,7 +45,7 @@ endif
 CFLAGS += -fno-omit-frame-pointer -momit-leaf-frame-pointer
 
 ifdef LISP_FEATURE_IMMOBILE_SPACE
- GC_SRC = fullcgc.c gencgc.c traceroot.c immobile-space.c
+ GC_SRC = fullcgc.c gencgc.c traceroot.c immobile-space.c elf.c
 else
  GC_SRC = fullcgc.c gencgc.c traceroot.c
 endif

src/runtime/GNUmakefile

@@ -96,6 +96,13 @@ libsbcl.so: $(subst .o,.pic.o,$(filter-out ldso-stubs.o,$(OBJS)))
  $(CC) -DLISP_FEATURE_GCC_TLS -DPOSITION_INDEPENDENT_ASM -c $(CFLAGS) $< -o $@
 testmain: testmain.c libsbcl.so -ldl
 
+shrinkwrap-sbcl.s shrinkwrap-sbcl-core.o: sbcl ../../output/sbcl.core \
+ ../../tools-for-build/editcore.lisp
+ ../../run-sbcl.sh --script ../../tools-for-build/editcore.lisp split \
+ ../../output/sbcl.core shrinkwrap-sbcl.s
+shrinkwrap-sbcl: shrinkwrap-sbcl.s shrinkwrap-sbcl-core.o $(OBJS) $(LIBS)
+ $(CC) -Wl,-export-dynamic $(CFLAGS) -o $@ $^
+
 sbcl.mk:
  ( echo 'CC=$(CC)' ; \
  echo 'LD=$(LD)' ; \

src/runtime/coreparse.c

@@ -119,6 +119,12 @@ maybe_initialize_runtime_options(int fd)
  }
 }
 
+#if defined(LISP_FEATURE_LINUX) && defined(LISP_FEATURE_IMMOBILE_CODE)
+#define ELFCORE 1
+#else
+#define ELFCORE 0
+#endif
+
 /* Search 'filename' for an embedded core. An SBCL core has, at the
  * end of the file, a trailer containing optional saved runtime
  * options, the start of the core (an os_vm_offset_t), and a final
@@ -131,6 +137,7 @@ maybe_initialize_runtime_options(int fd)
 os_vm_offset_t
 search_for_embedded_core(char *filename)
 {
+ extern size_t search_for_elf_core(int, os_vm_offset_t*);
  lispobj header;
  os_vm_offset_t lispobj_size = sizeof(lispobj);
  os_vm_offset_t trailer_size = lispobj_size + sizeof(os_vm_offset_t);
@@ -176,6 +183,25 @@ search_for_embedded_core(char *filename)
  }
 
 lose:
+ ;
+#if ELFCORE
+ size_t core_size = search_for_elf_core(fd, &core_start);
+ if (core_size) {
+ int announce = !lisp_startup_options.noinform;
+ if (announce)
+ fprintf(stderr, "Lisp core in ELF section: %lx:%lx\n", core_start, core_start + core_size);
+ // FIXME: saving options at the end of the core is terrible.
+ // They should be in an optional core entry.
+ off_t options_offset = core_start + core_size
+ - (2+RUNTIME_OPTIONS_WORDS) * sizeof (lispobj);
+ struct runtime_options *new_runtime_options;
+ lseek(fd, options_offset, SEEK_SET);
+ if ((new_runtime_options = read_runtime_options(fd))) {
+ runtime_options = new_runtime_options;
+ }
+ return core_start;
+ }
+#endif
  if (fd != -1)
  close(fd);
 
@@ -310,6 +336,8 @@ struct heap_adjust {
 #include "genesis/layout.h"
 #include "genesis/vector.h"
 
+extern __attribute__((weak)) lispobj __lisp_code_start, __lisp_code_end;
+
 static inline sword_t calc_adjustment(struct heap_adjust* adj, lispobj x)
 {
  if (adj->range[0].start <= x && x < adj->range[0].end)
@@ -598,11 +626,17 @@ void relocate_heap(struct heap_adjust* adj)
  relocate_space(STATIC_SPACE_START, static_space_free_pointer, adj);
 #ifdef LISP_FEATURE_IMMOBILE_SPACE
  relocate_space(FIXEDOBJ_SPACE_START, fixedobj_free_pointer, adj);
- relocate_space(VARYOBJ_SPACE_START, varyobj_free_pointer, adj);
  SYMBOL(FUNCTION_LAYOUT)->value = \
  adjust_word(adj, SYMBOL(FUNCTION_LAYOUT)->value >> 32) << 32;
 #endif
  relocate_space(DYNAMIC_SPACE_START, (lispobj*)get_alloc_pointer(), adj);
+
+ // Pointers within varyobj space to varyobj space do not need adjustment
+ // so remove any delta before performing the relocation pass on this space.
+ if (&__lisp_code_start) {
+ adj->range[2].delta = 0;
+ }
+ relocate_space(VARYOBJ_SPACE_START, varyobj_free_pointer, adj);
 }
 #endif
 
@@ -646,12 +680,29 @@ process_directory(int count, struct ndir_entry *entry,
  {0, 0, STATIC_SPACE_START, &static_space_free_pointer},
  {0, 0, READ_ONLY_SPACE_START, &read_only_space_free_pointer},
 #ifdef LISP_FEATURE_IMMOBILE_SPACE
- {(FIXEDOBJ_SPACE_SIZE+VARYOBJ_SPACE_SIZE) | 1, 0,
+ {FIXEDOBJ_SPACE_SIZE | 1, 0,
  FIXEDOBJ_SPACE_START, &fixedobj_free_pointer},
  {1, 0, VARYOBJ_SPACE_START, &varyobj_free_pointer}
 #endif
  };
 
+ if (&__lisp_code_start) {
+ VARYOBJ_SPACE_START = (uword_t)&__lisp_code_start;
+ varyobj_free_pointer = &__lisp_code_end;
+ uword_t aligned_end = ALIGN_UP((uword_t)&__lisp_code_end, IMMOBILE_CARD_BYTES);
+ varyobj_space_size = aligned_end - VARYOBJ_SPACE_START;
+ spaces[IMMOBILE_VARYOBJ_CORE_SPACE_ID].len = varyobj_space_size;
+ gc_assert(varyobj_free_pointer >= (lispobj*)VARYOBJ_SPACE_START);
+#if !ENABLE_PAGE_PROTECTION
+ printf("Lisp code present in executable @ %lx:%lx (freeptr=%p)\n",
+ (uword_t)&__lisp_code_start, aligned_end, varyobj_free_pointer);
+#endif
+ // unprotect the pages
+ os_protect((void*)VARYOBJ_SPACE_START, varyobj_space_size, OS_VM_PROT_ALL);
+ } else {
+ spaces[IMMOBILE_FIXEDOBJ_CORE_SPACE_ID].desired_size += VARYOBJ_SPACE_SIZE;
+ }
+
  for ( ; --count>= 0; ++entry) {
  sword_t id = entry->identifier;
  uword_t addr = (1024 * entry->address); // multiplier as per core.h
@@ -762,7 +813,9 @@ process_directory(int count, struct ndir_entry *entry,
  lispobj *free_pointer = (lispobj *) addr + entry->nwords;
  switch (id) {
  default:
- *spaces[id].pfree_pointer = free_pointer;
+ // varyobj free ptr is already nonzero if Lisp code in executable
+ if (!*spaces[id].pfree_pointer)
+ *spaces[id].pfree_pointer = free_pointer;
  break;
  case DYNAMIC_CORE_SPACE_ID:
 #ifdef LISP_FEATURE_CHENEYGC

src/runtime/elf.c

@@ -0,0 +1,54 @@
+#include <string.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <elf.h>
+
+// Return the offset to a file section named 'lisp.core' if there is one
+size_t search_for_elf_core(int fd, off_t* core_start)
+{
+ Elf64_Ehdr ehdr;
+ unsigned long result = 0;
+
+ if (lseek(fd, 0, SEEK_SET) != 0 ||
+ read(fd, &ehdr, sizeof ehdr) != sizeof ehdr) {
+ fprintf(stderr, "failed to read elf header\n");
+ return 0;
+ }
+ // Seek to and read the section header of the section header string table
+ Elf64_Shdr shdr;
+ off_t offset = ehdr.e_shoff + ehdr.e_shstrndx * ehdr.e_shentsize;
+ char * shstrtab_strbuf = 0;
+ if (lseek(fd, offset, SEEK_SET) != offset ||
+ read(fd, &shdr, sizeof shdr) != sizeof shdr) {
+ fprintf(stderr, "read failed\n");
+ return 1;
+ }
+ // Read the section header string table
+ if ((shstrtab_strbuf = malloc(shdr.sh_size)) == NULL ||
+ lseek(fd, shdr.sh_offset, SEEK_SET) != (Elf64_Sxword)shdr.sh_offset ||
+ read(fd, shstrtab_strbuf, shdr.sh_size) != (Elf64_Sxword)shdr.sh_size) {
+ fprintf(stderr, "read failed\n");
+ goto done;
+ }
+ // Seek back to the section headers and scan linearly
+ if (lseek(fd, ehdr.e_shoff, SEEK_SET) != (Elf64_Sxword)ehdr.e_shoff) {
+ fprintf(stderr, "lseek failed\n");
+ goto done;
+ }
+ int i;
+ for(i=0;i<ehdr.e_shnum;++i) {
+ if (read(fd, &shdr, sizeof shdr) != sizeof shdr)
+ break;
+ if (!strcmp(&shstrtab_strbuf[shdr.sh_name], "lisp.core")) {
+ *core_start = shdr.sh_offset;
+ result = shdr.sh_size;
+ break;
+ }
+ }
+ done:
+ if (shstrtab_strbuf)
+ free(shstrtab_strbuf);
+ return result;
+}

src/runtime/immobile-space.c

@@ -1286,8 +1286,13 @@ void immobile_space_coreparse(uword_t fixedobj_len, uword_t varyobj_len)
  if ((uword_t)limit & (IMMOBILE_CARD_BYTES-1)) {
  int remainder = IMMOBILE_CARD_BYTES -
  ((uword_t)limit & (IMMOBILE_CARD_BYTES-1));
- limit[0] = SIMPLE_ARRAY_FIXNUM_WIDETAG;
- limit[1] = make_fixnum((remainder >> WORD_SHIFT) - 2);
+ lispobj array_length = make_fixnum((remainder >> WORD_SHIFT) - 2);
+ if (limit[0] == SIMPLE_ARRAY_FIXNUM_WIDETAG) {
+ gc_assert(limit[1] == array_length);
+ } else {
+ limit[0] = SIMPLE_ARRAY_FIXNUM_WIDETAG;
+ limit[1] = array_length;
+ }
  int size = sizetab[SIMPLE_ARRAY_FIXNUM_WIDETAG](limit);
  lispobj* __attribute__((unused)) padded_end = limit + size;
  gc_assert(!((uword_t)padded_end & (IMMOBILE_CARD_BYTES-1)));