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