steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Simplify runtime's GC and relocation code

slava 2006-07-31 21:36:15 +00:00
parent b536e80864
commit e5abd93601
11 changed files with 72 additions and 227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -49,6 +49,8 @@
+ ui:
- the UI listener has a shitty design. perhaps it should not call out
to the real listener.
- remaining walker tasks:
- <input> handled by walker itself
- ^W in interactor

18
vm/alien.c
View File

@ -95,16 +95,9 @@ void primitive_alien_address(void)
/* image loading */
void fixup_alien(ALIEN *d)
{
data_fixup(&d->alien);
d->expired = true;
}
/* GC */
void collect_alien(ALIEN *d)
{
copy_handle(&d->alien);
}
/* define words to read/write numericals values at an alien address */
#define DEF_ALIEN_SLOT(name,type,boxer) \
void primitive_alien_##name (void) \
@ -197,14 +190,3 @@ void primitive_dlclose(void)
{
ffi_dlclose(untag_dll(dpop()));
}
void fixup_dll(DLL* dll)
{
data_fixup(&dll->path);
ffi_dlopen(dll,false);
}
void collect_dll(DLL* dll)
{
copy_handle(&dll->path);
}

4
vm/alien.h
View File

@ -12,7 +12,6 @@ void primitive_alien_address(void);
void* alien_offset(CELL object);
void fixup_alien(ALIEN* d);
void collect_alien(ALIEN* d);
DLLEXPORT void *unbox_alien(void);
DLLEXPORT void box_alien(CELL ptr);
@ -55,6 +54,3 @@ INLINE DLL *untag_dll(CELL tagged)
void primitive_dlopen(void);
void primitive_dlsym(void);
void primitive_dlclose(void);
void fixup_dll(DLL* dll);
void collect_dll(DLL* dll);

37
vm/image.c
View File

@ -142,43 +142,32 @@ void primitive_save_image(void)
void relocate_object(CELL relocating)
{
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;
}
switch(untag_header(get(relocating)))
{
case RATIO_TYPE:
fixup_ratio((F_RATIO*)relocating);
break;
case COMPLEX_TYPE:
fixup_complex((F_COMPLEX*)relocating);
break;
case WORD_TYPE:
fixup_word((F_WORD*)relocating);
break;
case ARRAY_TYPE:
case TUPLE_TYPE:
case QUOTATION_TYPE:
fixup_array((F_ARRAY*)relocating);
break;
case HASHTABLE_TYPE:
fixup_hashtable((F_HASHTABLE*)relocating);
break;
case VECTOR_TYPE:
fixup_vector((F_VECTOR*)relocating);
break;
case STRING_TYPE:
rehash_string((F_STRING*)relocating);
break;
case SBUF_TYPE:
fixup_sbuf((F_SBUF*)relocating);
break;
case DLL_TYPE:
fixup_dll((DLL*)relocating);
ffi_dlopen((DLL*)relocating,false);
break;
case ALIEN_TYPE:
fixup_alien((ALIEN*)relocating);
break;
case WRAPPER_TYPE:
fixup_wrapper((F_WRAPPER*)relocating);
break;
}
}

3
vm/layouts.h
View File

@ -152,8 +152,11 @@ typedef struct {
typedef struct {
CELL header;
/* tagged */
CELL alien;
/* untagged */
CELL displacement;
/* untagged */
bool expired;
} ALIEN;

24
vm/math.c
View File

@ -491,18 +491,6 @@ void primitive_from_fraction(void)
dpush(RETAG(ratio,RATIO_TYPE));
}
void fixup_ratio(F_RATIO* ratio)
{
data_fixup(&ratio->numerator);
data_fixup(&ratio->denominator);
}
void collect_ratio(F_RATIO* ratio)
{
copy_handle(&ratio->numerator);
copy_handle(&ratio->denominator);
}
/* Floats */
double to_float(CELL tagged)
@ -764,15 +752,3 @@ void primitive_from_rect(void)
complex->imaginary = imaginary;
dpush(RETAG(complex,COMPLEX_TYPE));
}
void fixup_complex(F_COMPLEX* complex)
{
data_fixup(&complex->real);
data_fixup(&complex->imaginary);
}
void collect_complex(F_COMPLEX* complex)
{
copy_handle(&complex->real);
copy_handle(&complex->imaginary);
}

4
vm/math.h
View File

@ -112,8 +112,6 @@ DLLEXPORT void box_unsigned_8(u64 n);
DLLEXPORT u64 unbox_unsigned_8(void);
void primitive_from_fraction(void);
void fixup_ratio(F_RATIO* ratio);
void collect_ratio(F_RATIO* ratio);
/* for punning */
typedef union {
@ -183,5 +181,3 @@ DLLEXPORT void box_double(double flo);
DLLEXPORT double unbox_double(void);
void primitive_from_rect(void);
void fixup_complex(F_COMPLEX* complex);
void collect_complex(F_COMPLEX* complex);

114
vm/memory.c
View File

@ -10,9 +10,7 @@ void *safe_malloc(size_t size)
CELL object_size(CELL tagged)
{
if(tagged == F)
return 0;
else if(TAG(tagged) == FIXNUM_TYPE)
if(tagged == F || TAG(tagged) == FIXNUM_TYPE)
return 0;
else
return untagged_object_size(UNTAG(tagged));
@ -20,57 +18,70 @@ CELL object_size(CELL tagged)
CELL untagged_object_size(CELL pointer)
{
CELL size;
return align8(unaligned_object_size(pointer));
}
CELL unaligned_object_size(CELL pointer)
{
switch(untag_header(get(pointer)))
{
case WORD_TYPE:
size = sizeof(F_WORD);
break;
return sizeof(F_WORD);
case ARRAY_TYPE:
case TUPLE_TYPE:
case BIGNUM_TYPE:
case BYTE_ARRAY_TYPE:
case QUOTATION_TYPE:
size = array_size(array_capacity((F_ARRAY*)(pointer)));
break;
return array_size(array_capacity((F_ARRAY*)(pointer)));
case HASHTABLE_TYPE:
size = sizeof(F_HASHTABLE);
break;
return sizeof(F_HASHTABLE);
case VECTOR_TYPE:
size = sizeof(F_VECTOR);
break;
return sizeof(F_VECTOR);
case STRING_TYPE:
size = string_size(string_capacity((F_STRING*)(pointer)));
break;
return string_size(string_capacity((F_STRING*)(pointer)));
case SBUF_TYPE:
size = sizeof(F_SBUF);
break;
return sizeof(F_SBUF);
case RATIO_TYPE:
size = sizeof(F_RATIO);
break;
return sizeof(F_RATIO);
case FLOAT_TYPE:
size = sizeof(F_FLOAT);
break;
return sizeof(F_FLOAT);
case COMPLEX_TYPE:
size = sizeof(F_COMPLEX);
break;
return sizeof(F_COMPLEX);
case DLL_TYPE:
size = sizeof(DLL);
break;
return sizeof(DLL);
case ALIEN_TYPE:
size = sizeof(ALIEN);
break;
return sizeof(ALIEN);
case WRAPPER_TYPE:
size = sizeof(F_WRAPPER);
break;
return sizeof(F_WRAPPER);
default:
critical_error("Cannot determine untagged_object_size",pointer);
size = -1;/* can't happen */
break;
return -1; /* can't happen */
}
}
return align8(size);
/* The number of cells from the start of the object which should be scanned by
the GC. Some types have a binary payload at the end (string, word, DLL) which
we ignore. */
CELL binary_payload_start(CELL pointer)
{
switch(untag_header(get(pointer)))
{
/* these objects do not refer to other objects at all */
case STRING_TYPE:
case FLOAT_TYPE:
case BYTE_ARRAY_TYPE:
case BIGNUM_TYPE:
return 0;
/* these objects have some binary data at the end */
case WORD_TYPE:
return sizeof(F_WORD) - CELLS;
case ALIEN_TYPE:
case DLL_TYPE:
return CELLS * 2;
/* everything else consists entirely of pointers */
default:
return unaligned_object_size(pointer);
}
}
void primitive_type(void)
@ -455,40 +466,15 @@ CELL copy_object(CELL pointer)
INLINE void collect_object(CELL scan)
{
switch(untag_header(get(scan)))
CELL payload_start = binary_payload_start(scan);
CELL end = scan + payload_start;
scan += CELLS;
while(scan < end)
{
case RATIO_TYPE:
collect_ratio((F_RATIO*)scan);
break;
case COMPLEX_TYPE:
collect_complex((F_COMPLEX*)scan);
break;
case WORD_TYPE:
collect_word((F_WORD*)scan);
break;
case ARRAY_TYPE:
case TUPLE_TYPE:
case QUOTATION_TYPE:
collect_array((F_ARRAY*)scan);
break;
case HASHTABLE_TYPE:
collect_hashtable((F_HASHTABLE*)scan);
break;
case VECTOR_TYPE:
collect_vector((F_VECTOR*)scan);
break;
case SBUF_TYPE:
collect_sbuf((F_SBUF*)scan);
break;
case DLL_TYPE:
collect_dll((DLL*)scan);
break;
case ALIEN_TYPE:
collect_alien((ALIEN*)scan);
break;
case WRAPPER_TYPE:
collect_wrapper((F_WRAPPER*)scan);
break;
copy_handle((CELL*)scan);
scan += CELLS;
}
}

2
vm/memory.h
View File

@ -82,7 +82,9 @@ INLINE void type_check(CELL type, CELL tagged)
}
CELL untagged_object_size(CELL pointer);
CELL unaligned_object_size(CELL pointer);
CELL object_size(CELL pointer);
CELL binary_payload_start(CELL pointer);
void primitive_room(void);
void primitive_type(void);
void primitive_tag(void);

75
vm/types.c
View File

@ -149,22 +149,6 @@ void primitive_tuple_to_array(void)
drepl(tuple);
}
/* image loading */
void fixup_array(F_ARRAY* array)
{
int i = 0; CELL capacity = array_capacity(array);
for(i = 0; i < capacity; i++)
data_fixup((void*)AREF(array,i));
}
/* GC */
void collect_array(F_ARRAY* array)
{
int i = 0; CELL capacity = array_capacity(array);
for(i = 0; i < capacity; i++)
copy_handle((void*)AREF(array,i));
}
F_VECTOR* vector(F_FIXNUM capacity)
{
F_VECTOR* vector = allot_object(VECTOR_TYPE,sizeof(F_VECTOR));
@ -192,16 +176,6 @@ void primitive_array_to_vector(void)
drepl(tag_object(vector));
}
void fixup_vector(F_VECTOR* vector)
{
data_fixup(&vector->array);
}
void collect_vector(F_VECTOR* vector)
{
copy_handle(&vector->array);
}
/* untagged */
F_STRING* allot_string(F_FIXNUM capacity)
{
@ -439,16 +413,6 @@ void primitive_sbuf(void)
drepl(tag_object(sbuf(size)));
}
void fixup_sbuf(F_SBUF* sbuf)
{
data_fixup(&sbuf->string);
}
void collect_sbuf(F_SBUF* sbuf)
{
copy_handle(&sbuf->string);
}
void primitive_hashtable(void)
{
F_HASHTABLE* hash;
@ -460,20 +424,6 @@ void primitive_hashtable(void)
dpush(tag_object(hash));
}
void fixup_hashtable(F_HASHTABLE* hashtable)
{
data_fixup(&hashtable->count);
data_fixup(&hashtable->deleted);
data_fixup(&hashtable->array);
}
void collect_hashtable(F_HASHTABLE* hashtable)
{
copy_handle(&hashtable->count);
copy_handle(&hashtable->deleted);
copy_handle(&hashtable->array);
}
/* When a word is executed we jump to the value of the xt field. However this
value is an unportable function pointer, so in the image we store a primitive
number that indexes a list of xts. */
@ -516,8 +466,6 @@ void primitive_word_compiledp(void)
void fixup_word(F_WORD* word)
{
data_fixup(&word->primitive);
/* If this is a compiled word, relocate the code pointer. Otherwise,
reset it based on the primitive number of the word. */
if(word->xt >= code_relocation_base
@ -526,19 +474,6 @@ void fixup_word(F_WORD* word)
code_fixup(&word->xt);
else
update_xt(word);
data_fixup(&word->name);
data_fixup(&word->vocabulary);
data_fixup(&word->def);
data_fixup(&word->props);
}
void collect_word(F_WORD* word)
{
copy_handle(&word->name);
copy_handle(&word->vocabulary);
copy_handle(&word->def);
copy_handle(&word->props);
}
void primitive_wrapper(void)
@ -551,13 +486,3 @@ void primitive_wrapper(void)
wrapper->object = dpeek();
drepl(tag_wrapper(wrapper));
}
void fixup_wrapper(F_WRAPPER *wrapper)
{
data_fixup(&wrapper->object);
}
void collect_wrapper(F_WRAPPER *wrapper)
{
copy_handle(&wrapper->object);
}

16
vm/types.h
View File

@ -24,7 +24,7 @@ INLINE F_ARRAY* untag_byte_array_fast(CELL tagged)
INLINE CELL array_size(CELL size)
{
return align8(sizeof(F_ARRAY) + size * CELLS);
return sizeof(F_ARRAY) + size * CELLS;
}
F_ARRAY *allot_array(CELL type, F_FIXNUM capacity);
@ -52,9 +52,6 @@ INLINE CELL array_capacity(F_ARRAY* array)
return untag_fixnum_fast(array->capacity);
}
void fixup_array(F_ARRAY* array);
void collect_array(F_ARRAY* array);
INLINE F_VECTOR* untag_vector(CELL tagged)
{
type_check(VECTOR_TYPE,tagged);
@ -65,8 +62,6 @@ F_VECTOR* vector(F_FIXNUM capacity);
void primitive_vector(void);
void primitive_array_to_vector(void);
void fixup_vector(F_VECTOR* vector);
void collect_vector(F_VECTOR* vector);
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS)
@ -88,7 +83,7 @@ INLINE CELL string_capacity(F_STRING* str)
INLINE CELL string_size(CELL size)
{
return align8(sizeof(F_STRING) + (size + 1) * CHARS);
return sizeof(F_STRING) + (size + 1) * CHARS;
}
F_STRING* allot_string(F_FIXNUM capacity);
@ -144,12 +139,8 @@ void primitive_set_char_slot(void);
F_SBUF* sbuf(F_FIXNUM capacity);
void primitive_sbuf(void);
void fixup_sbuf(F_SBUF* sbuf);
void collect_sbuf(F_SBUF* sbuf);
void primitive_hashtable(void);
void fixup_hashtable(F_HASHTABLE* hashtable);
void collect_hashtable(F_HASHTABLE* hashtable);
typedef void (*XT)(F_WORD *word);
@ -174,7 +165,6 @@ void primitive_word(void);
void primitive_update_xt(void);
void primitive_word_compiledp(void);
void fixup_word(F_WORD* word);
void collect_word(F_WORD* word);
INLINE F_WRAPPER *untag_wrapper_fast(CELL tagged)
{
@ -187,5 +177,3 @@ INLINE CELL tag_wrapper(F_WRAPPER *wrapper)
}
void primitive_wrapper(void);
void fixup_wrapper(F_WRAPPER *wrapper);
void collect_wrapper(F_WRAPPER *wrapper);