1.0.8.3: Include missing headers.
[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 #ifndef LISP_FEATURE_WIN32
13 #include <sys/types.h>
14 #include <sys/stat.h>
15 #endif
16 #include <stdlib.h>
17 #include <stdio.h>
18 #include <string.h>
19 #include <signal.h>
20 #include <sys/file.h>
21
22 #include "sbcl.h"
23 #include "runtime.h"
24 #include "os.h"
25 #include "core.h"
26 #include "globals.h"
27 #include "save.h"
28 #include "dynbind.h"
29 #include "lispregs.h"
30 #include "validate.h"
31 #include "gc-internal.h"
32 #include "thread.h"
33
34 #include "genesis/static-symbols.h"
35 #include "genesis/symbol.h"
36
37 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
38 #include "genesis/lutex.h"
39 #endif
40
41 static void
42 write_lispobj(lispobj obj, FILE *file)
43 {
44     fwrite(&obj, sizeof(lispobj), 1, file);
45 }
46
47 static long
48 write_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset)
49 {
50     long count, here, data;
51
52     bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
53
54 #ifdef LISP_FEATURE_WIN32
55     /* touch every single page in the space to force it to be mapped. */
56     for (count = 0; count < bytes; count += 0x1000) {
57         volatile int temp = addr[count];
58     }
59 #endif
60
61     fflush(file);
62     here = ftell(file);
63     fseek(file, 0, SEEK_END);
64     data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
65     fseek(file, data, SEEK_SET);
66
67     while (bytes > 0) {
68         count = fwrite(addr, 1, bytes, file);
69         if (count > 0) {
70             bytes -= count;
71             addr += count;
72         }
73         else {
74             perror("error writing to save file");
75             bytes = 0;
76         }
77     }
78     fflush(file);
79     fseek(file, here, SEEK_SET);
80     return ((data - file_offset) / os_vm_page_size) - 1;
81 }
82
83 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
84 /* saving lutexes in the core */
85 static void **lutex_addresses;
86 static long n_lutexes = 0;
87 static long max_lutexes = 0;
88
89 static long
90 default_scan_action(lispobj *obj)
91 {
92     return (sizetab[widetag_of(*obj)])(obj);
93 }
94
95 static long
96 lutex_scan_action(lispobj *obj)
97 {
98     /* note the address of the lutex */
99     if(n_lutexes >= max_lutexes) {
100         max_lutexes *= 2;
101         lutex_addresses = realloc(lutex_addresses, max_lutexes * sizeof(void *));
102         gc_assert(lutex_addresses);
103     }
104
105     lutex_addresses[n_lutexes++] = obj;
106
107     return (*sizetab[widetag_of(*obj)])(obj);
108 }
109
110 typedef long (*scan_table[256])(lispobj *obj);
111
112 static void
113 scan_objects(lispobj *start, long n_words, scan_table table)
114 {
115     lispobj *end = start + n_words;
116     lispobj *object_ptr;
117     long n_words_scanned;
118     for (object_ptr = start;
119          object_ptr < end;
120          object_ptr += n_words_scanned) {
121         lispobj obj = *object_ptr;
122
123         n_words_scanned = (table[widetag_of(obj)])(object_ptr);
124     }
125 }
126
127 static void
128 scan_for_lutexes(lispobj *addr, long n_words)
129 {
130     static int initialized = 0;
131     static scan_table lutex_scan_table;
132
133     if (!initialized) {
134         int i;
135
136         /* allocate a little space to get started */
137         lutex_addresses = malloc(16*sizeof(void *));
138         gc_assert(lutex_addresses);
139         max_lutexes = 16;
140
141         /* initialize the mapping table */
142         for(i = 0; i < ((sizeof lutex_scan_table)/(sizeof lutex_scan_table[0])); ++i) {
143             lutex_scan_table[i] = default_scan_action;
144         }
145
146         lutex_scan_table[LUTEX_WIDETAG] = lutex_scan_action;
147
148         initialized = 1;
149     }
150
151     /* do the scan */
152     scan_objects(addr, n_words, lutex_scan_table);
153 }
154 #endif
155
156 static void
157 output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset)
158 {
159     size_t words, bytes, data;
160     static char *names[] = {NULL, "dynamic", "static", "read-only"};
161
162     write_lispobj(id, file);
163     words = end - addr;
164     write_lispobj(words, file);
165
166     bytes = words * sizeof(lispobj);
167
168 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
169     printf("scanning space for lutexes...\n");
170     scan_for_lutexes((char *)addr, words);
171 #endif
172
173     printf("writing %lu bytes from the %s space at 0x%08lx\n",
174            (unsigned long)bytes, names[id], (unsigned long)addr);
175
176     data = write_bytes(file, (char *)addr, bytes, file_offset);
177
178     write_lispobj(data, file);
179     write_lispobj((long)addr / os_vm_page_size, file);
180     write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
181 }
182
183 FILE *
184 open_core_for_saving(char *filename)
185 {
186     /* Open the output file. We don't actually need the file yet, but
187      * the fopen() might fail for some reason, and we want to detect
188      * that and back out before we do anything irreversible. */
189     unlink(filename);
190     return fopen(filename, "wb");
191 }
192
193 boolean
194 save_to_filehandle(FILE *file, char *filename, lispobj init_function,
195                    boolean make_executable)
196 {
197     struct thread *th;
198     os_vm_offset_t core_start_pos, core_end_pos, core_size;
199
200     /* Smash the enclosing state. (Once we do this, there's no good
201      * way to go back, which is a sufficient reason that this ends up
202      * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
203     printf("[undoing binding stack and other enclosing state... ");
204     fflush(stdout);
205     for_each_thread(th) {       /* XXX really? */
206         unbind_to_here((lispobj *)th->binding_stack_start,th);
207         SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
208         SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
209     }
210     printf("done]\n");
211     fflush(stdout);
212
213     /* (Now we can actually start copying ourselves into the output file.) */
214
215     printf("[saving current Lisp image into %s:\n", filename);
216     fflush(stdout);
217
218     core_start_pos = ftell(file);
219     write_lispobj(CORE_MAGIC, file);
220
221     write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
222     write_lispobj(3, file);
223     write_lispobj(SBCL_CORE_VERSION_INTEGER, file);
224
225     write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
226     write_lispobj(/* (We're writing the word count of the entry here, and the 2
227           * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
228           * word and one word where we store the count itself.) */
229          2 + strlen((const char *)build_id),
230          file);
231     {
232         unsigned char *p;
233         for (p = (unsigned char *)build_id; *p; ++p)
234             write_lispobj(*p, file);
235     }
236
237     write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
238     write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
239           * entry type code, plus this count itself) */
240          (5*3)+2, file);
241     output_space(file,
242                  READ_ONLY_CORE_SPACE_ID,
243                  (lispobj *)READ_ONLY_SPACE_START,
244                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
245                  core_start_pos);
246     output_space(file,
247                  STATIC_CORE_SPACE_ID,
248                  (lispobj *)STATIC_SPACE_START,
249                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
250                  core_start_pos);
251 #ifdef LISP_FEATURE_GENCGC
252     /* Flush the current_region, updating the tables. */
253     gc_alloc_update_all_page_tables();
254     update_dynamic_space_free_pointer();
255 #endif
256 #ifdef reg_ALLOC
257 #ifdef LISP_FEATURE_GENCGC
258     output_space(file,
259                  DYNAMIC_CORE_SPACE_ID,
260                  (lispobj *)DYNAMIC_SPACE_START,
261                  dynamic_space_free_pointer,
262                  core_start_pos);
263 #else
264     output_space(file,
265                  DYNAMIC_CORE_SPACE_ID,
266                  (lispobj *)current_dynamic_space,
267                  dynamic_space_free_pointer,
268                  core_start_pos);
269 #endif
270 #else
271     output_space(file,
272                  DYNAMIC_CORE_SPACE_ID,
273                  (lispobj *)DYNAMIC_SPACE_START,
274                  (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
275                  core_start_pos);
276 #endif
277
278     write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
279     write_lispobj(3, file);
280     write_lispobj(init_function, file);
281
282 #ifdef LISP_FEATURE_GENCGC
283     {
284         size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1)
285             &~(os_vm_page_size-1);
286         long *data = calloc(size, 1);
287         if (data) {
288             long offset;
289             int i;
290             for (i = 0; i < last_free_page; i++) {
291                 data[i] = page_table[i].first_object_offset;
292             }
293             write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
294             write_lispobj(4, file);
295             write_lispobj(size, file);
296             offset = write_bytes(file, (char *) data, size, core_start_pos);
297             write_lispobj(offset, file);
298         }
299     }
300 #endif
301
302 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
303     if(n_lutexes > 0) {
304         long offset;
305         printf("writing %ld lutexes to the core...\n", n_lutexes);
306         write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file);
307         /* word count of the entry */
308         write_lispobj(4, file);
309         /* indicate how many lutexes we saved */
310         write_lispobj(n_lutexes, file);
311         /* save the lutexes */
312         offset = write_bytes(file, (char *) lutex_addresses,
313                              n_lutexes * sizeof(*lutex_addresses),
314                              core_start_pos);
315
316         write_lispobj(offset, file);
317     }
318 #endif
319
320     write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
321
322     /* Write a trailing header, ignored when parsing the core normally.
323      * This is used to locate the start of the core when the runtime is
324      * prepended to it. */
325     fseek(file, 0, SEEK_END);
326     core_end_pos = ftell(file);
327     core_size = core_end_pos - core_start_pos;
328
329     fwrite(&core_size, sizeof(os_vm_offset_t), 1, file);
330     write_lispobj(CORE_MAGIC, file);
331     fclose(file);
332
333 #ifndef LISP_FEATURE_WIN32
334     if (make_executable)
335         chmod (filename, 0755);
336 #endif
337
338     printf("done]\n");
339     exit(0);
340 }
341
342 /* Slurp the executable portion of the runtime into a malloced buffer
343  * and return it.  Places the size in bytes of the runtime into
344  * 'size_out'.  Returns NULL if the runtime cannot be loaded from
345  * 'runtime_path'. */
346 void *
347 load_runtime(char *runtime_path, size_t *size_out)
348 {
349     void *buf = NULL;
350     FILE *input = NULL;
351     size_t size, count;
352     os_vm_offset_t core_offset;
353
354     core_offset = search_for_embedded_core (runtime_path);
355     if ((input = fopen(runtime_path, "rb")) == NULL) {
356         fprintf(stderr, "Unable to open runtime: %s\n", runtime_path);
357         goto lose;
358     }
359
360     fseek(input, 0, SEEK_END);
361     size = (size_t) ftell(input);
362     fseek(input, 0, SEEK_SET);
363
364     if (core_offset != -1 && size > core_offset)
365         size = core_offset;
366
367     buf = successful_malloc(size);
368     if ((count = fread(buf, 1, size, input)) != size) {
369         fprintf(stderr, "Premature EOF while reading runtime.\n");
370         goto lose;
371     }
372
373     fclose(input);
374     *size_out = size;
375     return buf;
376
377 lose:
378     if (input != NULL)
379         fclose(input);
380     if (buf != NULL)
381         free(buf);
382     return NULL;
383 }
384
385 boolean
386 save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
387 {
388     size_t padding;
389     void *padbytes;
390
391     fwrite(runtime, 1, runtime_size, output);
392
393     padding = (os_vm_page_size - (runtime_size % os_vm_page_size)) & ~os_vm_page_size;
394     if (padding > 0) {
395         padbytes = successful_malloc(padding);
396         memset(padbytes, 0, padding);
397         fwrite(padbytes, 1, padding, output);
398         free(padbytes);
399     }
400
401     return 1;
402 }
403
404 FILE *
405 prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
406                 size_t *runtime_size)
407 {
408     FILE *file;
409     char *runtime_path;
410
411     if (prepend_runtime) {
412         runtime_path = os_get_runtime_executable_path();
413
414         if (runtime_path == NULL) {
415             fprintf(stderr, "Unable to get default runtime path.\n");
416             return NULL;
417         }
418
419         *runtime_bytes = load_runtime(runtime_path, runtime_size);
420         free(runtime_path);
421
422         if (*runtime_bytes == NULL)
423             return 0;
424     }
425
426     file = open_core_for_saving(filename);
427     if (file == NULL) {
428         free(*runtime_bytes);
429         perror(filename);
430         return NULL;
431     }
432
433     return file;
434 }
435
436 boolean
437 save(char *filename, lispobj init_function, boolean prepend_runtime)
438 {
439     FILE *file;
440     void *runtime_bytes = NULL;
441     size_t runtime_size;
442
443     file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
444     if (file == NULL)
445         return 1;
446
447     if (prepend_runtime)
448         save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
449
450     return save_to_filehandle(file, filename, init_function, prepend_runtime);
451 }