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