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
 106      * output file.) */
 107
 108     printf("[saving current Lisp image into %s:\n", filename);
 109     fflush(stdout);
 110
 111     putw(CORE_MAGIC, file);
 112
 113     putw(VERSION_CORE_ENTRY_TYPE_CODE, file);
 114     putw(3, file);
 115     putw(SBCL_CORE_VERSION_INTEGER, file);
 116
 117     putw(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
 118     putw((5*3)+2, file);
 119
 120     output_space(file,
 121                  READ_ONLY_CORE_SPACE_ID,
 122                  (lispobj *)READ_ONLY_SPACE_START,
 123                  (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
 124     output_space(file,
 125                  STATIC_CORE_SPACE_ID,
 126                  (lispobj *)STATIC_SPACE_START,
 127                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
 128 #ifdef reg_ALLOC
 129     output_space(file,
 130                  DYNAMIC_CORE_SPACE_ID,
 131                  (lispobj *)current_dynamic_space,
 132                  dynamic_space_free_pointer);
 133 #else
 134 #ifdef LISP_FEATURE_GENCGC
 135     /* I don't know too much about the circumstances in which we could
 136      * end up here.  It may be that current_region_free_pointer is
 137      * guaranteed to be relevant and we could skip these slightly
 138      * paranoid checks.  TRT would be to rid the code of
 139      * current_region_foo completely - dan 2002.09.17 */
 140     if((boxed_region.free_pointer < current_region_free_pointer) &&
 141        (boxed_region.end_addr == current_region_end_addr))
 142         boxed_region.free_pointer = current_region_free_pointer;
 143     /* Flush the current_region, updating the tables. */
 144     gc_alloc_update_page_tables(0,&boxed_region);
 145     gc_alloc_update_page_tables(1,&unboxed_region);
 146     update_x86_dynamic_space_free_pointer();
 147 #endif
 148     output_space(file,
 149                  DYNAMIC_CORE_SPACE_ID,
 150                  (lispobj *)DYNAMIC_SPACE_START,
 151                  (lispobj *)SymbolValue(ALLOCATION_POINTER));
 152 #endif
 153
 154     putw(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
 155     putw(3, file);
 156     putw(init_function, file);
 157
 158     putw(END_CORE_ENTRY_TYPE_CODE, file);
 159
 160     fclose(file);
 161     printf("done]\n");
 162
 163     exit(0);
 164 }