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