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