0.8.7.57:
[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 <stdlib.h>
13 #include <stdio.h>
14 #include <signal.h>
15 #include <sys/file.h>
16
17 #include "sbcl.h"
18 #include "runtime.h"
19 #include "os.h"
20 #include "core.h"
21 #include "globals.h"
22 #include "save.h"
23 #include "dynbind.h"
24 #include "lispregs.h"
25 #include "validate.h"
26 #include "gc-internal.h"
27 #include "thread.h"
28
29 #include "genesis/static-symbols.h"
30 #include "genesis/symbol.h"
31
32 static long
33 write_bytes(FILE *file, char *addr, long bytes)
34 {
35     long count, here, data;
36
37     bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
38
39     fflush(file);
40     here = ftell(file);
41     fseek(file, 0, 2);
42     data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
43     fseek(file, data, 0);
44
45     while (bytes > 0) {
46         count = fwrite(addr, 1, bytes, file);
47         if (count > 0) {
48             bytes -= count;
49             addr += count;
50         }
51         else {
52             perror("error writing to save file");
53             bytes = 0;
54         }
55     }
56     fflush(file);
57     fseek(file, here, 0);
58     return data/os_vm_page_size - 1;
59 }
60
61 static void
62 output_space(FILE *file, int id, lispobj *addr, lispobj *end)
63 {
64     int words, bytes, data;
65     static char *names[] = {NULL, "dynamic", "static", "read-only"};
66
67     putw(id, file);
68     words = end - addr;
69     putw(words, file);
70
71     bytes = words * sizeof(lispobj);
72
73     printf("writing %d bytes from the %s space at 0x%08lx\n",
74            bytes, names[id], (unsigned long)addr);
75
76     data = write_bytes(file, (char *)addr, bytes);
77
78     putw(data, file);
79     putw((long)addr / os_vm_page_size, file);
80     putw((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
81 }
82
83 boolean
84 save(char *filename, lispobj init_function)
85 {
86     FILE *file;
87     struct thread *th;
88
89     /* Open the output file. We don't actually need the file yet, but
90      * the fopen() might fail for some reason, and we want to detect
91      * that and back out before we do anything irreversible. */
92     unlink(filename);
93     file = fopen(filename, "w");
94     if (!file) {
95         perror(filename);
96         return 1;
97     }
98
99     /* Smash the enclosing state. (Once we do this, there's no good
100      * way to go back, which is a sufficient reason that this ends up
101      * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
102     printf("[undoing binding stack and other enclosing state... ");
103     fflush(stdout);
104     for_each_thread(th) {       /* XXX really? */
105         unbind_to_here((lispobj *)th->binding_stack_start,th);
106         SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
107         SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
108     }
109     printf("done]\n");
110     fflush(stdout);
111     
112     /* (Now we can actually start copying ourselves into the output file.) */
113
114     printf("[saving current Lisp image into %s:\n", filename);
115     fflush(stdout);
116
117     putw(CORE_MAGIC, file);
118
119     putw(VERSION_CORE_ENTRY_TYPE_CODE, file);
120     putw(3, file);
121     putw(SBCL_CORE_VERSION_INTEGER, file);
122
123     putw(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
124     putw(/* (We're writing the word count of the entry here, and the 2
125           * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
126           * word and one word where we store the count itself.) */
127          2 + strlen(build_id),
128          file);
129     {
130         char *p;
131         for (p = build_id; *p; ++p)
132             putw(*p, file);
133     }
134
135     putw(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
136     putw(/* (word count = 3 spaces described by 5 words each, plus the
137           * entry type code, plus this count itself) */
138          (5*3)+2, file);
139     output_space(file,
140                  READ_ONLY_CORE_SPACE_ID,
141                  (lispobj *)READ_ONLY_SPACE_START,
142                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
143     output_space(file,
144                  STATIC_CORE_SPACE_ID,
145                  (lispobj *)STATIC_SPACE_START,
146                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0));
147 #ifdef reg_ALLOC
148     output_space(file,
149                  DYNAMIC_CORE_SPACE_ID,
150                  (lispobj *)current_dynamic_space,
151                  dynamic_space_free_pointer);
152 #else
153 #ifdef LISP_FEATURE_GENCGC
154     /* Flush the current_region, updating the tables. */
155     gc_alloc_update_all_page_tables();
156     update_x86_dynamic_space_free_pointer();
157 #endif
158     output_space(file,
159                  DYNAMIC_CORE_SPACE_ID,
160                  (lispobj *)DYNAMIC_SPACE_START,
161                  (lispobj *)SymbolValue(ALLOCATION_POINTER,0));
162 #endif
163
164     putw(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
165     putw(3, file);
166     putw(init_function, file);
167
168     putw(END_CORE_ENTRY_TYPE_CODE, file);
169
170     fclose(file);
171     printf("done]\n");
172
173     exit(0);
174 }