2004-07-16 02:26:21 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
2005-05-10 22:30:58 -04:00
|
|
|
void init_objects(HEADER *h)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
for(i = 0; i < USER_ENV; i++)
|
|
|
|
userenv[i] = F;
|
|
|
|
userenv[GLOBAL_ENV] = h->global;
|
|
|
|
userenv[BOOT_ENV] = h->boot;
|
|
|
|
T = h->t;
|
|
|
|
bignum_zero = h->bignum_zero;
|
|
|
|
bignum_pos_one = h->bignum_pos_one;
|
|
|
|
bignum_neg_one = h->bignum_neg_one;
|
|
|
|
}
|
|
|
|
|
2006-08-08 01:38:32 -04:00
|
|
|
void load_image(const char* filename)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
FILE* file;
|
|
|
|
HEADER h;
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
file = fopen(filename,"rb");
|
2004-08-22 01:46:26 -04:00
|
|
|
if(file == NULL)
|
2006-03-19 02:42:40 -05:00
|
|
|
{
|
|
|
|
fprintf(stderr,"Cannot open image file: %s\n",filename);
|
|
|
|
fprintf(stderr,"%s\n",strerror(errno));
|
|
|
|
exit(1);
|
|
|
|
}
|
|
|
|
|
|
|
|
printf("Loading %s...",filename);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2006-08-08 01:38:32 -04:00
|
|
|
/* read it in native byte order */
|
|
|
|
fread(&h,sizeof(HEADER)/sizeof(CELL),sizeof(CELL),file);
|
|
|
|
|
|
|
|
if(h.magic != IMAGE_MAGIC)
|
|
|
|
fatal_error("Bad magic number",h.magic);
|
|
|
|
|
|
|
|
if(h.version != IMAGE_VERSION)
|
|
|
|
fatal_error("Bad version number",h.version);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
|
|
|
/* read data heap */
|
|
|
|
{
|
2006-08-08 01:38:32 -04:00
|
|
|
CELL size = h.data_size / CELLS;
|
2006-08-23 22:56:39 -04:00
|
|
|
if(size + tenured.base >= tenured.limit)
|
|
|
|
fatal_error("Data heap too large",h.code_size);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2005-05-11 00:43:52 -04:00
|
|
|
if(size != fread((void*)tenured.base,sizeof(CELL),size,file))
|
2006-08-08 01:38:32 -04:00
|
|
|
fatal_error("Wrong data heap length",h.data_size);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2006-08-08 01:38:32 -04:00
|
|
|
tenured.here = tenured.base + h.data_size;
|
|
|
|
data_relocation_base = h.data_relocation_base;
|
2004-12-25 02:55:03 -05:00
|
|
|
}
|
|
|
|
|
|
|
|
/* read code heap */
|
|
|
|
{
|
2006-08-08 01:38:32 -04:00
|
|
|
CELL size = h.code_size;
|
2004-12-25 02:55:03 -05:00
|
|
|
if(size + compiling.base >= compiling.limit)
|
2006-08-08 01:38:32 -04:00
|
|
|
fatal_error("Code heap too large",h.code_size);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
|
|
|
if(h.version == IMAGE_VERSION
|
|
|
|
&& size != fread((void*)compiling.base,1,size,file))
|
2006-08-08 01:38:32 -04:00
|
|
|
fatal_error("Wrong code heap length",h.code_size);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2006-08-09 18:09:10 -04:00
|
|
|
last_flush = compiling.here = compiling.base + h.code_size;
|
2006-08-08 01:38:32 -04:00
|
|
|
code_relocation_base = h.code_relocation_base;
|
2004-12-25 02:55:03 -05:00
|
|
|
}
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
fclose(file);
|
|
|
|
|
2004-09-06 22:39:12 -04:00
|
|
|
printf(" relocating...");
|
2004-08-07 18:45:48 -04:00
|
|
|
fflush(stdout);
|
|
|
|
|
2005-05-10 22:30:58 -04:00
|
|
|
init_objects(&h);
|
2004-08-07 18:45:48 -04:00
|
|
|
|
2004-12-25 02:55:03 -05:00
|
|
|
relocate_data();
|
|
|
|
relocate_code();
|
2004-08-07 18:45:48 -04:00
|
|
|
|
2004-09-06 22:39:12 -04:00
|
|
|
printf(" done\n");
|
|
|
|
fflush(stdout);
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2006-03-19 19:59:45 -05:00
|
|
|
bool save_image(const char* filename)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
FILE* file;
|
|
|
|
HEADER h;
|
|
|
|
|
2004-08-20 18:48:08 -04:00
|
|
|
fprintf(stderr,"Saving %s...\n",filename);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
file = fopen(filename,"wb");
|
2004-08-22 01:46:26 -04:00
|
|
|
if(file == NULL)
|
2004-08-20 18:48:08 -04:00
|
|
|
fatal_error("Cannot open image for writing",errno);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
h.magic = IMAGE_MAGIC;
|
|
|
|
h.version = IMAGE_VERSION;
|
2006-08-08 01:38:32 -04:00
|
|
|
h.data_relocation_base = tenured.base;
|
2004-08-20 18:48:08 -04:00
|
|
|
h.boot = userenv[BOOT_ENV];
|
2006-08-08 01:38:32 -04:00
|
|
|
h.data_size = tenured.here - tenured.base;
|
2004-08-20 18:48:08 -04:00
|
|
|
h.global = userenv[GLOBAL_ENV];
|
2005-05-10 22:30:58 -04:00
|
|
|
h.t = T;
|
|
|
|
h.bignum_zero = bignum_zero;
|
|
|
|
h.bignum_pos_one = bignum_pos_one;
|
|
|
|
h.bignum_neg_one = bignum_neg_one;
|
2006-08-08 01:38:32 -04:00
|
|
|
h.code_size = compiling.here - compiling.base;
|
|
|
|
h.code_relocation_base = compiling.base;
|
2004-07-16 02:26:21 -04:00
|
|
|
fwrite(&h,sizeof(HEADER),1,file);
|
2004-12-25 02:55:03 -05:00
|
|
|
|
2006-08-08 01:38:32 -04:00
|
|
|
fwrite((void*)tenured.base,h.data_size,1,file);
|
|
|
|
fwrite((void*)compiling.base,h.code_size,1,file);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
fclose(file);
|
|
|
|
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_save_image(void)
|
|
|
|
{
|
2005-01-25 19:40:57 -05:00
|
|
|
F_STRING* filename;
|
2005-05-11 00:43:52 -04:00
|
|
|
/* do a full GC to push everything into tenured space */
|
|
|
|
garbage_collection(TENURED);
|
2005-01-25 19:40:57 -05:00
|
|
|
filename = untag_string(dpop());
|
2006-05-22 23:32:27 -04:00
|
|
|
save_image(to_char_string(filename,true));
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
2006-07-07 00:07:18 -04:00
|
|
|
|
|
|
|
void relocate_object(CELL relocating)
|
|
|
|
{
|
2006-07-31 17:36:15 -04:00
|
|
|
CELL scan = relocating;
|
|
|
|
CELL payload_start = binary_payload_start(scan);
|
|
|
|
CELL end = scan + payload_start;
|
|
|
|
|
|
|
|
scan += CELLS;
|
|
|
|
|
|
|
|
while(scan < end)
|
|
|
|
{
|
|
|
|
data_fixup((CELL*)scan);
|
|
|
|
scan += CELLS;
|
|
|
|
}
|
|
|
|
|
2006-07-07 00:07:18 -04:00
|
|
|
switch(untag_header(get(relocating)))
|
|
|
|
{
|
|
|
|
case WORD_TYPE:
|
|
|
|
fixup_word((F_WORD*)relocating);
|
|
|
|
break;
|
|
|
|
case STRING_TYPE:
|
|
|
|
rehash_string((F_STRING*)relocating);
|
|
|
|
break;
|
|
|
|
case DLL_TYPE:
|
2006-07-31 17:36:15 -04:00
|
|
|
ffi_dlopen((DLL*)relocating,false);
|
2006-07-07 00:07:18 -04:00
|
|
|
break;
|
|
|
|
case ALIEN_TYPE:
|
|
|
|
fixup_alien((ALIEN*)relocating);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void relocate_data()
|
|
|
|
{
|
|
|
|
CELL relocating;
|
|
|
|
|
|
|
|
data_fixup(&userenv[BOOT_ENV]);
|
|
|
|
data_fixup(&userenv[GLOBAL_ENV]);
|
|
|
|
data_fixup(&T);
|
|
|
|
data_fixup(&bignum_zero);
|
|
|
|
data_fixup(&bignum_pos_one);
|
|
|
|
data_fixup(&bignum_neg_one);
|
|
|
|
|
|
|
|
for(relocating = tenured.base;
|
|
|
|
relocating < tenured.here;
|
|
|
|
relocating += untagged_object_size(relocating))
|
|
|
|
{
|
|
|
|
allot_barrier(relocating);
|
|
|
|
relocate_object(relocating);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-08-09 16:15:27 -04:00
|
|
|
void relocate_code_block(F_COMPILED *relocating, CELL code_start,
|
|
|
|
CELL reloc_start, CELL literal_start, CELL literal_end)
|
2006-07-07 00:07:18 -04:00
|
|
|
{
|
2006-08-08 01:38:32 -04:00
|
|
|
/* relocate literal table data */
|
2006-08-09 16:15:27 -04:00
|
|
|
CELL scan;
|
|
|
|
|
|
|
|
for(scan = literal_start; scan < literal_end; scan += CELLS)
|
|
|
|
data_fixup((CELL*)scan);
|
2006-07-07 00:07:18 -04:00
|
|
|
|
2006-08-09 16:15:27 -04:00
|
|
|
finalize_code_block(relocating,code_start,reloc_start,
|
|
|
|
literal_start,literal_end);
|
2006-07-07 00:07:18 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void relocate_code()
|
|
|
|
{
|
2006-08-09 16:15:27 -04:00
|
|
|
iterate_code_heap(compiling.base,compiling.here,relocate_code_block);
|
2006-07-07 00:07:18 -04:00
|
|
|
}
|