2 * This software is part of the SBCL system. See the README file for
5 * This software is derived from the CMU CL system, which was
6 * written at Carnegie Mellon University and released into the
7 * public domain. The software is in the public domain and is
8 * provided with absolutely no warranty. See the COPYING and CREDITS
9 * files for more information.
12 #ifndef LISP_FEATURE_WIN32
13 #include <sys/types.h>
31 #include "gc-internal.h"
34 #include "genesis/static-symbols.h"
35 #include "genesis/symbol.h"
37 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
38 #include "genesis/lutex.h"
42 write_lispobj(lispobj obj, FILE *file)
44 fwrite(&obj, sizeof(lispobj), 1, file);
48 write_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset)
50 long count, here, data;
52 bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
54 #ifdef LISP_FEATURE_WIN32
55 /* touch every single page in the space to force it to be mapped. */
56 for (count = 0; count < bytes; count += 0x1000) {
57 volatile int temp = addr[count];
63 fseek(file, 0, SEEK_END);
64 data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
65 fseek(file, data, SEEK_SET);
68 count = fwrite(addr, 1, bytes, file);
74 perror("error writing to save file");
79 fseek(file, here, SEEK_SET);
80 return ((data - file_offset) / os_vm_page_size) - 1;
83 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
84 /* saving lutexes in the core */
85 static void **lutex_addresses;
86 static long n_lutexes = 0;
87 static long max_lutexes = 0;
90 default_scan_action(lispobj *obj)
92 return (sizetab[widetag_of(*obj)])(obj);
96 lutex_scan_action(lispobj *obj)
98 /* note the address of the lutex */
99 if(n_lutexes >= max_lutexes) {
101 lutex_addresses = realloc(lutex_addresses, max_lutexes * sizeof(void *));
102 gc_assert(lutex_addresses);
105 lutex_addresses[n_lutexes++] = obj;
107 return (*sizetab[widetag_of(*obj)])(obj);
110 typedef long (*scan_table[256])(lispobj *obj);
113 scan_objects(lispobj *start, long n_words, scan_table table)
115 lispobj *end = start + n_words;
117 long n_words_scanned;
118 for (object_ptr = start;
120 object_ptr += n_words_scanned) {
121 lispobj obj = *object_ptr;
123 n_words_scanned = (table[widetag_of(obj)])(object_ptr);
128 scan_for_lutexes(lispobj *addr, long n_words)
130 static int initialized = 0;
131 static scan_table lutex_scan_table;
136 /* allocate a little space to get started */
137 lutex_addresses = malloc(16*sizeof(void *));
138 gc_assert(lutex_addresses);
141 /* initialize the mapping table */
142 for(i = 0; i < ((sizeof lutex_scan_table)/(sizeof lutex_scan_table[0])); ++i) {
143 lutex_scan_table[i] = default_scan_action;
146 lutex_scan_table[LUTEX_WIDETAG] = lutex_scan_action;
152 scan_objects(addr, n_words, lutex_scan_table);
157 output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset)
159 size_t words, bytes, data;
160 static char *names[] = {NULL, "dynamic", "static", "read-only"};
162 write_lispobj(id, file);
164 write_lispobj(words, file);
166 bytes = words * sizeof(lispobj);
168 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
169 printf("scanning space for lutexes...\n");
170 scan_for_lutexes((char *)addr, words);
173 printf("writing %lu bytes from the %s space at 0x%08lx\n",
174 (unsigned long)bytes, names[id], (unsigned long)addr);
176 data = write_bytes(file, (char *)addr, bytes, file_offset);
178 write_lispobj(data, file);
179 write_lispobj((long)addr / os_vm_page_size, file);
180 write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
184 open_core_for_saving(char *filename)
186 /* Open the output file. We don't actually need the file yet, but
187 * the fopen() might fail for some reason, and we want to detect
188 * that and back out before we do anything irreversible. */
190 return fopen(filename, "wb");
194 save_to_filehandle(FILE *file, char *filename, lispobj init_function,
195 boolean make_executable)
198 os_vm_offset_t core_start_pos, core_end_pos, core_size;
200 /* Smash the enclosing state. (Once we do this, there's no good
201 * way to go back, which is a sufficient reason that this ends up
202 * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
203 printf("[undoing binding stack and other enclosing state... ");
205 for_each_thread(th) { /* XXX really? */
206 unbind_to_here((lispobj *)th->binding_stack_start,th);
207 SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
208 SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
213 /* (Now we can actually start copying ourselves into the output file.) */
215 printf("[saving current Lisp image into %s:\n", filename);
218 core_start_pos = ftell(file);
219 write_lispobj(CORE_MAGIC, file);
221 write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
222 write_lispobj(3, file);
223 write_lispobj(SBCL_CORE_VERSION_INTEGER, file);
225 write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
226 write_lispobj(/* (We're writing the word count of the entry here, and the 2
227 * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
228 * word and one word where we store the count itself.) */
229 2 + strlen((const char *)build_id),
233 for (p = (unsigned char *)build_id; *p; ++p)
234 write_lispobj(*p, file);
237 write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
238 write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
239 * entry type code, plus this count itself) */
242 READ_ONLY_CORE_SPACE_ID,
243 (lispobj *)READ_ONLY_SPACE_START,
244 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
247 STATIC_CORE_SPACE_ID,
248 (lispobj *)STATIC_SPACE_START,
249 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
251 #ifdef LISP_FEATURE_GENCGC
252 /* Flush the current_region, updating the tables. */
253 gc_alloc_update_all_page_tables();
254 update_dynamic_space_free_pointer();
257 #ifdef LISP_FEATURE_GENCGC
259 DYNAMIC_CORE_SPACE_ID,
260 (lispobj *)DYNAMIC_SPACE_START,
261 dynamic_space_free_pointer,
265 DYNAMIC_CORE_SPACE_ID,
266 (lispobj *)current_dynamic_space,
267 dynamic_space_free_pointer,
272 DYNAMIC_CORE_SPACE_ID,
273 (lispobj *)DYNAMIC_SPACE_START,
274 (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
278 write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
279 write_lispobj(3, file);
280 write_lispobj(init_function, file);
282 #ifdef LISP_FEATURE_GENCGC
284 size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1)
285 &~(os_vm_page_size-1);
286 long *data = calloc(size, 1);
290 for (i = 0; i < last_free_page; i++) {
291 data[i] = page_table[i].first_object_offset;
293 write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
294 write_lispobj(4, file);
295 write_lispobj(size, file);
296 offset = write_bytes(file, (char *) data, size, core_start_pos);
297 write_lispobj(offset, file);
302 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
305 printf("writing %ld lutexes to the core...\n", n_lutexes);
306 write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file);
307 /* word count of the entry */
308 write_lispobj(4, file);
309 /* indicate how many lutexes we saved */
310 write_lispobj(n_lutexes, file);
311 /* save the lutexes */
312 offset = write_bytes(file, (char *) lutex_addresses,
313 n_lutexes * sizeof(*lutex_addresses),
316 write_lispobj(offset, file);
320 write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
322 /* Write a trailing header, ignored when parsing the core normally.
323 * This is used to locate the start of the core when the runtime is
324 * prepended to it. */
325 fseek(file, 0, SEEK_END);
326 core_end_pos = ftell(file);
327 core_size = core_end_pos - core_start_pos;
329 fwrite(&core_size, sizeof(os_vm_offset_t), 1, file);
330 write_lispobj(CORE_MAGIC, file);
333 #ifndef LISP_FEATURE_WIN32
335 chmod (filename, 0755);
342 /* Slurp the executable portion of the runtime into a malloced buffer
343 * and return it. Places the size in bytes of the runtime into
344 * 'size_out'. Returns NULL if the runtime cannot be loaded from
347 load_runtime(char *runtime_path, size_t *size_out)
352 os_vm_offset_t core_offset;
354 core_offset = search_for_embedded_core (runtime_path);
355 if ((input = fopen(runtime_path, "rb")) == NULL) {
356 fprintf(stderr, "Unable to open runtime: %s\n", runtime_path);
360 fseek(input, 0, SEEK_END);
361 size = (size_t) ftell(input);
362 fseek(input, 0, SEEK_SET);
364 if (core_offset != -1 && size > core_offset)
367 buf = successful_malloc(size);
368 if ((count = fread(buf, 1, size, input)) != size) {
369 fprintf(stderr, "Premature EOF while reading runtime.\n");
386 save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
391 fwrite(runtime, 1, runtime_size, output);
393 padding = (os_vm_page_size - (runtime_size % os_vm_page_size)) & ~os_vm_page_size;
395 padbytes = successful_malloc(padding);
396 memset(padbytes, 0, padding);
397 fwrite(padbytes, 1, padding, output);
405 prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
406 size_t *runtime_size)
411 if (prepend_runtime) {
412 runtime_path = os_get_runtime_executable_path();
414 if (runtime_path == NULL) {
415 fprintf(stderr, "Unable to get default runtime path.\n");
419 *runtime_bytes = load_runtime(runtime_path, runtime_size);
422 if (*runtime_bytes == NULL)
426 file = open_core_for_saving(filename);
428 free(*runtime_bytes);
437 save(char *filename, lispobj init_function, boolean prepend_runtime)
440 void *runtime_bytes = NULL;
443 file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
448 save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
450 return save_to_filehandle(file, filename, init_function, prepend_runtime);