void os_link_runtime()
{
#ifdef LISP_FEATURE_SB_DYNAMIC_CORE
char *link_target = (char*)(intptr_t)LINKAGE_TABLE_SPACE_START;
void *validated_end = link_target;
lispobj symbol_name;
char *namechars;
boolean datap;
void* result;
int j;
if (lisp_linkage_table_n_prelinked)
return; // Linkage was already performed by coreparse
struct vector* symbols = VECTOR(SymbolValue(REQUIRED_FOREIGN_SYMBOLS,0));
lisp_linkage_table_n_prelinked = fixnum_value(symbols->length);
for (j = 0 ; j < lisp_linkage_table_n_prelinked ; ++j)
{
lispobj item = symbols->data[j];
datap = listp(item);
symbol_name = datap ? CONS(item)->car : item;
namechars = (void*)(intptr_t)(VECTOR(symbol_name)->data);
result = os_dlsym_default(namechars);
if (link_target == validated_end) {
validated_end = (char*)validated_end + os_vm_page_size;
#ifdef LISP_FEATURE_WIN32
os_validate_recommit(link_target,os_vm_page_size);
#endif
}
if (result) {
arch_write_linkage_table_entry(link_target, result, datap);
} else { // startup might or might not work. ymmv
printf("Missing required foreign symbol '%s'\n", namechars);
}
link_target += LINKAGE_TABLE_ENTRY_SIZE;
}
#endif /* LISP_FEATURE_SB_DYNAMIC_CORE */
#ifdef LISP_FEATURE_X86_64
SetSymbolValue(CPUID_FN1_ECX, (lispobj)make_fixnum(cpuid_fn1_ecx), 0);
#endif
}
static void
process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset)
{
extern void immobile_space_coreparse(uword_t,uword_t);
struct ndir_entry *entry;
int compressed;
FSHOW((stderr, "/process_directory(..), count=%d\n", count));
for (entry = (struct ndir_entry *) ptr; --count>= 0; ++entry) {
compressed = 0;
sword_t id = entry->identifier;
if (id <= (MAX_CORE_SPACE_ID | DEFLATED_CORE_SPACE_ID_FLAG)) {
if (id & DEFLATED_CORE_SPACE_ID_FLAG)
compressed = 1;
id &= ~(DEFLATED_CORE_SPACE_ID_FLAG);
}
sword_t offset = os_vm_page_size * (1 + entry->data_page);
os_vm_address_t addr =
(os_vm_address_t) (os_vm_page_size * entry->address);
lispobj *free_pointer = (lispobj *) addr + entry->nwords;
uword_t len = os_vm_page_size * entry->page_count;
if (len != 0) {
os_vm_address_t real_addr;
FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n",
len, len, (uword_t)addr));
if (compressed) {
#ifdef LISP_FEATURE_SB_CORE_COMPRESSION
real_addr = inflate_core_bytes(fd, offset + file_offset, addr, len);
#else
lose("This runtime was not built with zlib-compressed core support... aborting\n");
#endif
} else {
#ifdef LISP_FEATURE_HPUX
real_addr = copy_core_bytes(fd, offset + file_offset, addr, len);
#else
real_addr = os_map(fd, offset + file_offset, addr, len);
#endif
}
if (real_addr != addr) {
lose("file mapped in wrong place! "
"(0x%08x != 0x%08lx)\n",
real_addr,
addr);
}
}
#ifdef MADV_MERGEABLE
if ((merge_core_pages == 1)
|| ((merge_core_pages == -1) && compressed)) {
madvise(addr, len, MADV_MERGEABLE);
}
#endif
FSHOW((stderr, "/space id = %ld, free pointer = %p\n",
id, (uword_t)free_pointer));
switch (id) {
case DYNAMIC_CORE_SPACE_ID:
if (len > dynamic_space_size) {
fprintf(stderr,
"dynamic space too small for core: %luKiB required, %luKiB available.\n",
(unsigned long)len >> 10,
(unsigned long)dynamic_space_size >> 10);
exit(1);
}
#ifdef LISP_FEATURE_GENCGC
if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) {
fprintf(stderr, "in core: %p; in runtime: %p \n",
(void*)addr, (void*)DYNAMIC_SPACE_START);
lose("core/runtime address mismatch: DYNAMIC_SPACE_START\n");
}
#else
if ((addr != (os_vm_address_t)DYNAMIC_0_SPACE_START) &&
(addr != (os_vm_address_t)DYNAMIC_1_SPACE_START)) {
fprintf(stderr, "in core: %p; in runtime: %p or %p\n",
(void*)addr,
(void*)DYNAMIC_0_SPACE_START,
(void*)DYNAMIC_1_SPACE_START);
lose("warning: core/runtime address mismatch: DYNAMIC_SPACE_START\n");
}
#endif
#if defined(ALLOCATION_POINTER)
SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer,0);
#else
dynamic_space_free_pointer = free_pointer;
#endif
/* For stop-and-copy GC, this will be whatever the GC was
* using at the time. With GENCGC, this will always be
* space 0. (We checked above that for GENCGC,
* addr==DYNAMIC_SPACE_START.) */
current_dynamic_space = (lispobj *)addr;
break;
case STATIC_CORE_SPACE_ID:
if (addr != (os_vm_address_t)STATIC_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)STATIC_SPACE_START);
lose("core/runtime address mismatch: STATIC_SPACE_START\n");
}
break;
case READ_ONLY_CORE_SPACE_ID:
if (addr != (os_vm_address_t)READ_ONLY_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)READ_ONLY_SPACE_START);
lose("core/runtime address mismatch: READ_ONLY_SPACE_START\n");
}
break;
#ifdef LISP_FEATURE_IMMOBILE_SPACE
// Immobile space is subdivided into fixed-size and variable-size.
// There is no margin between the two, though for efficiency
// they are written separately to eliminate waste in the core file.
case IMMOBILE_FIXEDOBJ_CORE_SPACE_ID:
if (addr != (os_vm_address_t)IMMOBILE_SPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)IMMOBILE_SPACE_START);
lose("core/runtime address mismatch: IMMOBILE_SPACE_START\n");
}
immobile_space_coreparse(IMMOBILE_SPACE_START, len);
break;
case IMMOBILE_VARYOBJ_CORE_SPACE_ID:
if (addr != (os_vm_address_t)IMMOBILE_VARYOBJ_SUBSPACE_START) {
fprintf(stderr, "in core: %p - in runtime: %p\n",
(void*)addr, (void*)IMMOBILE_VARYOBJ_SUBSPACE_START);
lose("core/runtime address mismatch: IMMOBILE_VARYOBJ_SUBSPACE_START\n");
}
immobile_space_coreparse(IMMOBILE_VARYOBJ_SUBSPACE_START, len);
break;
#endif
default:
lose("unknown space ID %ld addr %p\n", id, addr);
}
}
boolean
save_to_filehandle(FILE *file, char *filename, lispobj init_function,
boolean make_executable,
boolean save_runtime_options,
int core_compression_level)
{
struct thread *th;
os_vm_offset_t core_start_pos;
#ifdef LISP_FEATURE_X86_64
untune_asm_routines_for_microarch();
#endif
/* Smash the enclosing state. (Once we do this, there's no good
* way to go back, which is a sufficient reason that this ends up
* being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
printf("[undoing binding stack and other enclosing state... ");
fflush(stdout);
for_each_thread(th) { /* XXX really? */
unbind_to_here((lispobj *)th->binding_stack_start,th);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
}
printf("done]\n");
fflush(stdout);
/* (Now we can actually start copying ourselves into the output file.) */
printf("[saving current Lisp image into %s:\n", filename);
fflush(stdout);
core_start_pos = ftell(file);
write_lispobj(CORE_MAGIC, file);
write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (We're writing the word count of the entry here, and the 2
* term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
* word and one word where we store the count itself.) */
2 + strlen((const char *)build_id),
file);
{
unsigned char *p;
for (p = (unsigned char *)build_id; *p; ++p)
write_lispobj(*p, file);
}
write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (word count = N spaces described by 5 words each, plus the
* entry type code, plus this count itself) */
(5*N_SPACES_TO_SAVE)+2, file);
output_space(file,
READ_ONLY_CORE_SPACE_ID,
(lispobj *)READ_ONLY_SPACE_START,
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
output_space(file,
STATIC_CORE_SPACE_ID,
(lispobj *)STATIC_SPACE_START,
(lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
#ifdef LISP_FEATURE_GENCGC
/* Flush the current_region, updating the tables. */
gc_alloc_update_all_page_tables(1);
update_dynamic_space_free_pointer();
#endif
#ifdef LISP_FEATURE_IMMOBILE_SPACE
prepare_immobile_space_for_save();
output_space(file,
IMMOBILE_FIXEDOBJ_CORE_SPACE_ID,
(lispobj *)IMMOBILE_SPACE_START,
(lispobj *)SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER,0),
core_start_pos,
core_compression_level);
output_space(file,
IMMOBILE_VARYOBJ_CORE_SPACE_ID,
(lispobj *)IMMOBILE_VARYOBJ_SUBSPACE_START,
(lispobj *)SymbolValue(IMMOBILE_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
#endif
#ifdef reg_ALLOC
#ifdef LISP_FEATURE_GENCGC
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
dynamic_space_free_pointer,
core_start_pos,
core_compression_level);
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)current_dynamic_space,
dynamic_space_free_pointer,
core_start_pos,
core_compression_level);
#endif
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
(lispobj *)SymbolValue(ALLOCATION_POINTER,0),
core_start_pos,
core_compression_level);
#endif
write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(3, file);
write_lispobj(init_function, file);
#ifdef LISP_FEATURE_GENCGC
{
size_t size = (last_free_page*sizeof(sword_t)+os_vm_page_size-1)
&~(os_vm_page_size-1);
uword_t *data = calloc(size, 1);
if (data) {
uword_t word;
sword_t offset;
page_index_t i;
for (i = 0; i < last_free_page; i++) {
/* Thanks to alignment requirements, the two low bits
* are always zero, so we can use them to store the
* allocation type -- region is always closed, so only
* the two low bits of allocation flags matter. */
word = page_table[i].scan_start_offset;
gc_assert((word & 0x03) == 0);
data[i] = word | (0x03 & page_table[i].allocated);
}
write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(4, file);
write_lispobj(size, file);
offset = write_bytes(file, (char *)data, size, core_start_pos);
write_lispobj(offset, file);
}
}
#endif
write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
/* Write a trailing header, ignored when parsing the core normally.
* This is used to locate the start of the core when the runtime is
* prepended to it. */
fseek(file, 0, SEEK_END);
/* If NULL runtime options are passed to write_runtime_options,
* command-line processing is performed as normal in the SBCL
* executable. Otherwise, the saved runtime options are used and
* all command-line arguments are available to Lisp in
* SB-EXT:*POSIX-ARGV*. */
write_runtime_options(file,
(save_runtime_options ? runtime_options : NULL));
if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
perror("Error writing core starting position to file");
fclose(file);
} else {
write_lispobj(CORE_MAGIC, file);
fclose(file);
}
#ifndef LISP_FEATURE_WIN32
if (make_executable)
chmod (filename, 0755);
#endif
printf("done]\n");
exit(0);
}
void
arch_set_pseudo_atomic_interrupted(os_context_t * context)
{
SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
}
boolean
save_to_filehandle(FILE *file, char *filename, lispobj init_function,
boolean make_executable,
boolean save_runtime_options)
{
struct thread *th;
os_vm_offset_t core_start_pos;
/* Smash the enclosing state. (Once we do this, there's no good
* way to go back, which is a sufficient reason that this ends up
* being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
printf("[undoing binding stack and other enclosing state... ");
fflush(stdout);
for_each_thread(th) { /* XXX really? */
unbind_to_here((lispobj *)th->binding_stack_start,th);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
}
printf("done]\n");
fflush(stdout);
/* (Now we can actually start copying ourselves into the output file.) */
printf("[saving current Lisp image into %s:\n", filename);
fflush(stdout);
core_start_pos = ftell(file);
write_lispobj(CORE_MAGIC, file);
write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(3, file);
write_lispobj(SBCL_CORE_VERSION_INTEGER, file);
write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (We're writing the word count of the entry here, and the 2
* term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
* word and one word where we store the count itself.) */
2 + strlen((const char *)build_id),
file);
{
unsigned char *p;
for (p = (unsigned char *)build_id; *p; ++p)
write_lispobj(*p, file);
}
write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
* entry type code, plus this count itself) */
(5*3)+2, file);
output_space(file,
READ_ONLY_CORE_SPACE_ID,
(lispobj *)READ_ONLY_SPACE_START,
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
core_start_pos);
output_space(file,
STATIC_CORE_SPACE_ID,
(lispobj *)STATIC_SPACE_START,
(lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
core_start_pos);
#ifdef LISP_FEATURE_GENCGC
/* Flush the current_region, updating the tables. */
gc_alloc_update_all_page_tables();
update_dynamic_space_free_pointer();
#endif
#ifdef reg_ALLOC
#ifdef LISP_FEATURE_GENCGC
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
dynamic_space_free_pointer,
core_start_pos);
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)current_dynamic_space,
dynamic_space_free_pointer,
core_start_pos);
#endif
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
(lispobj *)SymbolValue(ALLOCATION_POINTER,0),
core_start_pos);
#endif
write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(3, file);
write_lispobj(init_function, file);
#ifdef LISP_FEATURE_GENCGC
{
size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1)
&~(os_vm_page_size-1);
unsigned long *data = calloc(size, 1);
if (data) {
long offset;
int i;
for (i = 0; i < last_free_page; i++) {
data[i] = page_table[i].region_start_offset;
}
write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(4, file);
write_lispobj(size, file);
offset = write_bytes(file, (char *) data, size, core_start_pos);
write_lispobj(offset, file);
}
}
#endif
#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
if(n_lutexes > 0) {
long offset;
printf("writing %ld lutexes to the core...\n", n_lutexes);
write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file);
/* word count of the entry */
write_lispobj(4, file);
/* indicate how many lutexes we saved */
write_lispobj(n_lutexes, file);
/* save the lutexes */
offset = write_bytes(file, (char *) lutex_addresses,
n_lutexes * sizeof(*lutex_addresses),
core_start_pos);
write_lispobj(offset, file);
}
#endif
write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
/* Write a trailing header, ignored when parsing the core normally.
* This is used to locate the start of the core when the runtime is
* prepended to it. */
fseek(file, 0, SEEK_END);
/* If NULL runtime options are passed to write_runtime_options,
* command-line processing is performed as normal in the SBCL
* executable. Otherwise, the saved runtime options are used and
* all command-line arguments are available to Lisp in
* SB-EXT:*POSIX-ARGV*. */
write_runtime_options(file,
(save_runtime_options ? runtime_options : NULL));
if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
perror("Error writing core starting position to file");
fclose(file);
} else {
write_lispobj(CORE_MAGIC, file);
fclose(file);
}
#ifndef LISP_FEATURE_WIN32
if (make_executable)
chmod (filename, 0755);
#endif
printf("done]\n");
exit(0);
}
boolean
save_executable(char *filename, lispobj init_function)
{
char *dir_name;
#if defined WANT_CGC
volatile lispobj *func_ptr = &init_function;
char sbuf[128];
strcpy(sbuf, filename);
filename = sbuf;
/* Get rid of remnant stuff. This is a MUST so that
* the memory manager can get started correctly when
* we restart after this save. Purify is going to
* maybe move the args so we need to consider them volatile,
* especially if the gcc optimizer is working!!
*/
purify(NIL, NIL);
init_function = *func_ptr;
/* Set dynamic space pointer to base value so we don't write out
* MBs of just cleared heap.
*/
if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START);
#endif
dir_name = dirname(strdup(filename));
printf("[Undoing binding stack... ");
fflush(stdout);
unbind_to_here((lispobj *)BINDING_STACK_START);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
SetSymbolValue(EVAL_STACK_TOP, 0);
printf("done]\n");
#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
SetSymbolValue(X86_CGC_ACTIVE_P, T);
#endif
printf("[Saving current lisp image as executable into \"%s\":\n", filename);
printf("\t[Writing core objects\n");
fflush(stdout);
write_space_object(dir_name, READ_ONLY_SPACE_ID, (os_vm_address_t)read_only_space,
(os_vm_address_t)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
write_space_object(dir_name, STATIC_SPACE_ID, (os_vm_address_t)static_space,
(os_vm_address_t)SymbolValue(STATIC_SPACE_FREE_POINTER));
#ifdef GENCGC
/* Flush the current_region updating the tables. */
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "before ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
dump_region(&boxed_region);
#endif
gc_alloc_update_page_tables(0,&boxed_region);
gc_alloc_update_page_tables(1,&unboxed_region);
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "boxed_region after update\n");
dump_region(&boxed_region);
print_ptr((lispobj*) 0x2805a184);
#endif
#ifdef DEBUG_BAD_HEAP
/*
* For some reason x86 has a heap corruption problem. I (rtoy)
* have not been able to figure out how that occurs, but what is
* happening is that when a core is loaded, there is some static
* object pointing to an object that is on a free page. In normal
* usage, at startup there should be 4 objects in static space
* pointing to a free page, because these are newly allocated
* objects created by the C runtime. However, there is an
* additional object.
*
* I do not know what this object should be or how it got there,
* but it will often cause CMUCL to fail to save a new core file.
*
* Disabling this call to update_dynamic_space_free_pointer is a
* work around. What is happening is that u_d_s_f_p is resetting
* ALLOCATION_POINTER, but that weird object is in the current
* region, but after resetting the pointer, that object isn't
* saved to the core file. By not resetting the pointer, the
* object (or at least enough of it) gets saved in the core file
* that we don't have problems when reloading.
*
* Note that on sparc and ppc, u_d_s_f_p doesn't actually do
* anything because the call to reset ALLOCATION_POINTER is a nop
* on sparc and ppc. And sparc and ppc dont' have the heap
* corruption issue. That's not conclusive evidence, though.
*
* This needs more work and investigation.
*/
update_dynamic_space_free_pointer();
#endif
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "after ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
#endif
#endif
#ifdef reg_ALLOC
write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
(os_vm_address_t)current_dynamic_space_free_pointer);
#else
write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
(os_vm_address_t)SymbolValue(ALLOCATION_POINTER));
#endif
printf("\tdone]\n");
fflush(stdout);
printf("Linking executable...\n");
fflush(stdout);
obj_run_linker(init_function, filename);
printf("done.\n");
exit(0);
}
void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
{
SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,NIL,0);
}
void arch_set_pseudo_atomic_interrupted(os_context_t *context)
{
/* 0x000f0001 is the syscall number for BREAK_POINT. */
SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,MAKE_FIXNUM(0x000f0001),0);
}
