vm/image.c

   1 #include "master.h"
   2
   3 /* Certain special objects in the image are known to the runtime */
   4 void init_objects(F_HEADER *h)
   5 {
   6         memcpy(userenv,h->userenv,sizeof(userenv));
   7
   8         T = h->t;
   9         bignum_zero = h->bignum_zero;
  10         bignum_pos_one = h->bignum_pos_one;
  11         bignum_neg_one = h->bignum_neg_one;
  12
  13         stage2 = (userenv[STAGE2_ENV] != F);
  14 }
  15
  16 INLINE void load_data_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
  17 {
  18         CELL good_size = h->data_size + (1 << 20);
  19
  20         if(good_size > p->tenured_size)
  21                 p->tenured_size = good_size;
  22
  23         init_data_heap(p->gen_count,
  24                 p->young_size,
  25                 p->aging_size,
  26                 p->tenured_size,
  27                 p->secure_gc);
  28
  29         clear_gc_stats();
  30
  31         F_ZONE *tenured = &data_heap->generations[TENURED];
  32
  33         F_FIXNUM bytes_read = fread((void*)tenured->start,1,h->data_size,file);
  34
  35         if(bytes_read != h->data_size)
  36         {
  37                 print_string("truncated image: ");
  38                 print_fixnum(bytes_read);
  39                 print_string(" bytes read, ");
  40                 print_cell(h->data_size);
  41                 print_string(" bytes expected\n");
  42                 fatal_error("load_data_heap failed",0);
  43         }
  44
  45         tenured->here = tenured->start + h->data_size;
  46         data_relocation_base = h->data_relocation_base;
  47 }
  48
  49 INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
  50 {
  51         CELL good_size = h->code_size + (1 << 19);
  52
  53         if(good_size > p->code_size)
  54                 p->code_size = good_size;
  55
  56         init_code_heap(p->code_size);
  57
  58         if(h->code_size != 0)
  59         {
  60                 F_FIXNUM bytes_read = fread(first_block(&code_heap),1,h->code_size,file);
  61                 if(bytes_read != h->code_size)
  62                 {
  63                         print_string("truncated image: ");
  64                         print_fixnum(bytes_read);
  65                         print_string(" bytes read, ");
  66                         print_cell(h->code_size);
  67                         print_string(" bytes expected\n");
  68                         fatal_error("load_code_heap failed",0);
  69                 }
  70         }
  71
  72         code_relocation_base = h->code_relocation_base;
  73         build_free_list(&code_heap,h->code_size);
  74 }
  75
  76 /* Read an image file from disk, only done once during startup */
  77 /* This function also initializes the data and code heaps */
  78 void load_image(F_PARAMETERS *p)
  79 {
  80         FILE *file = OPEN_READ(p->image_path);
  81         if(file == NULL)
  82         {
  83                 print_string("Cannot open image file: "); print_native_string(p->image_path); nl();
  84                 print_string(strerror(errno)); nl();
  85                 exit(1);
  86         }
  87
  88         F_HEADER h;
  89         fread(&h,sizeof(F_HEADER),1,file);
  90
  91         if(h.magic != IMAGE_MAGIC)
  92                 fatal_error("Bad image: magic number check failed",h.magic);
  93
  94         if(h.version != IMAGE_VERSION)
  95                 fatal_error("Bad image: version number check failed",h.version);
  96
  97         load_data_heap(file,&h,p);
  98         load_code_heap(file,&h,p);
  99
 100         fclose(file);
 101
 102         init_objects(&h);
 103
 104         relocate_data();
 105         relocate_code();
 106
 107         /* Store image path name */
 108         userenv[IMAGE_ENV] = tag_object(from_native_string(p->image_path));
 109 }
 110
 111 /* Save the current image to disk */
 112 bool save_image(const F_CHAR *filename)
 113 {
 114         FILE* file;
 115         F_HEADER h;
 116
 117         file = OPEN_WRITE(filename);
 118         if(file == NULL)
 119         {
 120                 print_string("Cannot open image file: "); print_native_string(filename); nl();
 121                 print_string(strerror(errno)); nl();
 122                 return false;
 123         }
 124
 125         F_ZONE *tenured = &data_heap->generations[TENURED];
 126
 127         h.magic = IMAGE_MAGIC;
 128         h.version = IMAGE_VERSION;
 129         h.data_relocation_base = tenured->start;
 130         h.data_size = tenured->here - tenured->start;
 131         h.code_relocation_base = code_heap.segment->start;
 132         h.code_size = heap_size(&code_heap);
 133
 134         h.t = T;
 135         h.bignum_zero = bignum_zero;
 136         h.bignum_pos_one = bignum_pos_one;
 137         h.bignum_neg_one = bignum_neg_one;
 138
 139         CELL i;
 140         for(i = 0; i < USER_ENV; i++)
 141         {
 142                 if(i < FIRST_SAVE_ENV)
 143                         h.userenv[i] = F;
 144                 else
 145                         h.userenv[i] = userenv[i];
 146         }
 147
 148         fwrite(&h,sizeof(F_HEADER),1,file);
 149
 150         if(fwrite((void*)tenured->start,h.data_size,1,file) != 1)
 151         {
 152                 print_string("Save data heap failed: "); print_string(strerror(errno)); nl();
 153                 return false;
 154         }
 155
 156         if(fwrite(first_block(&code_heap),h.code_size,1,file) != 1)
 157         {
 158                 print_string("Save code heap failed: "); print_string(strerror(errno)); nl();
 159                 return false;
 160         }
 161
 162         if(fclose(file))
 163         {
 164                 print_string("Failed to close image file: "); print_string(strerror(errno)); nl();
 165                 return false;
 166         }
 167
 168         return true;
 169 }
 170
 171 void primitive_save_image(void)
 172 {
 173         /* do a full GC to push everything into tenured space */
 174         gc();
 175
 176         save_image(unbox_native_string());
 177 }
 178
 179 void primitive_save_image_and_exit(void)
 180 {
 181         /* We unbox this before doing anything else. This is the only point
 182         where we might throw an error, so we have to throw an error here since
 183         later steps destroy the current image. */
 184         F_CHAR *path = unbox_native_string();
 185
 186         REGISTER_C_STRING(path);
 187
 188         /* strip out userenv data which is set on startup anyway */
 189         CELL i;
 190         for(i = 0; i < FIRST_SAVE_ENV; i++)
 191                 userenv[i] = F;
 192
 193         for(i = LAST_SAVE_ENV + 1; i < USER_ENV; i++)
 194                 userenv[i] = F;
 195
 196         /* do a full GC + code heap compaction */
 197         compact_code_heap();
 198
 199         UNREGISTER_C_STRING(path);
 200
 201         /* Save the image */
 202         if(save_image(path))
 203                 exit(0);
 204         else
 205                 exit(1);
 206 }
 207
 208 void fixup_word(F_WORD *word)
 209 {
 210         if(stage2)
 211         {
 212                 code_fixup((CELL)&word->code);
 213                 if(word->profiling) code_fixup((CELL)&word->profiling);
 214                 code_fixup((CELL)&word->xt);
 215         }
 216 }
 217
 218 void fixup_quotation(F_QUOTATION *quot)
 219 {
 220         if(quot->compiledp == F)
 221                 quot->xt = lazy_jit_compile;
 222         else
 223         {
 224                 code_fixup((CELL)&quot->xt);
 225                 code_fixup((CELL)&quot->code);
 226         }
 227 }
 228
 229 void fixup_alien(F_ALIEN *d)
 230 {
 231         d->expired = T;
 232 }
 233
 234 void fixup_stack_frame(F_STACK_FRAME *frame)
 235 {
 236         code_fixup((CELL)&frame->xt);
 237         code_fixup((CELL)&FRAME_RETURN_ADDRESS(frame));
 238 }
 239
 240 void fixup_callstack_object(F_CALLSTACK *stack)
 241 {
 242         iterate_callstack_object(stack,fixup_stack_frame);
 243 }
 244
 245 /* Initialize an object in a newly-loaded image */
 246 void relocate_object(CELL relocating)
 247 {
 248         /* Tuple relocation is a bit trickier; we have to fix up the
 249         fixup object before we can get the tuple size, so do_slots is
 250         out of the question */
 251         if(untag_header(get(relocating)) == TUPLE_TYPE)
 252         {
 253                 data_fixup((CELL *)relocating + 1);
 254
 255                 CELL scan = relocating + 2 * CELLS;
 256                 CELL size = untagged_object_size(relocating);
 257                 CELL end = relocating + size;
 258
 259                 while(scan < end)
 260                 {
 261                         data_fixup((CELL *)scan);
 262                         scan += CELLS;
 263                 }
 264         }
 265         else
 266         {
 267                 do_slots(relocating,data_fixup);
 268
 269                 switch(untag_header(get(relocating)))
 270                 {
 271                 case WORD_TYPE:
 272                         fixup_word((F_WORD *)relocating);
 273                         break;
 274                 case QUOTATION_TYPE:
 275                         fixup_quotation((F_QUOTATION *)relocating);
 276                         break;
 277                 case DLL_TYPE:
 278                         ffi_dlopen((F_DLL *)relocating);
 279                         break;
 280                 case ALIEN_TYPE:
 281                         fixup_alien((F_ALIEN *)relocating);
 282                         break;
 283                 case CALLSTACK_TYPE:
 284                         fixup_callstack_object((F_CALLSTACK *)relocating);
 285                         break;
 286                 }
 287         }
 288 }
 289
 290 /* Since the image might have been saved with a different base address than
 291 where it is loaded, we need to fix up pointers in the image. */
 292 void relocate_data()
 293 {
 294         CELL relocating;
 295
 296         CELL i;
 297         for(i = 0; i < USER_ENV; i++)
 298                 data_fixup(&userenv[i]);
 299
 300         data_fixup(&T);
 301         data_fixup(&bignum_zero);
 302         data_fixup(&bignum_pos_one);
 303         data_fixup(&bignum_neg_one);
 304
 305         F_ZONE *tenured = &data_heap->generations[TENURED];
 306
 307         for(relocating = tenured->start;
 308                 relocating < tenured->here;
 309                 relocating += untagged_object_size(relocating))
 310         {
 311                 allot_barrier(relocating);
 312                 relocate_object(relocating);
 313         }
 314 }
 315
 316 void fixup_code_block(F_CODE_BLOCK *compiled)
 317 {
 318         /* relocate literal table data */
 319         data_fixup(&compiled->relocation);
 320         data_fixup(&compiled->literals);
 321
 322         relocate_code_block(compiled);
 323 }
 324
 325 void relocate_code()
 326 {
 327         iterate_code_heap(fixup_code_block);
 328 }