static void output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset, int core_compression_level) { size_t words, bytes, data, compressed_flag; static char *names[] = {NULL, "dynamic", "static", "read-only", "immobile", "immobile"}; compressed_flag = ((core_compression_level != COMPRESSION_LEVEL_NONE) ? DEFLATED_CORE_SPACE_ID_FLAG : 0); write_lispobj(id | compressed_flag, file); words = end - addr; write_lispobj(words, file); bytes = words * sizeof(lispobj); printf("writing %lu bytes from the %s space at %p\n", bytes, names[id], addr); data = write_and_compress_bytes(file, (char *)addr, bytes, file_offset, core_compression_level); write_lispobj(data, file); write_lispobj((uword_t)addr / os_vm_page_size, file); write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file); }
static void output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset) { size_t words, bytes, data; static char *names[] = {NULL, "dynamic", "static", "read-only"}; write_lispobj(id, file); words = end - addr; write_lispobj(words, file); bytes = words * sizeof(lispobj); #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) printf("scanning space for lutexes...\n"); scan_for_lutexes((char *)addr, words); #endif printf("writing %lu bytes from the %s space at 0x%08lx\n", (unsigned long)bytes, names[id], (unsigned long)addr); data = write_bytes(file, (char *)addr, bytes, file_offset); write_lispobj(data, file); write_lispobj((long)addr / os_vm_page_size, file); write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file); }
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); }