0.6.10.4:
[sbcl.git] / src / runtime / save.c
1 /*
2  * This software is part of the SBCL system. See the README file for
3  * more information.
4  *
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.
10  */
11
12 #include <stdio.h>
13 #include <signal.h>
14 #include <sys/file.h>
15
16 #include "runtime.h"
17 #include "os.h"
18 #include "sbcl.h"
19 #include "core.h"
20 #include "globals.h"
21 #include "save.h"
22 #include "dynbind.h"
23 #include "lispregs.h"
24 #include "validate.h"
25
26 #ifdef GENCGC
27 #include "gencgc.h"
28 #endif
29
30 static long
31 write_bytes(FILE *file, char *addr, long bytes)
32 {
33     long count, here, data;
34
35     bytes = (bytes+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1);
36
37     fflush(file);
38     here = ftell(file);
39     fseek(file, 0, 2);
40     data = (ftell(file)+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1);
41     fseek(file, data, 0);
42
43     while (bytes > 0) {
44         count = fwrite(addr, 1, bytes, file);
45         if (count > 0) {
46             bytes -= count;
47             addr += count;
48         }
49         else {
50             perror("error writing to save file");
51             bytes = 0;
52         }
53     }
54     fflush(file);
55     fseek(file, here, 0);
56     return data/CORE_PAGESIZE - 1;
57 }
58
59 static void
60 output_space(FILE *file, int id, lispobj *addr, lispobj *end)
61 {
62     int words, bytes, data;
63     static char *names[] = {NULL, "dynamic", "static", "read-only"};
64
65     putw(id, file);
66     words = end - addr;
67     putw(words, file);
68
69     bytes = words * sizeof(lispobj);
70
71     printf("writing %d bytes from the %s space at 0x%08lx\n",
72            bytes, names[id], (unsigned long)addr);
73
74     data = write_bytes(file, (char *)addr, bytes);
75
76     putw(data, file);
77     putw((long)addr / CORE_PAGESIZE, file);
78     putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, file);
79 }
80
81 boolean
82 save(char *filename, lispobj init_function)
83 {
84     FILE *file;
85 #if defined WANT_CGC
86     volatile lispobj*func_ptr = &init_function;
87     char sbuf[128];
88     strcpy(sbuf,filename);
89     filename=sbuf;
90     /* Get rid of remnant stuff. This is a MUST so that the memory
91      * manager can get started correctly when we restart after this
92      * save. Purify is going to maybe move the args so we need to
93      * consider them volatile, especially if the gcc optimizer is
94      * working!! */
95     purify(NIL,NIL);
96
97     init_function = *func_ptr;
98     /* Set dynamic space pointer to base value so we don't write out
99      * MBs of just cleared heap. */
100     if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
101       SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_SPACE_START);
102 #endif
103     /* Open the file: */
104     unlink(filename);
105     file = fopen(filename, "w");
106     if (file == NULL) {
107         perror(filename);
108         return 1;
109     }
110     printf("[undoing binding stack... ");
111     fflush(stdout);
112     unbind_to_here((lispobj *)BINDING_STACK_START);
113     SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
114     SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
115     SetSymbolValue(EVAL_STACK_TOP, 0);
116     printf("done]\n");
117 #if defined WANT_CGC && defined X86_CGC_ACTIVE_P
118     SetSymbolValue(X86_CGC_ACTIVE_P, T);
119 #endif
120     printf("[saving current Lisp image into %s:\n", filename);
121
122     putw(CORE_MAGIC, file);
123
124     putw(CORE_VERSION, file);
125     putw(3, file);
126     putw(SBCL_CORE_VERSION_INTEGER, file);
127
128     putw(CORE_NDIRECTORY, file);
129     putw((5*3)+2, file);
130
131     output_space(file, READ_ONLY_SPACE_ID, (lispobj *)READ_ONLY_SPACE_START,
132                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
133     output_space(file, STATIC_SPACE_ID, (lispobj *)STATIC_SPACE_START,
134                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
135 #ifdef reg_ALLOC
136     output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START,
137                  dynamic_space_free_pointer);
138 #else
139 #ifdef GENCGC
140     /* Flush the current_region updating the tables. */
141     gc_alloc_update_page_tables(0,&boxed_region);
142     gc_alloc_update_page_tables(1,&unboxed_region);
143     update_x86_dynamic_space_free_pointer();
144 #endif
145     output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START,
146                  (lispobj *)SymbolValue(ALLOCATION_POINTER));
147 #endif
148
149     putw(CORE_INITIAL_FUNCTION, file);
150     putw(3, file);
151     putw(init_function, file);
152
153     putw(CORE_END, file);
154     fclose(file);
155
156     printf("done]\n");
157
158     exit(0);
159 }