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