#include "master.h" /* Certain special objects in the image are known to the runtime */ void init_objects(F_HEADER *h) { memcpy(userenv,h->userenv,sizeof(userenv)); T = h->t; bignum_zero = h->bignum_zero; bignum_pos_one = h->bignum_pos_one; bignum_neg_one = h->bignum_neg_one; } INLINE void load_data_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p) { CELL good_size = h->data_size + (1 << 20); if(good_size > p->aging_size) p->aging_size = good_size; init_data_heap(p->gen_count,p->young_size,p->aging_size,p->secure_gc); F_ZONE *tenured = &data_heap->generations[TENURED]; if(fread((void*)tenured->start,h->data_size,1,file) != 1) fatal_error("load_data_heap failed",0); tenured->here = tenured->start + h->data_size; data_relocation_base = h->data_relocation_base; } INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p) { CELL good_size = h->code_size + (1 << 19); if(good_size > p->code_size) p->code_size = good_size; init_code_heap(p->code_size); if(h->code_size != 0 && fread(first_block(&code_heap),h->code_size,1,file) != 1) fatal_error("load_code_heap failed",0); code_relocation_base = h->code_relocation_base; build_free_list(&code_heap,h->code_size); } /* Read an image file from disk, only done once during startup */ /* This function also initializes the data and code heaps */ void load_image(F_PARAMETERS *p) { FILE *file = OPEN_READ(p->image); if(file == NULL) { FPRINTF(stderr,"Cannot open image file: %s\n",p->image); fprintf(stderr,"%s\n",strerror(errno)); exit(1); } F_HEADER h; fread(&h,sizeof(F_HEADER),1,file); if(h.magic != IMAGE_MAGIC) fatal_error("Bad image: magic number check failed",h.magic); if(h.version != IMAGE_VERSION) fatal_error("Bad image: version number check failed",h.version); load_data_heap(file,&h,p); load_code_heap(file,&h,p); fclose(file); init_objects(&h); relocate_data(); relocate_code(); /* Store image path name */ userenv[IMAGE_ENV] = tag_object(from_native_string(p->image)); } /* Save the current image to disk */ void save_image(const F_CHAR *filename) { FILE* file; F_HEADER h; FPRINTF(stderr,"*** Saving %s...\n",filename); file = OPEN_WRITE(filename); if(file == NULL) { FPRINTF(stderr,"Cannot open image file: %s\n",filename); fprintf(stderr,"%s\n",strerror(errno)); return; } F_ZONE *tenured = &data_heap->generations[TENURED]; h.magic = IMAGE_MAGIC; h.version = IMAGE_VERSION; h.data_relocation_base = tenured->start; h.data_size = tenured->here - tenured->start; h.code_relocation_base = code_heap.segment->start; h.code_size = heap_size(&code_heap); h.t = T; h.bignum_zero = bignum_zero; h.bignum_pos_one = bignum_pos_one; h.bignum_neg_one = bignum_neg_one; CELL i; for(i = 0; i < USER_ENV; i++) { if(i < FIRST_SAVE_ENV) h.userenv[i] = F; else h.userenv[i] = userenv[i]; } fwrite(&h,sizeof(F_HEADER),1,file); fwrite((void*)tenured->start,h.data_size,1,file); fwrite(first_block(&code_heap),h.code_size,1,file); fclose(file); } DEFINE_PRIMITIVE(save_image) { /* do a full GC to push everything into tenured space */ code_gc(); save_image(unbox_native_string()); } DEFINE_PRIMITIVE(save_image_and_exit) { /* strip out userenv data which is set on startup anyway */ CELL i; for(i = 0; i < FIRST_SAVE_ENV; i++) userenv[i] = F; /* do a full GC + code heap compaction */ compact_code_heap(); /* Save the image */ save_image(unbox_native_string()); /* now exit; we cannot continue executing like this */ exit(0); } void fixup_word(F_WORD *word) { /* If this is a compiled word, relocate the code pointer. Otherwise, reset it based on the primitive number of the word. */ if(word->compiledp == F) word->xt = default_word_xt(word); else { code_fixup((CELL)&word->xt); code_fixup((CELL)&word->code); } } void fixup_quotation(F_QUOTATION *quot) { if(quot->compiledp == F) quot->xt = lazy_jit_compile; else { code_fixup((CELL)"->xt); code_fixup((CELL)"->code); } } void fixup_alien(F_ALIEN *d) { d->expired = T; } void fixup_stack_frame(F_STACK_FRAME *frame) { code_fixup((CELL)&frame->xt); if(frame_type(frame) == QUOTATION_TYPE) { CELL scan = frame->scan - frame->array; data_fixup(&frame->array); frame->scan = scan + frame->array; } code_fixup((CELL)&FRAME_RETURN_ADDRESS(frame)); } void fixup_callstack_object(F_CALLSTACK *stack) { iterate_callstack_object(stack,fixup_stack_frame); } /* Initialize an object in a newly-loaded image */ void relocate_object(CELL relocating) { do_slots(relocating,data_fixup); switch(untag_header(get(relocating))) { case WORD_TYPE: fixup_word((F_WORD *)relocating); break; case QUOTATION_TYPE: fixup_quotation((F_QUOTATION *)relocating); break; case DLL_TYPE: ffi_dlopen((F_DLL *)relocating,false); break; case ALIEN_TYPE: fixup_alien((F_ALIEN *)relocating); break; case CALLSTACK_TYPE: fixup_callstack_object((F_CALLSTACK *)relocating); break; } } /* Since the image might have been saved with a different base address than where it is loaded, we need to fix up pointers in the image. */ void relocate_data() { CELL relocating; CELL i; for(i = 0; i < USER_ENV; i++) data_fixup(&userenv[i]); data_fixup(&T); data_fixup(&bignum_zero); data_fixup(&bignum_pos_one); data_fixup(&bignum_neg_one); F_ZONE *tenured = &data_heap->generations[TENURED]; for(relocating = tenured->start; relocating < tenured->here; relocating += untagged_object_size(relocating)) { allot_barrier(relocating); relocate_object(relocating); } } void fixup_code_block(F_COMPILED *relocating, CELL code_start, CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end) { /* relocate literal table data */ CELL scan; CELL literal_end = literals_start + relocating->literals_length; for(scan = literals_start; scan < literal_end; scan += CELLS) data_fixup((CELL*)scan); for(scan = words_start; scan < words_end; scan += CELLS) { if(relocating->finalized) code_fixup(scan); else data_fixup((CELL*)scan); } if(reloc_start != literals_start) { relocate_code_block(relocating,code_start,reloc_start, literals_start,words_start,words_end); } } void relocate_code() { iterate_code_heap(fixup_code_block); }