Optional support for zlib-based in-memory deflate/inflate for core files
[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 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
42 # include <zlib.h>
43 #endif
44
45
46 /* write_runtime_options uses a simple serialization scheme that
47  * consists of one word of magic, one word indicating whether options
48  * are actually saved, and one word per struct field. */
49 static void
50 write_runtime_options(FILE *file, struct runtime_options *options)
51 {
52     size_t optarray[RUNTIME_OPTIONS_WORDS];
53
54     memset(&optarray, 0, sizeof(optarray));
55     optarray[0] = RUNTIME_OPTIONS_MAGIC;
56
57     if (options != NULL) {
58         /* optarray[1] is a flag indicating that options are present */
59         optarray[1] = 1;
60         optarray[2] = options->dynamic_space_size;
61         optarray[3] = options->thread_control_stack_size;
62     }
63
64     if (RUNTIME_OPTIONS_WORDS !=
65         fwrite(optarray, sizeof(size_t), RUNTIME_OPTIONS_WORDS, file)) {
66         perror("Error writing runtime options to file");
67     }
68 }
69
70 static void
71 write_lispobj(lispobj obj, FILE *file)
72 {
73     if (1 != fwrite(&obj, sizeof(lispobj), 1, file)) {
74         perror("Error writing to file");
75     }
76 }
77
78 static void
79 write_bytes_to_file(FILE * file, char *addr, long bytes, int compression)
80 {
81     if (compression == COMPRESSION_LEVEL_NONE) {
82         while (bytes > 0) {
83             long count = fwrite(addr, 1, bytes, file);
84             if (count > 0) {
85                 bytes -= count;
86                 addr += count;
87             }
88             else {
89                 perror("error writing to save file");
90                 bytes = 0;
91             }
92         }
93 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
94     } else if ((compression >= -1) && (compression <= 9)) {
95 # define ZLIB_BUFFER_SIZE (1u<<16)
96         z_stream stream;
97         unsigned char buf[ZLIB_BUFFER_SIZE];
98         unsigned char * written, * end;
99         long total_written = 0;
100         int ret;
101         stream.zalloc = NULL;
102         stream.zfree = NULL;
103         stream.opaque = NULL;
104         stream.avail_in = bytes;
105         stream.next_in  = (void*)addr;
106         ret = deflateInit(&stream, compression);
107         if (ret != Z_OK)
108             lose("deflateInit: %i\n", ret);
109         do {
110             stream.avail_out = sizeof(buf);
111             stream.next_out = buf;
112             ret = deflate(&stream, Z_FINISH);
113             if (ret < 0) lose("zlib deflate error: %i... exiting\n", ret);
114             written = buf;
115             end     = buf+sizeof(buf)-stream.avail_out;
116             total_written += end - written;
117             while (written < end) {
118                 long count = fwrite(written, 1, end-written, file);
119                 if (count > 0) {
120                     written += count;
121                 } else {
122                     lose("unable to write to core file\n");
123                 }
124             }
125         } while (stream.avail_out == 0);
126         deflateEnd(&stream);
127         printf("compressed %lu bytes into %lu at level %i\n",
128                bytes, total_written, compression);
129 # undef ZLIB_BUFFER_SIZE
130 #endif
131     } else {
132 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
133         lose("Unknown core compression level %i, exiting\n", compression);
134 #else
135         lose("zlib-compressed core support not built in this runtime\n");
136 #endif
137     }
138
139     fflush(file);
140 };
141
142
143 static long
144 write_and_compress_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset,
145                          int compression)
146 {
147     long here, data;
148
149     bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
150
151 #ifdef LISP_FEATURE_WIN32
152     /* touch every single page in the space to force it to be mapped. */
153     for (count = 0; count < bytes; count += 0x1000) {
154         volatile int temp = addr[count];
155     }
156 #endif
157
158     fflush(file);
159     here = ftell(file);
160     fseek(file, 0, SEEK_END);
161     data = (ftell(file)+os_vm_page_size-1)&~(os_vm_page_size-1);
162     fseek(file, data, SEEK_SET);
163     write_bytes_to_file(file, addr, bytes, compression);
164     fseek(file, here, SEEK_SET);
165     return ((data - file_offset) / os_vm_page_size) - 1;
166 }
167
168 static long
169 write_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset)
170 {
171     return write_and_compress_bytes(file, addr, bytes, file_offset,
172                                     COMPRESSION_LEVEL_NONE);
173 }
174
175 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
176 /* saving lutexes in the core */
177 static void **lutex_addresses;
178 static long n_lutexes = 0;
179 static long max_lutexes = 0;
180
181 static long
182 default_scan_action(lispobj *obj)
183 {
184     return (sizetab[widetag_of(*obj)])(obj);
185 }
186
187 static long
188 lutex_scan_action(lispobj *obj)
189 {
190     /* note the address of the lutex */
191     if(n_lutexes >= max_lutexes) {
192         max_lutexes *= 2;
193         lutex_addresses = realloc(lutex_addresses, max_lutexes * sizeof(void *));
194         gc_assert(lutex_addresses);
195     }
196
197     lutex_addresses[n_lutexes++] = obj;
198
199     return (*sizetab[widetag_of(*obj)])(obj);
200 }
201
202 typedef long (*scan_table[256])(lispobj *obj);
203
204 static void
205 scan_objects(lispobj *start, long n_words, scan_table table)
206 {
207     lispobj *end = start + n_words;
208     lispobj *object_ptr;
209     long n_words_scanned;
210     for (object_ptr = start;
211          object_ptr < end;
212          object_ptr += n_words_scanned) {
213         lispobj obj = *object_ptr;
214
215         n_words_scanned = (table[widetag_of(obj)])(object_ptr);
216     }
217 }
218
219 static void
220 scan_for_lutexes(lispobj *addr, long n_words)
221 {
222     static int initialized = 0;
223     static scan_table lutex_scan_table;
224
225     if (!initialized) {
226         int i;
227
228         /* allocate a little space to get started */
229         lutex_addresses = malloc(16*sizeof(void *));
230         gc_assert(lutex_addresses);
231         max_lutexes = 16;
232
233         /* initialize the mapping table */
234         for(i = 0; i < ((sizeof lutex_scan_table)/(sizeof lutex_scan_table[0])); ++i) {
235             lutex_scan_table[i] = default_scan_action;
236         }
237
238         lutex_scan_table[LUTEX_WIDETAG] = lutex_scan_action;
239
240         initialized = 1;
241     }
242
243     /* do the scan */
244     scan_objects(addr, n_words, lutex_scan_table);
245 }
246 #endif
247
248 static void
249 output_space(FILE *file, int id, lispobj *addr, lispobj *end,
250              os_vm_offset_t file_offset,
251              int core_compression_level)
252 {
253     size_t words, bytes, data, compressed_flag;
254     static char *names[] = {NULL, "dynamic", "static", "read-only"};
255
256     compressed_flag
257             = ((core_compression_level != COMPRESSION_LEVEL_NONE)
258                ? DEFLATED_CORE_SPACE_ID_FLAG : 0);
259
260     write_lispobj(id | compressed_flag, file);
261     words = end - addr;
262     write_lispobj(words, file);
263
264     bytes = words * sizeof(lispobj);
265
266 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
267     printf("scanning space for lutexes...\n");
268     scan_for_lutexes((void *)addr, words);
269 #endif
270
271     printf("writing %lu bytes from the %s space at 0x%08lx\n",
272            (unsigned long)bytes, names[id], (unsigned long)addr);
273
274     data = write_and_compress_bytes(file, (char *)addr, bytes, file_offset,
275                                     core_compression_level);
276
277     write_lispobj(data, file);
278     write_lispobj((long)addr / os_vm_page_size, file);
279     write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
280 }
281
282 FILE *
283 open_core_for_saving(char *filename)
284 {
285     /* Open the output file. We don't actually need the file yet, but
286      * the fopen() might fail for some reason, and we want to detect
287      * that and back out before we do anything irreversible. */
288     unlink(filename);
289     return fopen(filename, "wb");
290 }
291
292 boolean
293 save_to_filehandle(FILE *file, char *filename, lispobj init_function,
294                    boolean make_executable,
295                    boolean save_runtime_options,
296                    int core_compression_level)
297 {
298     struct thread *th;
299     os_vm_offset_t core_start_pos;
300
301     /* Smash the enclosing state. (Once we do this, there's no good
302      * way to go back, which is a sufficient reason that this ends up
303      * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
304     printf("[undoing binding stack and other enclosing state... ");
305     fflush(stdout);
306     for_each_thread(th) {       /* XXX really? */
307         unbind_to_here((lispobj *)th->binding_stack_start,th);
308         SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
309         SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
310     }
311     printf("done]\n");
312     fflush(stdout);
313
314     /* (Now we can actually start copying ourselves into the output file.) */
315
316     printf("[saving current Lisp image into %s:\n", filename);
317     fflush(stdout);
318
319     core_start_pos = ftell(file);
320     write_lispobj(CORE_MAGIC, file);
321
322     write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
323     write_lispobj(3, file);
324     write_lispobj(SBCL_CORE_VERSION_INTEGER, file);
325
326     write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
327     write_lispobj(/* (We're writing the word count of the entry here, and the 2
328           * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
329           * word and one word where we store the count itself.) */
330          2 + strlen((const char *)build_id),
331          file);
332     {
333         unsigned char *p;
334         for (p = (unsigned char *)build_id; *p; ++p)
335             write_lispobj(*p, file);
336     }
337
338     write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
339     write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
340           * entry type code, plus this count itself) */
341          (5*3)+2, file);
342     output_space(file,
343                  READ_ONLY_CORE_SPACE_ID,
344                  (lispobj *)READ_ONLY_SPACE_START,
345                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
346                  core_start_pos,
347                  core_compression_level);
348     output_space(file,
349                  STATIC_CORE_SPACE_ID,
350                  (lispobj *)STATIC_SPACE_START,
351                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
352                  core_start_pos,
353                  core_compression_level);
354 #ifdef LISP_FEATURE_GENCGC
355     /* Flush the current_region, updating the tables. */
356     gc_alloc_update_all_page_tables();
357     update_dynamic_space_free_pointer();
358 #endif
359 #ifdef reg_ALLOC
360 #ifdef LISP_FEATURE_GENCGC
361     output_space(file,
362                  DYNAMIC_CORE_SPACE_ID,
363                  (lispobj *)DYNAMIC_SPACE_START,
364                  dynamic_space_free_pointer,
365                  core_start_pos,
366                  core_compression_level);
367 #else
368     output_space(file,
369                  DYNAMIC_CORE_SPACE_ID,
370                  (lispobj *)current_dynamic_space,
371                  dynamic_space_free_pointer,
372                  core_start_pos,
373                  core_compression_level);
374 #endif
375 #else
376     output_space(file,
377                  DYNAMIC_CORE_SPACE_ID,
378                  (lispobj *)DYNAMIC_SPACE_START,
379                  (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
380                  core_start_pos,
381                  core_compression_level);
382 #endif
383
384     write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
385     write_lispobj(3, file);
386     write_lispobj(init_function, file);
387
388 #ifdef LISP_FEATURE_GENCGC
389     {
390         size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1)
391             &~(os_vm_page_size-1);
392         unsigned long *data = calloc(size, 1);
393         if (data) {
394             unsigned long word;
395             long offset;
396             int i;
397             for (i = 0; i < last_free_page; i++) {
398                 /* Thanks to alignment requirements, the two low bits
399                  * are always zero, so we can use them to store the
400                  * allocation type -- region is always closed, so only
401                  * the two low bits of allocation flags matter. */
402                 word = page_table[i].region_start_offset;
403                 gc_assert((word & 0x03) == 0);
404                 data[i] = word | (0x03 & page_table[i].allocated);
405             }
406             write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
407             write_lispobj(4, file);
408             write_lispobj(size, file);
409             offset = write_bytes(file, (char *)data, size, core_start_pos);
410             write_lispobj(offset, file);
411         }
412     }
413 #endif
414
415 #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
416     if(n_lutexes > 0) {
417         long offset;
418         printf("writing %ld lutexes to the core...\n", n_lutexes);
419         write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file);
420         /* word count of the entry */
421         write_lispobj(4, file);
422         /* indicate how many lutexes we saved */
423         write_lispobj(n_lutexes, file);
424         /* save the lutexes */
425         offset = write_bytes(file, (char *) lutex_addresses,
426                              n_lutexes * sizeof(*lutex_addresses),
427                              core_start_pos);
428
429         write_lispobj(offset, file);
430     }
431 #endif
432
433     write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
434
435     /* Write a trailing header, ignored when parsing the core normally.
436      * This is used to locate the start of the core when the runtime is
437      * prepended to it. */
438     fseek(file, 0, SEEK_END);
439
440     /* If NULL runtime options are passed to write_runtime_options,
441      * command-line processing is performed as normal in the SBCL
442      * executable. Otherwise, the saved runtime options are used and
443      * all command-line arguments are available to Lisp in
444      * SB-EXT:*POSIX-ARGV*. */
445     write_runtime_options(file,
446                           (save_runtime_options ? runtime_options : NULL));
447
448     if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
449         perror("Error writing core starting position to file");
450         fclose(file);
451     } else {
452         write_lispobj(CORE_MAGIC, file);
453         fclose(file);
454     }
455
456 #ifndef LISP_FEATURE_WIN32
457     if (make_executable)
458         chmod (filename, 0755);
459 #endif
460
461     printf("done]\n");
462     exit(0);
463 }
464
465 /* Check if the build_id for the current runtime is present in a
466  * buffer. */
467 int
468 check_runtime_build_id(void *buf, size_t size)
469 {
470     size_t idlen;
471     char *pos;
472
473     idlen = strlen(build_id) - 1;
474     while ((pos = memchr(buf, build_id[0], size)) != NULL) {
475         size -= (pos + 1) - (char *)buf;
476         buf = (pos + 1);
477         if (idlen <= size && memcmp(buf, build_id + 1, idlen) == 0)
478             return 1;
479     }
480
481     return 0;
482 }
483
484 /* Slurp the executable portion of the runtime into a malloced buffer
485  * and return it.  Places the size in bytes of the runtime into
486  * 'size_out'.  Returns NULL if the runtime cannot be loaded from
487  * 'runtime_path'. */
488 void *
489 load_runtime(char *runtime_path, size_t *size_out)
490 {
491     void *buf = NULL;
492     FILE *input = NULL;
493     size_t size, count;
494     os_vm_offset_t core_offset;
495
496     core_offset = search_for_embedded_core (runtime_path);
497     if ((input = fopen(runtime_path, "rb")) == NULL) {
498         fprintf(stderr, "Unable to open runtime: %s\n", runtime_path);
499         goto lose;
500     }
501
502     fseek(input, 0, SEEK_END);
503     size = (size_t) ftell(input);
504     fseek(input, 0, SEEK_SET);
505
506     if (core_offset != -1 && size > core_offset)
507         size = core_offset;
508
509     buf = successful_malloc(size);
510     if ((count = fread(buf, 1, size, input)) != size) {
511         fprintf(stderr, "Premature EOF while reading runtime.\n");
512         goto lose;
513     }
514
515     if (!check_runtime_build_id(buf, size)) {
516         fprintf(stderr, "Failed to locate current build_id in runtime: %s\n",
517             runtime_path);
518         goto lose;
519     }
520
521     fclose(input);
522     *size_out = size;
523     return buf;
524
525 lose:
526     if (input != NULL)
527         fclose(input);
528     if (buf != NULL)
529         free(buf);
530     return NULL;
531 }
532
533 boolean
534 save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
535 {
536     size_t padding;
537     void *padbytes;
538
539     if (runtime_size != fwrite(runtime, 1, runtime_size, output)) {
540         perror("Error saving runtime");
541         return 0;
542     }
543
544     padding = (os_vm_page_size - (runtime_size % os_vm_page_size)) & ~os_vm_page_size;
545     if (padding > 0) {
546         padbytes = successful_malloc(padding);
547         memset(padbytes, 0, padding);
548         if (padding != fwrite(padbytes, 1, padding, output)) {
549             perror("Error saving runtime");
550             free(padbytes);
551             return 0;
552         }
553         free(padbytes);
554     }
555
556     return 1;
557 }
558
559 FILE *
560 prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
561                 size_t *runtime_size)
562 {
563     FILE *file;
564     char *runtime_path;
565
566     if (prepend_runtime) {
567         runtime_path = os_get_runtime_executable_path(0);
568
569         if (runtime_path == NULL && saved_runtime_path == NULL) {
570             fprintf(stderr, "Unable to get default runtime path.\n");
571             return NULL;
572         }
573
574         if (runtime_path == NULL)
575             *runtime_bytes = load_runtime(saved_runtime_path, runtime_size);
576         else {
577             *runtime_bytes = load_runtime(runtime_path, runtime_size);
578             free(runtime_path);
579         }
580
581         if (*runtime_bytes == NULL)
582             return 0;
583     }
584
585     file = open_core_for_saving(filename);
586     if (file == NULL) {
587         free(*runtime_bytes);
588         perror(filename);
589         return NULL;
590     }
591
592     return file;
593 }
594
595 boolean
596 save(char *filename, lispobj init_function, boolean prepend_runtime,
597      boolean save_runtime_options, boolean compressed, int compression_level)
598 {
599     FILE *file;
600     void *runtime_bytes = NULL;
601     size_t runtime_size;
602
603     file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
604     if (file == NULL)
605         return 1;
606
607     if (prepend_runtime)
608         save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
609
610     return save_to_filehandle(file, filename, init_function, prepend_runtime,
611                               save_runtime_options,
612                               compressed ? compressed : COMPRESSION_LEVEL_NONE);
613 }