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.
26 #include "gc-internal.h"
29 write_bytes(FILE *file, char *addr, long bytes)
31 long count, here, data;
33 bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
38 data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
42 count = fwrite(addr, 1, bytes, file);
48 perror("error writing to save file");
54 return data/os_vm_page_size - 1;
58 output_space(FILE *file, int id, lispobj *addr, lispobj *end)
60 int words, bytes, data;
61 static char *names[] = {NULL, "dynamic", "static", "read-only"};
67 bytes = words * sizeof(lispobj);
69 printf("writing %d bytes from the %s space at 0x%08lx\n",
70 bytes, names[id], (unsigned long)addr);
72 data = write_bytes(file, (char *)addr, bytes);
75 putw((long)addr / os_vm_page_size, file);
76 putw((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
80 save(char *filename, lispobj init_function)
84 /* Open the output file. We don't actually need the file yet, but
85 * the fopen() might fail for some reason, and we want to detect
86 * that and back out before we do anything irreversible. */
88 file = fopen(filename, "w");
94 /* Smash the enclosing state. (Once we do this, there's no good
95 * way to go back, which is a sufficient reason that this ends up
96 * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
97 printf("[undoing binding stack and other enclosing state... ");
99 unbind_to_here((lispobj *)BINDING_STACK_START);
100 SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
101 SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
105 /* (Now we can actually start copying ourselves into the output file.) */
107 printf("[saving current Lisp image into %s:\n", filename);
110 putw(CORE_MAGIC, file);
112 putw(VERSION_CORE_ENTRY_TYPE_CODE, file);
114 putw(SBCL_CORE_VERSION_INTEGER, file);
116 putw(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
117 putw(/* (We're writing the word count of the entry here, and the 2
118 * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
119 * word and one word where we store the count itself.) */
120 2 + strlen(build_id),
124 for (p = build_id; *p; ++p)
128 putw(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
129 putw(/* (word count = 3 spaces described by 5 words each, plus the
130 * entry type code, plus this count itself) */
133 READ_ONLY_CORE_SPACE_ID,
134 (lispobj *)READ_ONLY_SPACE_START,
135 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
137 STATIC_CORE_SPACE_ID,
138 (lispobj *)STATIC_SPACE_START,
139 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
142 DYNAMIC_CORE_SPACE_ID,
143 (lispobj *)current_dynamic_space,
144 dynamic_space_free_pointer);
146 #ifdef LISP_FEATURE_GENCGC
147 /* I don't know too much about the circumstances in which we could
148 * end up here. It may be that current_region_free_pointer is
149 * guaranteed to be relevant and we could skip these slightly
150 * paranoid checks. TRT would be to rid the code of
151 * current_region_foo completely - dan 2002.09.17 */
152 if((boxed_region.free_pointer < current_region_free_pointer) &&
153 (boxed_region.end_addr == current_region_end_addr))
154 boxed_region.free_pointer = current_region_free_pointer;
155 /* Flush the current_region, updating the tables. */
156 gc_alloc_update_page_tables(0,&boxed_region);
157 gc_alloc_update_page_tables(1,&unboxed_region);
158 update_x86_dynamic_space_free_pointer();
161 DYNAMIC_CORE_SPACE_ID,
162 (lispobj *)DYNAMIC_SPACE_START,
163 (lispobj *)SymbolValue(ALLOCATION_POINTER));
166 putw(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
168 putw(init_function, file);
170 putw(END_CORE_ENTRY_TYPE_CODE, file);