Optimize CAD*R for &MORE args.
[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 <sys/file.h>
20
21 #include "sbcl.h"
22 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
23 #include "pthreads_win32.h"
24 #else
25 #include <signal.h>
26 #endif
27 #include "runtime.h"
28 #include "os.h"
29 #include "core.h"
30 #include "globals.h"
31 #include "save.h"
32 #include "dynbind.h"
33 #include "lispregs.h"
34 #include "validate.h"
35 #include "gc-internal.h"
36 #include "thread.h"
37
38 #include "genesis/static-symbols.h"
39 #include "genesis/symbol.h"
40
41 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
42 # include <zlib.h>
43 #endif
44
45 /* write_runtime_options uses a simple serialization scheme that
46  * consists of one word of magic, one word indicating whether options
47  * are actually saved, and one word per struct field. */
48 static void
49 write_runtime_options(FILE *file, struct runtime_options *options)
50 {
51     size_t optarray[RUNTIME_OPTIONS_WORDS];
52
53     memset(&optarray, 0, sizeof(optarray));
54     optarray[0] = RUNTIME_OPTIONS_MAGIC;
55
56     if (options != NULL) {
57         /* optarray[1] is a flag indicating that options are present */
58         optarray[1] = 1;
59         optarray[2] = options->dynamic_space_size;
60         optarray[3] = options->thread_control_stack_size;
61     }
62
63     if (RUNTIME_OPTIONS_WORDS !=
64         fwrite(optarray, sizeof(size_t), RUNTIME_OPTIONS_WORDS, file)) {
65         perror("Error writing runtime options to file");
66     }
67 }
68
69 static void
70 write_lispobj(lispobj obj, FILE *file)
71 {
72     if (1 != fwrite(&obj, sizeof(lispobj), 1, file)) {
73         perror("Error writing to file");
74     }
75 }
76
77 static void
78 write_bytes_to_file(FILE * file, char *addr, long bytes, int compression)
79 {
80     if (compression == COMPRESSION_LEVEL_NONE) {
81         while (bytes > 0) {
82             sword_t count = fwrite(addr, 1, bytes, file);
83             if (count > 0) {
84                 bytes -= count;
85                 addr += count;
86             }
87             else {
88                 perror("error writing to save file");
89                 bytes = 0;
90             }
91         }
92 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
93     } else if ((compression >= -1) && (compression <= 9)) {
94 # define ZLIB_BUFFER_SIZE (1u<<16)
95         z_stream stream;
96         unsigned char buf[ZLIB_BUFFER_SIZE];
97         unsigned char * written, * end;
98         long total_written = 0;
99         int ret;
100         stream.zalloc = NULL;
101         stream.zfree = NULL;
102         stream.opaque = NULL;
103         stream.avail_in = bytes;
104         stream.next_in  = (void*)addr;
105         ret = deflateInit(&stream, compression);
106         if (ret != Z_OK)
107             lose("deflateInit: %i\n", ret);
108         do {
109             stream.avail_out = sizeof(buf);
110             stream.next_out = buf;
111             ret = deflate(&stream, Z_FINISH);
112             if (ret < 0) lose("zlib deflate error: %i... exiting\n", ret);
113             written = buf;
114             end     = buf+sizeof(buf)-stream.avail_out;
115             total_written += end - written;
116             while (written < end) {
117                 long count = fwrite(written, 1, end-written, file);
118                 if (count > 0) {
119                     written += count;
120                 } else {
121                     lose("unable to write to core file\n");
122                 }
123             }
124         } while (stream.avail_out == 0);
125         deflateEnd(&stream);
126         printf("compressed %lu bytes into %lu at level %i\n",
127                bytes, total_written, compression);
128 # undef ZLIB_BUFFER_SIZE
129 #endif
130     } else {
131 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
132         lose("Unknown core compression level %i, exiting\n", compression);
133 #else
134         lose("zlib-compressed core support not built in this runtime\n");
135 #endif
136     }
137
138     fflush(file);
139 };
140
141
142 static long
143 write_and_compress_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset,
144                          int compression)
145 {
146     long here, data;
147
148     bytes = (bytes+os_vm_page_size-1)&~(os_vm_page_size-1);
149
150 #ifdef LISP_FEATURE_WIN32
151     long count;
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 static void
176 output_space(FILE *file, int id, lispobj *addr, lispobj *end,
177              os_vm_offset_t file_offset,
178              int core_compression_level)
179 {
180     size_t words, bytes, data, compressed_flag;
181     static char *names[] = {NULL, "dynamic", "static", "read-only"};
182
183     compressed_flag
184             = ((core_compression_level != COMPRESSION_LEVEL_NONE)
185                ? DEFLATED_CORE_SPACE_ID_FLAG : 0);
186
187     write_lispobj(id | compressed_flag, file);
188     words = end - addr;
189     write_lispobj(words, file);
190
191     bytes = words * sizeof(lispobj);
192
193     printf("writing %lu bytes from the %s space at 0x%p\n",
194            bytes, names[id], addr);
195
196     data = write_and_compress_bytes(file, (char *)addr, bytes, file_offset,
197                                     core_compression_level);
198
199     write_lispobj(data, file);
200     write_lispobj((uword_t)addr / os_vm_page_size, file);
201     write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file);
202 }
203
204 FILE *
205 open_core_for_saving(char *filename)
206 {
207     /* Open the output file. We don't actually need the file yet, but
208      * the fopen() might fail for some reason, and we want to detect
209      * that and back out before we do anything irreversible. */
210     unlink(filename);
211     return fopen(filename, "wb");
212 }
213
214 boolean
215 save_to_filehandle(FILE *file, char *filename, lispobj init_function,
216                    boolean make_executable,
217                    boolean save_runtime_options,
218                    int core_compression_level)
219 {
220     struct thread *th;
221     os_vm_offset_t core_start_pos;
222
223     /* Smash the enclosing state. (Once we do this, there's no good
224      * way to go back, which is a sufficient reason that this ends up
225      * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
226     printf("[undoing binding stack and other enclosing state... ");
227     fflush(stdout);
228     for_each_thread(th) {       /* XXX really? */
229         unbind_to_here((lispobj *)th->binding_stack_start,th);
230         SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
231         SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
232     }
233     printf("done]\n");
234     fflush(stdout);
235
236     /* (Now we can actually start copying ourselves into the output file.) */
237
238     printf("[saving current Lisp image into %s:\n", filename);
239     fflush(stdout);
240
241     core_start_pos = ftell(file);
242     write_lispobj(CORE_MAGIC, file);
243
244     write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
245     write_lispobj(3, file);
246     write_lispobj(SBCL_CORE_VERSION_INTEGER, file);
247
248     write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
249     write_lispobj(/* (We're writing the word count of the entry here, and the 2
250           * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
251           * word and one word where we store the count itself.) */
252          2 + strlen((const char *)build_id),
253          file);
254     {
255         unsigned char *p;
256         for (p = (unsigned char *)build_id; *p; ++p)
257             write_lispobj(*p, file);
258     }
259
260     write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
261     write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
262           * entry type code, plus this count itself) */
263          (5*3)+2, file);
264     output_space(file,
265                  READ_ONLY_CORE_SPACE_ID,
266                  (lispobj *)READ_ONLY_SPACE_START,
267                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
268                  core_start_pos,
269                  core_compression_level);
270     output_space(file,
271                  STATIC_CORE_SPACE_ID,
272                  (lispobj *)STATIC_SPACE_START,
273                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
274                  core_start_pos,
275                  core_compression_level);
276 #ifdef LISP_FEATURE_GENCGC
277     /* Flush the current_region, updating the tables. */
278     gc_alloc_update_all_page_tables();
279     update_dynamic_space_free_pointer();
280 #endif
281 #ifdef reg_ALLOC
282 #ifdef LISP_FEATURE_GENCGC
283     output_space(file,
284                  DYNAMIC_CORE_SPACE_ID,
285                  (lispobj *)DYNAMIC_SPACE_START,
286                  dynamic_space_free_pointer,
287                  core_start_pos,
288                  core_compression_level);
289 #else
290     output_space(file,
291                  DYNAMIC_CORE_SPACE_ID,
292                  (lispobj *)current_dynamic_space,
293                  dynamic_space_free_pointer,
294                  core_start_pos,
295                  core_compression_level);
296 #endif
297 #else
298     output_space(file,
299                  DYNAMIC_CORE_SPACE_ID,
300                  (lispobj *)DYNAMIC_SPACE_START,
301                  (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
302                  core_start_pos,
303                  core_compression_level);
304 #endif
305
306     write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
307     write_lispobj(3, file);
308     write_lispobj(init_function, file);
309
310 #ifdef LISP_FEATURE_GENCGC
311     {
312         size_t size = (last_free_page*sizeof(sword_t)+os_vm_page_size-1)
313             &~(os_vm_page_size-1);
314         uword_t *data = calloc(size, 1);
315         if (data) {
316             uword_t word;
317             sword_t offset;
318             page_index_t i;
319             for (i = 0; i < last_free_page; i++) {
320                 /* Thanks to alignment requirements, the two low bits
321                  * are always zero, so we can use them to store the
322                  * allocation type -- region is always closed, so only
323                  * the two low bits of allocation flags matter. */
324                 word = page_table[i].region_start_offset;
325                 gc_assert((word & 0x03) == 0);
326                 data[i] = word | (0x03 & page_table[i].allocated);
327             }
328             write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
329             write_lispobj(4, file);
330             write_lispobj(size, file);
331             offset = write_bytes(file, (char *)data, size, core_start_pos);
332             write_lispobj(offset, file);
333         }
334     }
335 #endif
336
337     write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
338
339     /* Write a trailing header, ignored when parsing the core normally.
340      * This is used to locate the start of the core when the runtime is
341      * prepended to it. */
342     fseek(file, 0, SEEK_END);
343
344     /* If NULL runtime options are passed to write_runtime_options,
345      * command-line processing is performed as normal in the SBCL
346      * executable. Otherwise, the saved runtime options are used and
347      * all command-line arguments are available to Lisp in
348      * SB-EXT:*POSIX-ARGV*. */
349     write_runtime_options(file,
350                           (save_runtime_options ? runtime_options : NULL));
351
352     if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
353         perror("Error writing core starting position to file");
354         fclose(file);
355     } else {
356         write_lispobj(CORE_MAGIC, file);
357         fclose(file);
358     }
359
360 #ifndef LISP_FEATURE_WIN32
361     if (make_executable)
362         chmod (filename, 0755);
363 #endif
364
365     printf("done]\n");
366     exit(0);
367 }
368
369 /* Check if the build_id for the current runtime is present in a
370  * buffer. */
371 int
372 check_runtime_build_id(void *buf, size_t size)
373 {
374     size_t idlen;
375     char *pos;
376
377     idlen = strlen(build_id) - 1;
378     while ((pos = memchr(buf, build_id[0], size)) != NULL) {
379         size -= (pos + 1) - (char *)buf;
380         buf = (pos + 1);
381         if (idlen <= size && memcmp(buf, build_id + 1, idlen) == 0)
382             return 1;
383     }
384
385     return 0;
386 }
387
388 /* Slurp the executable portion of the runtime into a malloced buffer
389  * and return it.  Places the size in bytes of the runtime into
390  * 'size_out'.  Returns NULL if the runtime cannot be loaded from
391  * 'runtime_path'. */
392 void *
393 load_runtime(char *runtime_path, size_t *size_out)
394 {
395     void *buf = NULL;
396     FILE *input = NULL;
397     size_t size, count;
398     os_vm_offset_t core_offset;
399
400     core_offset = search_for_embedded_core (runtime_path);
401     if ((input = fopen(runtime_path, "rb")) == NULL) {
402         fprintf(stderr, "Unable to open runtime: %s\n", runtime_path);
403         goto lose;
404     }
405
406     fseek(input, 0, SEEK_END);
407     size = (size_t) ftell(input);
408     fseek(input, 0, SEEK_SET);
409
410     if (core_offset != -1 && size > core_offset)
411         size = core_offset;
412
413     buf = successful_malloc(size);
414     if ((count = fread(buf, 1, size, input)) != size) {
415         fprintf(stderr, "Premature EOF while reading runtime.\n");
416         goto lose;
417     }
418
419     if (!check_runtime_build_id(buf, size)) {
420         fprintf(stderr, "Failed to locate current build_id in runtime: %s\n",
421             runtime_path);
422         goto lose;
423     }
424
425     fclose(input);
426     *size_out = size;
427     return buf;
428
429 lose:
430     if (input != NULL)
431         fclose(input);
432     if (buf != NULL)
433         free(buf);
434     return NULL;
435 }
436
437 boolean
438 save_runtime_to_filehandle(FILE *output, void *runtime, size_t runtime_size)
439 {
440     size_t padding;
441     void *padbytes;
442
443     if (runtime_size != fwrite(runtime, 1, runtime_size, output)) {
444         perror("Error saving runtime");
445         return 0;
446     }
447
448     padding = (os_vm_page_size - (runtime_size % os_vm_page_size)) & ~os_vm_page_size;
449     if (padding > 0) {
450         padbytes = successful_malloc(padding);
451         memset(padbytes, 0, padding);
452         if (padding != fwrite(padbytes, 1, padding, output)) {
453             perror("Error saving runtime");
454             free(padbytes);
455             return 0;
456         }
457         free(padbytes);
458     }
459
460     return 1;
461 }
462
463 FILE *
464 prepare_to_save(char *filename, boolean prepend_runtime, void **runtime_bytes,
465                 size_t *runtime_size)
466 {
467     FILE *file;
468     char *runtime_path;
469
470     if (prepend_runtime) {
471         runtime_path = os_get_runtime_executable_path(0);
472
473         if (runtime_path == NULL && saved_runtime_path == NULL) {
474             fprintf(stderr, "Unable to get default runtime path.\n");
475             return NULL;
476         }
477
478         if (runtime_path == NULL)
479             *runtime_bytes = load_runtime(saved_runtime_path, runtime_size);
480         else {
481             *runtime_bytes = load_runtime(runtime_path, runtime_size);
482             free(runtime_path);
483         }
484
485         if (*runtime_bytes == NULL)
486             return 0;
487     }
488
489     file = open_core_for_saving(filename);
490     if (file == NULL) {
491         free(*runtime_bytes);
492         perror(filename);
493         return NULL;
494     }
495
496     return file;
497 }
498
499 boolean
500 save(char *filename, lispobj init_function, boolean prepend_runtime,
501      boolean save_runtime_options, boolean compressed, int compression_level)
502 {
503     FILE *file;
504     void *runtime_bytes = NULL;
505     size_t runtime_size;
506
507     file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
508     if (file == NULL)
509         return 1;
510
511     if (prepend_runtime)
512         save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
513
514     return save_to_filehandle(file, filename, init_function, prepend_runtime,
515                               save_runtime_options,
516                               compressed ? compressed : COMPRESSION_LEVEL_NONE);
517 }