Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / save.c
CommitLineData
82a2bc67 1/*
2
82a2bc67 3 This code was written as part of the CMU Common Lisp project at
4 Carnegie Mellon University, and has been placed in the public domain.
5
6*/
7
62957726 8
9#include <stdio.h>
10#include <signal.h>
3cefc21b 11#include <stdlib.h>
46ecd939 12#include <string.h>
62957726 13
14#include "lisp.h"
15#include "os.h"
16#include "internals.h"
17#include "core.h"
18#include "globals.h"
62957726 19#include "save.h"
5eb10b17 20#include "lispregs.h"
62957726 21#include "validate.h"
c66586ed 22#include "dynbind.h"
62957726 23
0c41e522 24#ifdef GENCGC
25#include "gencgc.h"
26#endif
27
757179b1 28#ifdef FEATURE_EXECUTABLE
35bcce9b 29#include "elf.h"
4e07640f 30#if !(defined(DARWIN) && defined(__ppc__))
05257d2a 31#include <libgen.h>
13e1c055 32#endif
dc8b7cc2 33#endif
13e1c055 34
62957726 35extern int version;
36
9a8c1c2f 37static long
38write_bytes(FILE * file, char *addr, long bytes)
62957726 39{
e0ba1b6d 40 long count, here, data;
41
42 bytes = (bytes + CORE_PAGESIZE - 1) & ~(CORE_PAGESIZE - 1);
43
44 fflush(file);
45 here = ftell(file);
46 fseek(file, 0, 2);
47 data = (ftell(file) + CORE_PAGESIZE - 1) & ~(CORE_PAGESIZE - 1);
48 fseek(file, data, 0);
49
50 while (bytes > 0) {
51 count = fwrite(addr, 1, bytes, file);
52 if (count > 0) {
53 bytes -= count;
54 addr += count;
55 } else {
56 perror("Error writing to save file");
57 bytes = 0;
58 }
59 }
60 fflush(file);
61 fseek(file, here, 0);
62 return data / CORE_PAGESIZE - 1;
62957726 63}
64
9a8c1c2f 65static void
66output_space(FILE * file, int id, lispobj * addr, lispobj * end)
62957726 67{
68 int words, bytes, data;
9a8c1c2f 69 static char *names[] = { NULL, "Dynamic", "Static", "Read-Only" };
62957726 70
71 putw(id, file);
72 words = end - addr;
73 putw(words, file);
74
75 bytes = words * sizeof(lispobj);
76
0ac2c885 77 printf("Writing %d bytes from the %s space at 0x%08lX.\n",
9a8c1c2f 78 bytes, names[id], (unsigned long) addr);
62957726 79
9a8c1c2f 80 data = write_bytes(file, (char *) addr, bytes);
62957726 81
82 putw(data, file);
c66586ed 83 putw((long) addr / CORE_PAGESIZE, file);
62957726 84 putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, file);
85}
86
f22fe508 87#ifdef DEBUG_BAD_HEAP
88static void
89dump_region(struct alloc_region *alloc_region)
90{
91 fprintf(stderr, "free_pointer = %p\n", alloc_region->free_pointer);
92 fprintf(stderr, "end_addr = %p\n", alloc_region->end_addr);
93 fprintf(stderr, "first_page = %d\n", alloc_region->first_page);
94 fprintf(stderr, "last_page = %d\n", alloc_region->last_page);
95 fprintf(stderr, "start_addr = %p\n", alloc_region->start_addr);
96
97 fprintf(stderr, " page_table[%d]\n", alloc_region->first_page);
98 fprintf(stderr, " flags = %x\n", page_table[alloc_region->first_page].flags);
99 fprintf(stderr, " offset = %x\n", page_table[alloc_region->first_page].first_object_offset);
100 fprintf(stderr, " used = %x\n", page_table[alloc_region->first_page].bytes_used);
101}
102#endif
103
9a8c1c2f 104boolean
29f1fd98 105save(char *filename, lispobj init_function, int sse2_mode)
62957726 106{
5eb10b17 107 FILE *file;
9a8c1c2f 108
5ced0fdf 109#if defined WANT_CGC
9a8c1c2f 110 volatile lispobj *func_ptr = &init_function;
5ced0fdf 111 char sbuf[128];
9a8c1c2f 112
113 strcpy(sbuf, filename);
114 filename = sbuf;
5ced0fdf 115 /* Get rid of remnant stuff. This is a MUST so that
116 * the memory manager can get started correctly when
117 * we restart after this save. Purify is going to
118 * maybe move the args so we need to consider them volatile,
119 * especially if the gcc optimizer is working!!
120 */
9a8c1c2f 121 purify(NIL, NIL);
5ced0fdf 122
123 init_function = *func_ptr;
124 /* Set dynamic space pointer to base value so we don't write out
125 * MBs of just cleared heap.
126 */
9a8c1c2f 127 if (SymbolValue(X86_CGC_ACTIVE_P) != NIL)
128 SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START);
5ced0fdf 129#endif
5eb10b17 130 /* Open the file: */
86bc9d98 131 remove(filename);
5eb10b17 132 file = fopen(filename, "w");
133 if (file == NULL) {
9a8c1c2f 134 perror(filename);
135 return TRUE;
5eb10b17 136 }
137 printf("[Undoing binding stack... ");
138 fflush(stdout);
9a8c1c2f 139 unbind_to_here((lispobj *) BINDING_STACK_START);
5eb10b17 140 SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
141 SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
142 SetSymbolValue(EVAL_STACK_TOP, 0);
143 printf("done]\n");
5ced0fdf 144#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
145 SetSymbolValue(X86_CGC_ACTIVE_P, T);
146#endif
5eb10b17 147 printf("[Saving current lisp image into %s:\n", filename);
62957726 148
149 putw(CORE_MAGIC, file);
150
151 putw(CORE_VERSION, file);
29f1fd98 152#if defined(i386) && defined(FEATURE_SSE2)
cb786538 153 putw(4, file);
154#else
62957726 155 putw(3, file);
cb786538 156#endif
62957726 157 putw(version, file);
29f1fd98 158
159#if defined(i386) && defined(FEATURE_SSE2)
160 if (sse2_mode) {
161 putw(SSE2, file);
162 } else {
163 putw(X87, file);
164 }
cb786538 165#endif
166
62957726 167 putw(CORE_NDIRECTORY, file);
9a8c1c2f 168 putw((5 * 3) + 2, file);
62957726 169
170 output_space(file, READ_ONLY_SPACE_ID, read_only_space,
9a8c1c2f 171 (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
62957726 172 output_space(file, STATIC_SPACE_ID, static_space,
9a8c1c2f 173 (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER));
0c41e522 174#ifdef GENCGC
175 /* Flush the current_region updating the tables. */
f22fe508 176#ifdef DEBUG_BAD_HEAP
177 fprintf(stderr, "before ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
178 dump_region(&boxed_region);
13e1c055 179#endif
9a8c1c2f 180 gc_alloc_update_page_tables(0, &boxed_region);
181 gc_alloc_update_page_tables(1, &unboxed_region);
f22fe508 182#ifdef DEBUG_BAD_HEAP
183 fprintf(stderr, "boxed_region after update\n");
184 dump_region(&boxed_region);
185
186 print_ptr((lispobj*) 0x2805a184);
187#endif
e0ba1b6d 188
f22fe508 189#ifdef DEBUG_BAD_HEAP
190 /*
191 * For some reason x86 has a heap corruption problem. I (rtoy)
192 * have not been able to figure out how that occurs, but what is
193 * happening is that when a core is loaded, there is some static
194 * object pointing to an object that is on a free page. In normal
195 * usage, at startup there should be 4 objects in static space
196 * pointing to a free page, because these are newly allocated
197 * objects created by the C runtime. However, there is an
198 * additional object.
199 *
200 * I do not know what this object should be or how it got there,
201 * but it will often cause CMUCL to fail to save a new core file.
202 *
203 * Disabling this call to update_dynamic_space_free_pointer is a
204 * work around. What is happening is that u_d_s_f_p is resetting
205 * ALLOCATION_POINTER, but that weird object is in the current
206 * region, but after resetting the pointer, that object isn't
207 * saved to the core file. By not resetting the pointer, the
208 * object (or at least enough of it) gets saved in the core file
209 * that we don't have problems when reloading.
210 *
211 * Note that on sparc and ppc, u_d_s_f_p doesn't actually do
212 * anything because the call to reset ALLOCATION_POINTER is a nop
213 * on sparc and ppc. And sparc and ppc dont' have the heap
214 * corruption issue. That's not conclusive evidence, though.
215 *
216 * This needs more work and investigation.
217 */
af867264 218 update_dynamic_space_free_pointer();
0c41e522 219#endif
af867264 220
f22fe508 221#ifdef DEBUG_BAD_HEAP
222 fprintf(stderr, "after ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
223#endif
224#endif
225
af867264 226#ifdef reg_ALLOC
227 output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space,
228 current_dynamic_space_free_pointer);
229#else
62957726 230 output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space,
9a8c1c2f 231 (lispobj *) SymbolValue(ALLOCATION_POINTER));
62957726 232#endif
233
5eb10b17 234 putw(CORE_INITIAL_FUNCTION, file);
235 putw(3, file);
236 putw(init_function, file);
62957726 237
238 putw(CORE_END, file);
239 fclose(file);
240
241 printf("done.]\n");
242
5eb10b17 243 exit(0);
62957726 244}
13e1c055 245
e0ba1b6d 246
757179b1 247#ifdef FEATURE_EXECUTABLE
13e1c055 248boolean
249save_executable(char *filename, lispobj init_function)
250{
95322e54 251 char *dir_name;
13e1c055 252
253#if defined WANT_CGC
254 volatile lispobj *func_ptr = &init_function;
255 char sbuf[128];
256
257 strcpy(sbuf, filename);
258 filename = sbuf;
259 /* Get rid of remnant stuff. This is a MUST so that
260 * the memory manager can get started correctly when
261 * we restart after this save. Purify is going to
262 * maybe move the args so we need to consider them volatile,
263 * especially if the gcc optimizer is working!!
264 */
265 purify(NIL, NIL);
266
267 init_function = *func_ptr;
268 /* Set dynamic space pointer to base value so we don't write out
269 * MBs of just cleared heap.
270 */
271 if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
272 SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START);
273#endif
95322e54 274 dir_name = dirname(strdup(filename));
275
13e1c055 276 printf("[Undoing binding stack... ");
277 fflush(stdout);
278 unbind_to_here((lispobj *)BINDING_STACK_START);
279 SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
280 SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
281 SetSymbolValue(EVAL_STACK_TOP, 0);
282 printf("done]\n");
283#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
284 SetSymbolValue(X86_CGC_ACTIVE_P, T);
285#endif
286 printf("[Saving current lisp image as executable into \"%s\":\n", filename);
287
a5cd2c4f 288 printf("\t[Writing core objects\n");
13e1c055 289 fflush(stdout);
35bcce9b 290 write_space_object(dir_name, READ_ONLY_SPACE_ID, (os_vm_address_t)read_only_space,
291 (os_vm_address_t)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
292 write_space_object(dir_name, STATIC_SPACE_ID, (os_vm_address_t)static_space,
293 (os_vm_address_t)SymbolValue(STATIC_SPACE_FREE_POINTER));
13e1c055 294#ifdef GENCGC
295 /* Flush the current_region updating the tables. */
296#ifdef DEBUG_BAD_HEAP
297 fprintf(stderr, "before ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
298 dump_region(&boxed_region);
299#endif
300 gc_alloc_update_page_tables(0,&boxed_region);
301 gc_alloc_update_page_tables(1,&unboxed_region);
302#ifdef DEBUG_BAD_HEAP
303 fprintf(stderr, "boxed_region after update\n");
304 dump_region(&boxed_region);
305
306 print_ptr((lispobj*) 0x2805a184);
307#endif
308#ifdef DEBUG_BAD_HEAP
309 /*
310 * For some reason x86 has a heap corruption problem. I (rtoy)
311 * have not been able to figure out how that occurs, but what is
312 * happening is that when a core is loaded, there is some static
313 * object pointing to an object that is on a free page. In normal
314 * usage, at startup there should be 4 objects in static space
315 * pointing to a free page, because these are newly allocated
316 * objects created by the C runtime. However, there is an
317 * additional object.
318 *
319 * I do not know what this object should be or how it got there,
320 * but it will often cause CMUCL to fail to save a new core file.
321 *
322 * Disabling this call to update_dynamic_space_free_pointer is a
323 * work around. What is happening is that u_d_s_f_p is resetting
324 * ALLOCATION_POINTER, but that weird object is in the current
325 * region, but after resetting the pointer, that object isn't
326 * saved to the core file. By not resetting the pointer, the
327 * object (or at least enough of it) gets saved in the core file
328 * that we don't have problems when reloading.
329 *
330 * Note that on sparc and ppc, u_d_s_f_p doesn't actually do
331 * anything because the call to reset ALLOCATION_POINTER is a nop
332 * on sparc and ppc. And sparc and ppc dont' have the heap
333 * corruption issue. That's not conclusive evidence, though.
334 *
335 * This needs more work and investigation.
336 */
337 update_dynamic_space_free_pointer();
338#endif
339
340#ifdef DEBUG_BAD_HEAP
341 fprintf(stderr, "after ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
342#endif
343#endif
344
13e1c055 345#ifdef reg_ALLOC
35bcce9b 346 write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
347 (os_vm_address_t)current_dynamic_space_free_pointer);
13e1c055 348#else
35bcce9b 349 write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
350 (os_vm_address_t)SymbolValue(ALLOCATION_POINTER));
13e1c055 351#endif
352
a5cd2c4f 353 printf("\tdone]\n");
13e1c055 354 fflush(stdout);
355
356 printf("Linking executable...\n");
357 fflush(stdout);
35bcce9b 358 obj_run_linker(init_function, filename);
13e1c055 359 printf("done.\n");
360 exit(0);
361}
362#endif