common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Extend save-lisp-and-die to write an ELF .o file

Browse source 
which embeds an SBCL core and allows linking without --export-dynamic.
This is a lighter-weight and possibly easier-to-use incarnation of elftool.
This commit is contained in:
Douglas Katzman 2026-01-30 16:46:29 -05:00
parent d61e53f2b1
commit fcd4d116fe
5 changed files with 241 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/code/save.lisp
View file

@ -123,6 +123,8 @@ The following &KEY arguments are defined:
to create a standalone executable. If false (the default), the
core image will not be executable on its own. Executable images
always behave as if they were passed the --noinform runtime option.
If :EXECUTABLE is :ELF-OBJECT, then the resulting core will be
wrapped in a .o which requires further linking. (EXPERIMENTAL)
:SAVE-RUNTIME-OPTIONS
If true, values of runtime options --dynamic-space-size and
@ -256,7 +258,7 @@ sufficiently motivated to do lengthy fixes."
;; since the GC will invalidate the stack.
(sb-kernel::unsafe-clear-roots sb-vm:+highest-normal-generation+)
(gc-and-save name
(foreign-bool executable)
(if (eq executable :elf-object) 2 (foreign-bool executable))
(foreign-bool purify)
(case save-runtime-options
(:accept-runtime-options 2)

13
src/runtime/GNUmakefile
View file

@ -159,6 +159,19 @@ pie-shrinkwrap-sbcl: pie-shrinkwrap-sbcl.s pie-shrinkwrap-sbcl-core.o $(PIC_OBJS
semiwrap-sbcl: shrinkwrap-sbcl.s $(LIBSBCL)
$(CC) $(LINKFLAGS) $(CFLAGS) -o $@ $^ $(LIBS)
# simpler version of core embedding where the core is just a section of the ELF file.
# tools-for-build/elftool could kinda do this but it didn't work as well as it
# does using the ELF writer from C, because firstly the interface is less
# polished and secondly it did remove the need for -Wl,--export-dynamic.
# Note about $(LIBS) - we don't really need -ldl except os-common does reference it
# so removing it would break that. Also certain platforms need -lm and -lpthread
# to get in there so using the same link options as for the ordinary "sbcl"
# is just easiest.
embedcore-sbcl: $(LIBSBCL)
../../run-sbcl.sh --eval '(save-lisp-and-die "wrappedcore.o" :executable :elf-object)'
$(CC) -no-pie $(filter-out -Wl$(comma)--export-dynamic, $(LINKFLAGS)) \
$(CFLAGS) -o $@ wrappedcore.o $^ $(LIBS)
sbcl.mk: Config
( echo 'CC=$(CC)' ; \
echo 'LD=$(LD)' ; \

146
src/runtime/os-common.c
View file

@ -596,4 +596,150 @@ int apply_pie_relocs(long code_space_translation,
free(ptrs);
return success;
}
#ifdef LISP_FEATURE_ARM64
# define ELF_MACHINE EM_AARCH64
# define CORE_ALIGNMENT 65536
# define OUR_RELOC_KIND R_AARCH64_ABS64
#else
# define ELF_MACHINE EM_X86_64
# define CORE_ALIGNMENT 32768
# define OUR_RELOC_KIND R_X86_64_64
#endif
static uint32_t add_string(char *buffer, uint32_t *current_size, const char *str) {
uint32_t offset = *current_size;
strcpy(buffer + offset, str);
*current_size += strlen(str) + 1;
return offset;
}
static void put_section(FILE* f, long offset, void* data, int size, int nmemb)
{
fseek(f, offset, SEEK_SET);
fwrite(data, size, nmemb, f);
}
void generate_elfcore_obj(const char *filename,
FILE* input_core,
char **symbol_names, int symbol_count)
{
size_t core_size = ftell(input_core);
rewind(input_core);
// Prepare Section Header String Table
char shstrtab[256] = {0};
uint32_t shstr_size = 0;
add_string(shstrtab, &shstr_size, "");
uint32_t core_shname = add_string(shstrtab, &shstr_size, "lisp.core");
uint32_t table_shname = add_string(shstrtab, &shstr_size, ".data"); // alien_table");
uint32_t rela_shname = add_string(shstrtab, &shstr_size, ".rela.data"); // alien_table");
uint32_t note_shname = add_string(shstrtab, &shstr_size, ".note.GNU-stack");
uint32_t shstr_shname = add_string(shstrtab, &shstr_size, ".shstrtab");
uint32_t sym_shname = add_string(shstrtab, &shstr_size, ".symtab");
uint32_t str_shname = add_string(shstrtab, &shstr_size, ".strtab");
// Prepare String Table
const char anchor[] = "alien_linkage_values";
uint32_t strtab_size = 1 + sizeof anchor;
for (int i = 0; i < symbol_count; i++) strtab_size += strlen(symbol_names[i]) + 1;
char* strtab = malloc(strtab_size);
uint32_t str_ct = 0; // how many chars are written into strtab
add_string(strtab, &str_ct, "");
uint32_t anchor_strname = add_string(strtab, &str_ct, anchor);
// Prepare Symbol Table
// Index 1: alien_linkage_values (Defined, Global)
// Index 2...N: The External C symbols (Undefined, Global)
int total_elf_syms = symbol_count + 2;
Elf64_Sym *elf_syms = calloc(total_elf_syms, sizeof(Elf64_Sym));
elf_syms[1].st_name = anchor_strname;
elf_syms[1].st_info = ELF64_ST_INFO(STB_GLOBAL, STT_NOTYPE);
elf_syms[1].st_shndx = 2; // Index of .alien_table
elf_syms[1].st_size = 0;//symbol_count * N_WORD_BYTES;
for (int i = 0; i < symbol_count; i++) {
elf_syms[i+2].st_name = add_string(strtab, &str_ct, symbol_names[i]);
elf_syms[i+2].st_info = ELF64_ST_INFO(STB_GLOBAL, STT_NOTYPE);
elf_syms[i+2].st_shndx = SHN_UNDEF;
}
gc_assert(str_ct == strtab_size);
// Prepare alien_linkage_values
size_t table_data_size = symbol_count * N_WORD_BYTES;
uint64_t *table_data = calloc((unsigned int)symbol_count, 8); // Initialized to 0
Elf64_Rela *relocs = calloc((unsigned int)symbol_count, sizeof(Elf64_Rela));
for (int i = 0; i < symbol_count; i++) {
relocs[i].r_offset = i * 8;
// Syms start at index 2
relocs[i].r_info = ELF64_R_INFO(i + 2, OUR_RELOC_KIND);
relocs[i].r_addend = 0;
}
// Compute placement of data in the ELF file
// Force the core to start at the first 32K boundary after the ELF header
long core_offset = CORE_ALIGNMENT;
long table_offset = core_offset + core_size; // alien_linkage_values array goes here
long rela_offset = table_offset + ALIGN_UP(table_data_size, N_WORD_BYTES);
long note_offset = rela_offset + ALIGN_UP(symbol_count * sizeof(Elf64_Rela), N_WORD_BYTES);
long shstr_offset = note_offset;
long sym_offset = shstr_offset + ALIGN_UP(shstr_size, N_WORD_BYTES);
long str_offset = sym_offset + ALIGN_UP(total_elf_syms * sizeof(Elf64_Sym), N_WORD_BYTES);
long header_table_offset = str_offset + ALIGN_UP(strtab_size, N_WORD_BYTES);
/* in a .symtab section:
* sh_link is the index of its corresponding string section
* sh_info is the index of the first global symbol
* in a .rela section:
* sh_link is the index of the symbol section
* sh_info is the section to patch
*/
// 5. Section Headers (8 total: 0..7)
Elf64_Shdr shdr[8] = {0};
shdr[1] = (Elf64_Shdr){ .sh_name=core_shname, .sh_type=SHT_PROGBITS, .sh_flags=SHF_ALLOC,
.sh_offset=core_offset, .sh_size=core_size, .sh_addralign=CORE_ALIGNMENT
};
shdr[2] = (Elf64_Shdr){ .sh_name=table_shname, .sh_type=SHT_PROGBITS, .sh_flags=SHF_ALLOC|SHF_WRITE,
.sh_offset=table_offset, .sh_size=table_data_size, .sh_addralign=8
};
shdr[3] = (Elf64_Shdr){ .sh_name=rela_shname, .sh_type=SHT_RELA, .sh_offset=rela_offset,
.sh_size=symbol_count*sizeof(Elf64_Rela), .sh_link=6, .sh_info=2, .sh_entsize=sizeof(Elf64_Rela)
};
shdr[4] = (Elf64_Shdr){ .sh_name=note_shname, .sh_type=SHT_PROGBITS, .sh_offset=note_offset };
shdr[5] = (Elf64_Shdr){ .sh_name=shstr_shname, .sh_type=SHT_STRTAB, .sh_offset=shstr_offset,
.sh_size=shstr_size
};
shdr[6] = (Elf64_Shdr){ .sh_name=sym_shname, .sh_type=SHT_SYMTAB, .sh_offset=sym_offset,
.sh_size=total_elf_syms*sizeof(Elf64_Sym), .sh_link=7, .sh_info=1, .sh_entsize=sizeof(Elf64_Sym)
};
shdr[7] = (Elf64_Shdr){ .sh_name=str_shname, .sh_type=SHT_STRTAB, .sh_offset=str_offset,
.sh_size=strtab_size
};
Elf64_Ehdr ehdr = {
.e_ident = { ELFMAG0, ELFMAG1, ELFMAG2, ELFMAG3, ELFCLASS64, ELFDATA2LSB, EV_CURRENT },
.e_type = ET_REL, .e_machine = ELF_MACHINE, .e_version = EV_CURRENT,
.e_ehsize = sizeof(Elf64_Ehdr), .e_shentsize = sizeof(Elf64_Shdr),
.e_shnum = 8, .e_shstrndx = 5, .e_shoff = header_table_offset
};
FILE *f = fopen(filename, "wb");
char buffer[4096];
int nread;
fwrite(&ehdr, 1, sizeof(ehdr), f);
fseek(f, core_offset, SEEK_SET);
while ((nread = fread(buffer, 1, 4096, input_core)) > 0)
fwrite(buffer, 1, nread, f);
put_section(f, table_offset, table_data, table_data_size, 1);
put_section(f, rela_offset, relocs, sizeof(Elf64_Rela), symbol_count);
put_section(f, shstr_offset, shstrtab, shstr_size, 1);
put_section(f, sym_offset, elf_syms, sizeof(Elf64_Sym), total_elf_syms);
put_section(f, str_offset, strtab, strtab_size, 1);
put_section(f, header_table_offset, shdr, sizeof(Elf64_Shdr), 8);
fclose(f);
// Should really free() some stuff but it's not a leak since this program is now exiting
}
#endif

63
src/runtime/save.c
View file

@ -33,6 +33,7 @@
#include "gc.h"
#include "thread.h"
#include "arch.h"
#include "genesis/hash-table.h"
#include "genesis/static-symbols.h"
#include "genesis/symbol.h"
#include "genesis/vector.h"
@ -279,6 +280,9 @@ void save_to_filehandle(FILE *file, char *filename, lispobj init_function,
/* (Now we can actually start copying ourselves into the output file.) */
if (verbose) {
/* This shows the temporary file name if writing a .o file. I think that's
* a reasonable choice, though we could certainly make an extra copy
* of the name as originally specified */
printf("[saving current Lisp image into %s:\n", filename);
fflush(stdout);
}
@ -707,6 +711,8 @@ static void prepare_dynamic_space_for_final_gc(struct thread* thread)
char gc_coalesce_string_literals = 0;
extern void move_rospace_to_dynamic(int), prepare_readonly_space(int,int);
extern bool generate_elfcore_obj(const char *filename, FILE* input_core,
char **syms, int sym_count);
/* Do a non-conservative GC twice, and then save a core with the initial
* function being set to the value of 'lisp_init_function'.
@ -743,10 +749,13 @@ extern void move_rospace_to_dynamic(int), prepare_readonly_space(int,int);
* as empty pages, because we can't represent discontiguous ranges.
*/
void
gc_and_save(char *filename, bool prepend_runtime, bool purify,
gc_and_save(char *filename, int core_format, bool purify,
int save_runtime_options, bool compressed,
int compression_level, int application_type)
{
int prepend_runtime = core_format == 1;
int elf_object = core_format == 2;
// FIXME: Instead of disabling purify for static space relocation,
// we should make r/o space read-only after fixing up pointers to
// static space instead.
@ -768,14 +777,22 @@ gc_and_save(char *filename, bool prepend_runtime, bool purify,
extern void coalesce_similar_objects();
bool verbose = !lisp_startup_options.noinform;
if (!elf_object) {
/* The filename might come from Lisp, and be moved by the now
* non-conservative GC. */
filename = strdup(filename);
} else {
int tempnamelen = strlen(filename) + 5; // ".tmp"
char* copy = checked_malloc(tempnamelen);
snprintf(copy, tempnamelen, "%s.tmp", filename);
filename = copy;
}
file = prepare_to_save(filename, prepend_runtime, &runtime_bytes,
&runtime_size);
if (file == NULL)
if (file == NULL) {
free(filename);
return;
/* The filename might come from Lisp, and be moved by the now
* non-conservative GC. */
filename = strdup(filename);
}
/* We're destined for process exit at this point, and interrupts can not
* possibly be handled in Lisp. The installed signal handler closures should
@ -868,8 +885,42 @@ gc_and_save(char *filename, bool prepend_runtime, bool purify,
save_runtime_to_filehandle(file, runtime_bytes, runtime_size,
application_type);
char** elf_c_symbols = 0;
int n_symbols = 0;
if (elf_object) {
// Find SB-SYS:*LINKAGE-INFO*
lispobj* sym = find_symbol("*LINKAGE-INFO*", get_package_by_id(PACKAGE_ID_SYS));
lispobj value = ((struct symbol*)sym)->value;
gc_assert(instancep(CONS(value)->car));
struct hash_table* ht = (void*)native_pointer(CONS(value)->car);
gc_assert(simple_vector_p(ht->pairs));
struct vector* kvv = (void*)native_pointer(ht->pairs);
n_symbols = fixnum_value(ht->_count);
gc_assert(fixnum_value(kvv->data[0]) == n_symbols); // KVV's high-water mark
if (verbose) {
printf("[linkage info: %d symbols]\n", n_symbols);
fflush(stdout);
}
elf_c_symbols = calloc(n_symbols, sizeof (char*));
int i;
for (i=0; i<n_symbols; ++i) {
lispobj key = kvv->data[(1+i)<<1];
// string is code symbol, singleton cons of string is a data symbol
if (listp(key)) key = CONS(key)->car;
struct vector* c_symbol = VECTOR(key);
elf_c_symbols[i] = (char*)c_symbol->data;
}
}
save_to_filehandle(file, filename, lisp_init_function,
prepend_runtime, save_runtime_options,
compressed ? compression_level : COMPRESSION_LEVEL_NONE);
if (elf_object) {
file = fopen(filename, "r"); // reopen it for reading
unlink(filename);
filename[strlen(filename)-4] = '\0'; // chop ".tmp" from the end
fseek(file, 0, SEEK_END);
generate_elfcore_obj(filename, file, elf_c_symbols, n_symbols);
printf("[Converted to ELF]\n");
}
exit(0);
}

22
tests/elfcore.test.sh
View file

@ -15,6 +15,28 @@
. ./subr.sh
# The 'embedcore-sbcl' test works for more configurations than the rest of the
# tests in this file do, so try it first. If this can't be run, neither can
# anything else.
run_sbcl <<EOF
#+(and linux (or arm64 x86-64)) (exit :code 0) ; good
(exit :code 2) ; otherwise
EOF
status=$?
if [ $status != 0 ]; then # test can't be executed
# we don't have a way to exit shell tests with "inapplicable" as the result
exit $EXIT_TEST_WIN
fi
# Ensure that we're not running a stale embedcore-sbcl
(cd $SBCL_PWD/../src/runtime ; rm -f embedcore-sbcl ; make embedcore-sbcl)
set -e # exit on error
$SBCL_PWD/../src/runtime/embedcore-sbcl --disable-debugger --no-sysinit --no-userinit --noprint <<EOF
(format t "~&ELF-embedded core starts OK~%")
(exit :code 0)
EOF
set +e # no exit on error
run_sbcl <<EOF
#+(and linux elf sb-thread)
(let ((s (find-symbol "IMMOBILE-SPACE-OBJ-P" "SB-KERNEL")))