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);
}
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);
}
