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