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

Clean up untag_* and tag_* inline functions in favor of more idiomatic C++

db4
Slava Pestov 2009-05-02 20:47:29 -05:00
parent b923d548cf
commit e3592ca8f6
32 changed files with 205 additions and 263 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
vm/arrays.hpp
View File

@ -1,10 +1,3 @@
DEFINE_UNTAG(F_ARRAY,ARRAY_TYPE,array)
INLINE CELL tag_array(F_ARRAY *array)
{
return RETAG(array,ARRAY_TYPE);
}
F_ARRAY *allot_array(CELL capacity, CELL fill); F_ARRAY *allot_array(CELL capacity, CELL fill);
CELL allot_array_1(CELL obj); CELL allot_array_1(CELL obj);

6
vm/bignumint.hpp
View File

@ -62,7 +62,7 @@ typedef F_FIXNUM bignum_length_type;
#define BIGNUM_START_PTR(bignum) \ #define BIGNUM_START_PTR(bignum) \
((BIGNUM_TO_POINTER (bignum)) + 1) ((BIGNUM_TO_POINTER (bignum)) + 1)
#define BIGNUM_LENGTH(bignum) (untag_fixnum_fast((bignum)->capacity) - 1) #define BIGNUM_LENGTH(bignum) (untag_fixnum((bignum)->capacity) - 1)
#define BIGNUM_NEGATIVE_P(bignum) (get(AREF(bignum,0)) != 0) #define BIGNUM_NEGATIVE_P(bignum) (get(AREF(bignum,0)) != 0)
#define BIGNUM_SET_NEGATIVE_P(bignum,neg) put(AREF(bignum,0),neg) #define BIGNUM_SET_NEGATIVE_P(bignum,neg) put(AREF(bignum,0),neg)
@ -75,9 +75,9 @@ typedef F_FIXNUM bignum_length_type;
/* These definitions are here to facilitate caching of the constants /* These definitions are here to facilitate caching of the constants
0, 1, and -1. */ 0, 1, and -1. */
#define BIGNUM_ZERO() untag_bignum_fast(bignum_zero) #define BIGNUM_ZERO() untag<F_BIGNUM>(bignum_zero)
#define BIGNUM_ONE(neg_p) \ #define BIGNUM_ONE(neg_p) \
untag_bignum_fast(neg_p ? bignum_neg_one : bignum_pos_one) untag<F_BIGNUM>(neg_p ? bignum_neg_one : bignum_pos_one)
#define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK) #define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK)
#define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH) #define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH)

8
vm/byte_arrays.cpp
View File

@ -10,20 +10,20 @@ F_BYTE_ARRAY *allot_byte_array(CELL size)
void primitive_byte_array(void) void primitive_byte_array(void)
{ {
CELL size = unbox_array_size(); CELL size = unbox_array_size();
dpush(tag_object(allot_byte_array(size))); dpush(tag<F_BYTE_ARRAY>(allot_byte_array(size)));
} }
void primitive_uninitialized_byte_array(void) void primitive_uninitialized_byte_array(void)
{ {
CELL size = unbox_array_size(); CELL size = unbox_array_size();
dpush(tag_object(allot_array_internal<F_BYTE_ARRAY>(size))); dpush(tag<F_BYTE_ARRAY>(allot_array_internal<F_BYTE_ARRAY>(size)));
} }
void primitive_resize_byte_array(void) void primitive_resize_byte_array(void)
{ {
F_BYTE_ARRAY *array = untag_byte_array(dpop()); F_BYTE_ARRAY *array = untag_check<F_BYTE_ARRAY>(dpop());
CELL capacity = unbox_array_size(); CELL capacity = unbox_array_size();
dpush(tag_object(reallot_array(array,capacity))); dpush(tag<F_BYTE_ARRAY>(reallot_array(array,capacity)));
} }
void growable_byte_array::append_bytes(void *elts, CELL len) void growable_byte_array::append_bytes(void *elts, CELL len)

2
vm/byte_arrays.hpp
View File

@ -1,5 +1,3 @@
DEFINE_UNTAG(F_BYTE_ARRAY,BYTE_ARRAY_TYPE,byte_array)
F_BYTE_ARRAY *allot_byte_array(CELL size); F_BYTE_ARRAY *allot_byte_array(CELL size);
void primitive_byte_array(void); void primitive_byte_array(void);

18
vm/callstack.cpp
View File

@ -29,7 +29,7 @@ void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator)
void iterate_callstack_object(F_CALLSTACK *stack, CALLSTACK_ITER iterator) void iterate_callstack_object(F_CALLSTACK *stack, CALLSTACK_ITER iterator)
{ {
CELL top = (CELL)FIRST_STACK_FRAME(stack); CELL top = (CELL)FIRST_STACK_FRAME(stack);
CELL bottom = top + untag_fixnum_fast(stack->length); CELL bottom = top + untag_fixnum(stack->length);
iterate_callstack(top,bottom,iterator); iterate_callstack(top,bottom,iterator);
} }
@ -80,16 +80,16 @@ void primitive_callstack(void)
F_CALLSTACK *callstack = allot_callstack(size); F_CALLSTACK *callstack = allot_callstack(size);
memcpy(FIRST_STACK_FRAME(callstack),top,size); memcpy(FIRST_STACK_FRAME(callstack),top,size);
dpush(tag_object(callstack)); dpush(tag<F_CALLSTACK>(callstack));
} }
void primitive_set_callstack(void) void primitive_set_callstack(void)
{ {
F_CALLSTACK *stack = untag_callstack(dpop()); F_CALLSTACK *stack = untag_check<F_CALLSTACK>(dpop());
set_callstack(stack_chain->callstack_bottom, set_callstack(stack_chain->callstack_bottom,
FIRST_STACK_FRAME(stack), FIRST_STACK_FRAME(stack),
untag_fixnum_fast(stack->length), untag_fixnum(stack->length),
memcpy); memcpy);
/* We cannot return here ... */ /* We cannot return here ... */
@ -114,7 +114,7 @@ CELL frame_executing(F_STACK_FRAME *frame)
return F; return F;
else else
{ {
F_ARRAY *array = untag_array_fast(compiled->literals); F_ARRAY *array = untag<F_ARRAY>(compiled->literals);
return array_nth(array,0); return array_nth(array,0);
} }
} }
@ -174,13 +174,13 @@ void primitive_callstack_to_array(void)
frame_index = 0; frame_index = 0;
iterate_callstack_object(callstack.untagged(),stack_frame_to_array); iterate_callstack_object(callstack.untagged(),stack_frame_to_array);
dpush(tag_array(array)); dpush(tag<F_ARRAY>(array));
} }
F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack) F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
{ {
F_STACK_FRAME *top = FIRST_STACK_FRAME(callstack); F_STACK_FRAME *top = FIRST_STACK_FRAME(callstack);
CELL bottom = (CELL)top + untag_fixnum_fast(callstack->length); CELL bottom = (CELL)top + untag_fixnum(callstack->length);
F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1; F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1;
@ -195,7 +195,7 @@ Used by the single stepper. */
void primitive_innermost_stack_frame_quot(void) void primitive_innermost_stack_frame_quot(void)
{ {
F_STACK_FRAME *inner = innermost_stack_frame( F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop())); untag_check<F_CALLSTACK>(dpop()));
type_check(QUOTATION_TYPE,frame_executing(inner)); type_check(QUOTATION_TYPE,frame_executing(inner));
dpush(frame_executing(inner)); dpush(frame_executing(inner));
@ -204,7 +204,7 @@ void primitive_innermost_stack_frame_quot(void)
void primitive_innermost_stack_frame_scan(void) void primitive_innermost_stack_frame_scan(void)
{ {
F_STACK_FRAME *inner = innermost_stack_frame( F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop())); untag_check<F_CALLSTACK>(dpop()));
type_check(QUOTATION_TYPE,frame_executing(inner)); type_check(QUOTATION_TYPE,frame_executing(inner));
dpush(frame_scan(inner)); dpush(frame_scan(inner));

2
vm/callstack.hpp
View File

@ -3,8 +3,6 @@ INLINE CELL callstack_size(CELL size)
return sizeof(F_CALLSTACK) + size; return sizeof(F_CALLSTACK) + size;
} }
DEFINE_UNTAG(F_CALLSTACK,CALLSTACK_TYPE,callstack)
#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1) #define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame); typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame);

20
vm/code_block.cpp
View File

@ -9,7 +9,7 @@ void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
{ {
if(compiled->relocation != F) if(compiled->relocation != F)
{ {
F_BYTE_ARRAY *relocation = untag_byte_array_fast(compiled->relocation); F_BYTE_ARRAY *relocation = untag<F_BYTE_ARRAY>(compiled->relocation);
CELL index = stack_traces_p() ? 1 : 0; CELL index = stack_traces_p() ? 1 : 0;
@ -114,7 +114,7 @@ void update_literal_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compile
if(REL_TYPE(rel) == RT_IMMEDIATE) if(REL_TYPE(rel) == RT_IMMEDIATE)
{ {
CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1);
F_ARRAY *literals = untag_array_fast(compiled->literals); F_ARRAY *literals = untag<F_ARRAY>(compiled->literals);
F_FIXNUM absolute_value = array_nth(literals,index); F_FIXNUM absolute_value = array_nth(literals,index);
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value); store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
} }
@ -156,25 +156,25 @@ CELL object_xt(CELL obj)
{ {
if(TAG(obj) == QUOTATION_TYPE) if(TAG(obj) == QUOTATION_TYPE)
{ {
F_QUOTATION *quot = untag_quotation_fast(obj); F_QUOTATION *quot = untag<F_QUOTATION>(obj);
return (CELL)quot->xt; return (CELL)quot->xt;
} }
else else
{ {
F_WORD *word = untag_word_fast(obj); F_WORD *word = untag<F_WORD>(obj);
return (CELL)word->xt; return (CELL)word->xt;
} }
} }
CELL word_direct_xt(CELL obj) CELL word_direct_xt(CELL obj)
{ {
F_WORD *word = untag_word_fast(obj); F_WORD *word = untag<F_WORD>(obj);
CELL quot = word->direct_entry_def; CELL quot = word->direct_entry_def;
if(quot == F || max_pic_size == 0) if(quot == F || max_pic_size == 0)
return (CELL)word->xt; return (CELL)word->xt;
else else
{ {
F_QUOTATION *untagged = untag_quotation_fast(quot); F_QUOTATION *untagged = untag<F_QUOTATION>(quot);
if(untagged->compiledp == F) if(untagged->compiledp == F)
return (CELL)word->xt; return (CELL)word->xt;
else else
@ -188,7 +188,7 @@ void update_word_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
if(type == RT_XT || type == RT_XT_DIRECT) if(type == RT_XT || type == RT_XT_DIRECT)
{ {
CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1);
F_ARRAY *literals = untag_array_fast(compiled->literals); F_ARRAY *literals = untag<F_ARRAY>(compiled->literals);
CELL obj = array_nth(literals,index); CELL obj = array_nth(literals,index);
CELL xt; CELL xt;
@ -313,7 +313,7 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index)
CELL symbol = array_nth(literals,index); CELL symbol = array_nth(literals,index);
CELL library = array_nth(literals,index + 1); CELL library = array_nth(literals,index + 1);
F_DLL *dll = (library == F ? NULL : untag_dll(library)); F_DLL *dll = (library == F ? NULL : untag<F_DLL>(library));
if(dll != NULL && !dll->dll) if(dll != NULL && !dll->dll)
return (void *)undefined_symbol; return (void *)undefined_symbol;
@ -329,7 +329,7 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index)
else if(type_of(symbol) == ARRAY_TYPE) else if(type_of(symbol) == ARRAY_TYPE)
{ {
CELL i; CELL i;
F_ARRAY *names = untag_array_fast(symbol); F_ARRAY *names = untag<F_ARRAY>(symbol);
for(i = 0; i < array_capacity(names); i++) for(i = 0; i < array_capacity(names); i++)
{ {
F_SYMBOL *name = alien_offset(array_nth(names,i)); F_SYMBOL *name = alien_offset(array_nth(names,i));
@ -352,7 +352,7 @@ void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
#endif #endif
CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1);
F_ARRAY *literals = untag_array_fast(compiled->literals); F_ARRAY *literals = untag<F_ARRAY>(compiled->literals);
F_FIXNUM absolute_value; F_FIXNUM absolute_value;
switch(REL_TYPE(rel)) switch(REL_TYPE(rel))

27
vm/code_heap.cpp
View File

@ -136,25 +136,30 @@ void forward_object_xts(void)
while((obj = next_object()) != F) while((obj = next_object()) != F)
{ {
if(type_of(obj) == WORD_TYPE) switch(type_of(obj))
{ {
F_WORD *word = untag_word_fast(obj); case WORD_TYPE:
F_WORD *word = untag<F_WORD>(obj);
word->code = forward_xt(word->code); word->code = forward_xt(word->code);
if(word->profiling) if(word->profiling)
word->profiling = forward_xt(word->profiling); word->profiling = forward_xt(word->profiling);
}
else if(type_of(obj) == QUOTATION_TYPE) break;
{ case QUOTATION_TYPE:
F_QUOTATION *quot = untag_quotation_fast(obj); F_QUOTATION *quot = untag<F_QUOTATION>(obj);
if(quot->compiledp != F) if(quot->compiledp != F)
quot->code = forward_xt(quot->code); quot->code = forward_xt(quot->code);
}
else if(type_of(obj) == CALLSTACK_TYPE) break;
{ case CALLSTACK_TYPE:
F_CALLSTACK *stack = untag_callstack_fast(obj); F_CALLSTACK *stack = untag<F_CALLSTACK>(obj);
iterate_callstack_object(stack,forward_frame_xt); iterate_callstack_object(stack,forward_frame_xt);
break;
default:
break;
} }
} }
@ -175,7 +180,7 @@ void fixup_object_xts(void)
update_word_xt(obj); update_word_xt(obj);
else if(type_of(obj) == QUOTATION_TYPE) else if(type_of(obj) == QUOTATION_TYPE)
{ {
F_QUOTATION *quot = untag_quotation_fast(obj); F_QUOTATION *quot = untag<F_QUOTATION>(obj);
if(quot->compiledp != F) if(quot->compiledp != F)
set_quot_xt(quot,quot->code); set_quot_xt(quot,quot->code);

14
vm/data_heap.cpp
View File

@ -184,8 +184,8 @@ void init_data_heap(CELL gens,
gc_locals_region = alloc_segment(getpagesize()); gc_locals_region = alloc_segment(getpagesize());
gc_locals = gc_locals_region->start - CELLS; gc_locals = gc_locals_region->start - CELLS;
extra_roots_region = alloc_segment(getpagesize()); gc_bignums_region = alloc_segment(getpagesize());
extra_roots = extra_roots_region->start - CELLS; gc_bignums = gc_bignums_region->start - CELLS;
secure_gc = secure_gc_; secure_gc = secure_gc_;
@ -224,8 +224,8 @@ CELL unaligned_object_size(CELL pointer)
case STRING_TYPE: case STRING_TYPE:
return string_size(string_capacity((F_STRING*)pointer)); return string_size(string_capacity((F_STRING*)pointer));
case TUPLE_TYPE: case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer); tuple = untag<F_TUPLE>(pointer);
layout = untag_tuple_layout(tuple->layout); layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
return tuple_size(layout); return tuple_size(layout);
case QUOTATION_TYPE: case QUOTATION_TYPE:
return sizeof(F_QUOTATION); return sizeof(F_QUOTATION);
@ -241,7 +241,7 @@ CELL unaligned_object_size(CELL pointer)
return sizeof(F_WRAPPER); return sizeof(F_WRAPPER);
case CALLSTACK_TYPE: case CALLSTACK_TYPE:
return callstack_size( return callstack_size(
untag_fixnum_fast(((F_CALLSTACK *)pointer)->length)); untag_fixnum(((F_CALLSTACK *)pointer)->length));
default: default:
critical_error("Invalid header",pointer); critical_error("Invalid header",pointer);
return -1; /* can't happen */ return -1; /* can't happen */
@ -284,8 +284,8 @@ CELL binary_payload_start(CELL pointer)
case ARRAY_TYPE: case ARRAY_TYPE:
return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer)); return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer));
case TUPLE_TYPE: case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer); tuple = untag<F_TUPLE>(pointer);
layout = untag_tuple_layout(tuple->layout); layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
return tuple_size(layout); return tuple_size(layout);
case WRAPPER_TYPE: case WRAPPER_TYPE:
return sizeof(F_WRAPPER); return sizeof(F_WRAPPER);

20
vm/debug.cpp
View File

@ -15,12 +15,12 @@ void print_word(F_WORD* word, CELL nesting)
if(type_of(word->vocabulary) == STRING_TYPE) if(type_of(word->vocabulary) == STRING_TYPE)
{ {
print_chars(untag_string(word->vocabulary)); print_chars(untag<F_STRING>(word->vocabulary));
print_string(":"); print_string(":");
} }
if(type_of(word->name) == STRING_TYPE) if(type_of(word->name) == STRING_TYPE)
print_chars(untag_string(word->name)); print_chars(untag<F_STRING>(word->name));
else else
{ {
print_string("#<not a string: "); print_string("#<not a string: ");
@ -62,7 +62,7 @@ void print_array(F_ARRAY* array, CELL nesting)
void print_tuple(F_TUPLE* tuple, CELL nesting) void print_tuple(F_TUPLE* tuple, CELL nesting)
{ {
F_TUPLE_LAYOUT *layout = untag_tuple_layout(tuple->layout); F_TUPLE_LAYOUT *layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
CELL length = to_fixnum(layout->size); CELL length = to_fixnum(layout->size);
print_string(" "); print_string(" ");
@ -102,31 +102,31 @@ void print_nested_obj(CELL obj, F_FIXNUM nesting)
switch(type_of(obj)) switch(type_of(obj))
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
print_fixnum(untag_fixnum_fast(obj)); print_fixnum(untag_fixnum(obj));
break; break;
case WORD_TYPE: case WORD_TYPE:
print_word(untag_word(obj),nesting - 1); print_word(untag<F_WORD>(obj),nesting - 1);
break; break;
case STRING_TYPE: case STRING_TYPE:
print_factor_string(untag_string(obj)); print_factor_string(untag<F_STRING>(obj));
break; break;
case F_TYPE: case F_TYPE:
print_string("f"); print_string("f");
break; break;
case TUPLE_TYPE: case TUPLE_TYPE:
print_string("T{"); print_string("T{");
print_tuple(untag_tuple_fast(obj),nesting - 1); print_tuple(untag<F_TUPLE>(obj),nesting - 1);
print_string(" }"); print_string(" }");
break; break;
case ARRAY_TYPE: case ARRAY_TYPE:
print_string("{"); print_string("{");
print_array(untag_array_fast(obj),nesting - 1); print_array(untag<F_ARRAY>(obj),nesting - 1);
print_string(" }"); print_string(" }");
break; break;
case QUOTATION_TYPE: case QUOTATION_TYPE:
print_string("["); print_string("[");
quot = untag_quotation_fast(obj); quot = untag<F_QUOTATION>(obj);
print_array(untag_array_fast(quot->array),nesting - 1); print_array(untag<F_ARRAY>(quot->array),nesting - 1);
print_string(" ]"); print_string(" ]");
break; break;
default: default:

26
vm/dispatch.cpp
View File

@ -5,11 +5,11 @@ CELL megamorphic_cache_misses;
static CELL search_lookup_alist(CELL table, CELL klass) static CELL search_lookup_alist(CELL table, CELL klass)
{ {
F_ARRAY *pairs = untag_array_fast(table); F_ARRAY *pairs = untag<F_ARRAY>(table);
F_FIXNUM index = array_capacity(pairs) - 1; F_FIXNUM index = array_capacity(pairs) - 1;
while(index >= 0) while(index >= 0)
{ {
F_ARRAY *pair = untag_array_fast(array_nth(pairs,index)); F_ARRAY *pair = untag<F_ARRAY>(array_nth(pairs,index));
if(array_nth(pair,0) == klass) if(array_nth(pair,0) == klass)
return array_nth(pair,1); return array_nth(pair,1);
else else
@ -21,7 +21,7 @@ static CELL search_lookup_alist(CELL table, CELL klass)
static CELL search_lookup_hash(CELL table, CELL klass, CELL hashcode) static CELL search_lookup_hash(CELL table, CELL klass, CELL hashcode)
{ {
F_ARRAY *buckets = untag_array_fast(table); F_ARRAY *buckets = untag<F_ARRAY>(table);
CELL bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1)); CELL bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
if(type_of(bucket) == WORD_TYPE || bucket == F) if(type_of(bucket) == WORD_TYPE || bucket == F)
return bucket; return bucket;
@ -43,12 +43,12 @@ static CELL nth_hashcode(F_TUPLE_LAYOUT *layout, F_FIXNUM echelon)
static CELL lookup_tuple_method(CELL object, CELL methods) static CELL lookup_tuple_method(CELL object, CELL methods)
{ {
F_TUPLE *tuple = untag_tuple_fast(object); F_TUPLE *tuple = untag<F_TUPLE>(object);
F_TUPLE_LAYOUT *layout = untag_tuple_layout(tuple->layout); F_TUPLE_LAYOUT *layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
F_ARRAY *echelons = untag_array_fast(methods); F_ARRAY *echelons = untag<F_ARRAY>(methods);
F_FIXNUM echelon = untag_fixnum_fast(layout->echelon); F_FIXNUM echelon = untag_fixnum(layout->echelon);
F_FIXNUM max_echelon = array_capacity(echelons) - 1; F_FIXNUM max_echelon = array_capacity(echelons) - 1;
if(echelon > max_echelon) echelon = max_echelon; if(echelon > max_echelon) echelon = max_echelon;
@ -61,7 +61,7 @@ static CELL lookup_tuple_method(CELL object, CELL methods)
else if(echelon_methods != F) else if(echelon_methods != F)
{ {
CELL klass = nth_superclass(layout,echelon); CELL klass = nth_superclass(layout,echelon);
CELL hashcode = untag_fixnum_fast(nth_hashcode(layout,echelon)); CELL hashcode = untag_fixnum(nth_hashcode(layout,echelon));
CELL result = search_lookup_hash(echelon_methods,klass,hashcode); CELL result = search_lookup_hash(echelon_methods,klass,hashcode);
if(result != F) if(result != F)
return result; return result;
@ -76,7 +76,7 @@ static CELL lookup_tuple_method(CELL object, CELL methods)
static CELL lookup_hi_tag_method(CELL object, CELL methods) static CELL lookup_hi_tag_method(CELL object, CELL methods)
{ {
F_ARRAY *hi_tag_methods = untag_array_fast(methods); F_ARRAY *hi_tag_methods = untag<F_ARRAY>(methods);
CELL tag = hi_tag(object) - HEADER_TYPE; CELL tag = hi_tag(object) - HEADER_TYPE;
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
assert(tag < TYPE_COUNT - HEADER_TYPE); assert(tag < TYPE_COUNT - HEADER_TYPE);
@ -86,7 +86,7 @@ static CELL lookup_hi_tag_method(CELL object, CELL methods)
static CELL lookup_hairy_method(CELL object, CELL methods) static CELL lookup_hairy_method(CELL object, CELL methods)
{ {
CELL method = array_nth(untag_array_fast(methods),TAG(object)); CELL method = array_nth(untag<F_ARRAY>(methods),TAG(object));
if(type_of(method) == WORD_TYPE) if(type_of(method) == WORD_TYPE)
return method; return method;
else else
@ -109,7 +109,7 @@ static CELL lookup_hairy_method(CELL object, CELL methods)
CELL lookup_method(CELL object, CELL methods) CELL lookup_method(CELL object, CELL methods)
{ {
if(!HI_TAG_OR_TUPLE_P(object)) if(!HI_TAG_OR_TUPLE_P(object))
return array_nth(untag_array_fast(methods),TAG(object)); return array_nth(untag<F_ARRAY>(methods),TAG(object));
else else
return lookup_hairy_method(object,methods); return lookup_hairy_method(object,methods);
} }
@ -137,7 +137,7 @@ static CELL method_cache_hashcode(CELL klass, F_ARRAY *array)
static void update_method_cache(CELL cache, CELL klass, CELL method) static void update_method_cache(CELL cache, CELL klass, CELL method)
{ {
F_ARRAY *array = untag_array_fast(cache); F_ARRAY *array = untag<F_ARRAY>(cache);
CELL hashcode = method_cache_hashcode(klass,array); CELL hashcode = method_cache_hashcode(klass,array);
set_array_nth(array,hashcode,klass); set_array_nth(array,hashcode,klass);
set_array_nth(array,hashcode + 1,method); set_array_nth(array,hashcode + 1,method);
@ -148,7 +148,7 @@ void primitive_mega_cache_miss(void)
megamorphic_cache_misses++; megamorphic_cache_misses++;
CELL cache = dpop(); CELL cache = dpop();
F_FIXNUM index = untag_fixnum_fast(dpop()); F_FIXNUM index = untag_fixnum(dpop());
CELL methods = dpop(); CELL methods = dpop();
CELL object = get(ds - index * CELLS); CELL object = get(ds - index * CELLS);

9
vm/errors.cpp
View File

@ -39,7 +39,7 @@ void throw_error(CELL error, F_STACK_FRAME *callstack_top)
/* Reset local roots */ /* Reset local roots */
gc_locals = gc_locals_region->start - CELLS; gc_locals = gc_locals_region->start - CELLS;
extra_roots = extra_roots_region->start - CELLS; gc_bignums = gc_bignums_region->start - CELLS;
/* If we had an underflow or overflow, stack pointers might be /* If we had an underflow or overflow, stack pointers might be
out of bounds */ out of bounds */
@ -114,13 +114,6 @@ void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack)
else if(in_page(addr, nursery.end, 0, 0)) else if(in_page(addr, nursery.end, 0, 0))
critical_error("allot_object() missed GC check",0); critical_error("allot_object() missed GC check",0);
else if(in_page(addr, gc_locals_region->start, 0, -1)) else if(in_page(addr, gc_locals_region->start, 0, -1))
critical_error("gc locals underflow",0);
else if(in_page(addr, gc_locals_region->end, 0, 0))
critical_error("gc locals overflow",0);
else if(in_page(addr, extra_roots_region->start, 0, -1))
critical_error("extra roots underflow",0);
else if(in_page(addr, extra_roots_region->end, 0, 0))
critical_error("extra roots overflow",0);
else else
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack); general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
} }

11
vm/errors.hpp
View File

@ -39,17 +39,6 @@ INLINE void type_check(CELL type, CELL tagged)
if(type_of(tagged) != type) type_error(type,tagged); if(type_of(tagged) != type) type_error(type,tagged);
} }
#define DEFINE_UNTAG(type,check,name) \
INLINE type *untag_##name##_fast(CELL obj) \
{ \
return (type *)UNTAG(obj); \
} \
INLINE type *untag_##name(CELL obj) \
{ \
type_check(check,obj); \
return untag_##name##_fast(obj); \
} \
void primitive_unimplemented(void); void primitive_unimplemented(void);
/* Global variables used to pass fault handler state from signal handler to /* Global variables used to pass fault handler state from signal handler to

10
vm/inline_cache.cpp
View File

@ -47,7 +47,7 @@ static CELL determine_inline_cache_type(F_ARRAY *cache_entries)
switch(type_of(klass)) switch(type_of(klass))
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
type = untag_fixnum_fast(klass); type = untag_fixnum(klass);
if(type >= HEADER_TYPE) if(type >= HEADER_TYPE)
seen_hi_tag = true; seen_hi_tag = true;
break; break;
@ -86,7 +86,7 @@ struct inline_cache_jit : public jit {
void inline_cache_jit::emit_check(CELL klass) void inline_cache_jit::emit_check(CELL klass)
{ {
CELL code_template; CELL code_template;
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum_fast(klass) < HEADER_TYPE) if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
code_template = userenv[PIC_CHECK_TAG]; code_template = userenv[PIC_CHECK_TAG];
else else
code_template = userenv[PIC_CHECK]; code_template = userenv[PIC_CHECK];
@ -152,12 +152,12 @@ static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index,
/* A generic word's definition performs general method lookup. Allocates memory */ /* A generic word's definition performs general method lookup. Allocates memory */
static XT megamorphic_call_stub(CELL generic_word) static XT megamorphic_call_stub(CELL generic_word)
{ {
return untag_word(generic_word)->xt; return untag<F_WORD>(generic_word)->xt;
} }
static CELL inline_cache_size(CELL cache_entries) static CELL inline_cache_size(CELL cache_entries)
{ {
return array_capacity(untag_array(cache_entries)) / 2; return array_capacity(untag_check<F_ARRAY>(cache_entries)) / 2;
} }
/* Allocates memory */ /* Allocates memory */
@ -196,7 +196,7 @@ XT inline_cache_miss(CELL return_address)
deallocate_inline_cache(return_address); deallocate_inline_cache(return_address);
gc_root<F_ARRAY> cache_entries(dpop()); gc_root<F_ARRAY> cache_entries(dpop());
F_FIXNUM index = untag_fixnum_fast(dpop()); F_FIXNUM index = untag_fixnum(dpop());
gc_root<F_ARRAY> methods(dpop()); gc_root<F_ARRAY> methods(dpop());
gc_root<F_WORD> generic_word(dpop()); gc_root<F_WORD> generic_word(dpop());
gc_root<F_OBJECT> object(get(ds - index * CELLS)); gc_root<F_OBJECT> object(get(ds - index * CELLS));

4
vm/io.cpp
View File

@ -81,7 +81,7 @@ void primitive_fread(void)
if(size == 0) if(size == 0)
{ {
dpush(tag_object(allot_string(0,0))); dpush(tag<F_STRING>(allot_string(0,0)));
return; return;
} }
@ -135,7 +135,7 @@ void primitive_fputc(void)
void primitive_fwrite(void) void primitive_fwrite(void)
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = (FILE *)unbox_alien();
F_BYTE_ARRAY *text = untag_byte_array(dpop()); F_BYTE_ARRAY *text = untag_check<F_BYTE_ARRAY>(dpop());
CELL length = array_capacity(text); CELL length = array_capacity(text);
char *string = (char *)(text + 1); char *string = (char *)(text + 1);

8
vm/jit.cpp
View File

@ -22,7 +22,7 @@ jit::jit(CELL type_, CELL owner_)
F_REL jit::rel_to_emit(CELL code_template, bool *rel_p) F_REL jit::rel_to_emit(CELL code_template, bool *rel_p)
{ {
F_ARRAY *quadruple = untag_array_fast(code_template); F_ARRAY *quadruple = untag<F_ARRAY>(code_template);
CELL rel_class = array_nth(quadruple,1); CELL rel_class = array_nth(quadruple,1);
CELL rel_type = array_nth(quadruple,2); CELL rel_type = array_nth(quadruple,2);
CELL offset = array_nth(quadruple,3); CELL offset = array_nth(quadruple,3);
@ -35,9 +35,9 @@ F_REL jit::rel_to_emit(CELL code_template, bool *rel_p)
else else
{ {
*rel_p = true; *rel_p = true;
return (untag_fixnum_fast(rel_type) << 28) return (untag_fixnum(rel_type) << 28)
| (untag_fixnum_fast(rel_class) << 24) | (untag_fixnum(rel_class) << 24)
| ((code.count + untag_fixnum_fast(offset))); | ((code.count + untag_fixnum(offset)));
} }
} }

5
vm/jit.hpp
View File

@ -29,8 +29,9 @@ struct jit {
emit_with(userenv[JIT_WORD_CALL],word); emit_with(userenv[JIT_WORD_CALL],word);
} }
void emit_subprimitive(CELL word) { void emit_subprimitive(CELL word_) {
gc_root<F_ARRAY> code_template(untagged<F_WORD>(word)->subprimitive); gc_root<F_WORD> word(word_);
gc_root<F_ARRAY> code_template(word->subprimitive);
if(array_nth(code_template.untagged(),1) != F) literal(T); if(array_nth(code_template.untagged(),1) != F) literal(T);
emit(code_template.value()); emit(code_template.value());
} }

10
vm/layouts.hpp
View File

@ -68,8 +68,11 @@ INLINE bool immediate_p(CELL obj)
return (obj == F || TAG(obj) == FIXNUM_TYPE); return (obj == F || TAG(obj) == FIXNUM_TYPE);
} }
INLINE F_FIXNUM untag_fixnum_fast(CELL tagged) INLINE F_FIXNUM untag_fixnum(CELL tagged)
{ {
#ifdef FACTOR_DEBUG
assert(TAG(tagged) == FIXNUM_TYPE);
#endif
return ((F_FIXNUM)tagged) >> TAG_BITS; return ((F_FIXNUM)tagged) >> TAG_BITS;
} }
@ -80,8 +83,10 @@ INLINE CELL tag_fixnum(F_FIXNUM untagged)
typedef void *XT; typedef void *XT;
#define NO_TYPE_CHECK static const CELL type_number = TYPE_COUNT
struct F_OBJECT { struct F_OBJECT {
static const CELL type_number = TYPE_COUNT; NO_TYPE_CHECK;
CELL header; CELL header;
}; };
@ -96,6 +101,7 @@ struct F_ARRAY : public F_OBJECT {
/* These are really just arrays, but certain elements have special /* These are really just arrays, but certain elements have special
significance */ significance */
struct F_TUPLE_LAYOUT : public F_ARRAY { struct F_TUPLE_LAYOUT : public F_ARRAY {
NO_TYPE_CHECK;
/* tagged */ /* tagged */
CELL klass; CELL klass;
/* tagged fixnum */ /* tagged fixnum */

108
vm/math.cpp
View File

@ -10,9 +10,9 @@ F_FIXNUM to_fixnum(CELL tagged)
switch(TAG(tagged)) switch(TAG(tagged))
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
return untag_fixnum_fast(tagged); return untag_fixnum(tagged);
case BIGNUM_TYPE: case BIGNUM_TYPE:
return bignum_to_fixnum(untag_bignum_fast(tagged)); return bignum_to_fixnum(untag<F_BIGNUM>(tagged));
default: default:
type_error(FIXNUM_TYPE,tagged); type_error(FIXNUM_TYPE,tagged);
return -1; /* can't happen */ return -1; /* can't happen */
@ -26,7 +26,7 @@ CELL to_cell(CELL tagged)
void primitive_bignum_to_fixnum(void) void primitive_bignum_to_fixnum(void)
{ {
drepl(tag_fixnum(bignum_to_fixnum(untag_bignum_fast(dpeek())))); drepl(tag_fixnum(bignum_to_fixnum(untag<F_BIGNUM>(dpeek()))));
} }
void primitive_float_to_fixnum(void) void primitive_float_to_fixnum(void)
@ -38,14 +38,14 @@ void primitive_float_to_fixnum(void)
overflow, they call these functions. */ overflow, they call these functions. */
F_FASTCALL void overflow_fixnum_add(F_FIXNUM x, F_FIXNUM y) F_FASTCALL void overflow_fixnum_add(F_FIXNUM x, F_FIXNUM y)
{ {
drepl(tag_bignum(fixnum_to_bignum( drepl(tag<F_BIGNUM>(fixnum_to_bignum(
untag_fixnum_fast(x) + untag_fixnum_fast(y)))); untag_fixnum(x) + untag_fixnum(y))));
} }
F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y) F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y)
{ {
drepl(tag_bignum(fixnum_to_bignum( drepl(tag<F_BIGNUM>(fixnum_to_bignum(
untag_fixnum_fast(x) - untag_fixnum_fast(y)))); untag_fixnum(x) - untag_fixnum(y))));
} }
F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y) F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y)
@ -54,15 +54,15 @@ F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y)
REGISTER_BIGNUM(bx); REGISTER_BIGNUM(bx);
F_BIGNUM *by = fixnum_to_bignum(y); F_BIGNUM *by = fixnum_to_bignum(y);
UNREGISTER_BIGNUM(bx); UNREGISTER_BIGNUM(bx);
drepl(tag_bignum(bignum_multiply(bx,by))); drepl(tag<F_BIGNUM>(bignum_multiply(bx,by)));
} }
/* Division can only overflow when we are dividing the most negative fixnum /* Division can only overflow when we are dividing the most negative fixnum
by -1. */ by -1. */
void primitive_fixnum_divint(void) void primitive_fixnum_divint(void)
{ {
F_FIXNUM y = untag_fixnum_fast(dpop()); \ F_FIXNUM y = untag_fixnum(dpop()); \
F_FIXNUM x = untag_fixnum_fast(dpeek()); F_FIXNUM x = untag_fixnum(dpeek());
F_FIXNUM result = x / y; F_FIXNUM result = x / y;
if(result == -FIXNUM_MIN) if(result == -FIXNUM_MIN)
drepl(allot_integer(-FIXNUM_MIN)); drepl(allot_integer(-FIXNUM_MIN));
@ -81,7 +81,7 @@ void primitive_fixnum_divmod(void)
} }
else else
{ {
put(ds - CELLS,tag_fixnum(untag_fixnum_fast(x) / untag_fixnum_fast(y))); put(ds - CELLS,tag_fixnum(untag_fixnum(x) / untag_fixnum(y)));
put(ds,(F_FIXNUM)x % (F_FIXNUM)y); put(ds,(F_FIXNUM)x % (F_FIXNUM)y);
} }
} }
@ -96,8 +96,8 @@ void primitive_fixnum_divmod(void)
void primitive_fixnum_shift(void) void primitive_fixnum_shift(void)
{ {
F_FIXNUM y = untag_fixnum_fast(dpop()); \ F_FIXNUM y = untag_fixnum(dpop()); \
F_FIXNUM x = untag_fixnum_fast(dpeek()); F_FIXNUM x = untag_fixnum(dpeek());
if(x == 0) if(x == 0)
return; return;
@ -117,24 +117,24 @@ void primitive_fixnum_shift(void)
} }
} }
drepl(tag_bignum(bignum_arithmetic_shift( drepl(tag<F_BIGNUM>(bignum_arithmetic_shift(
fixnum_to_bignum(x),y))); fixnum_to_bignum(x),y)));
} }
/* Bignums */ /* Bignums */
void primitive_fixnum_to_bignum(void) void primitive_fixnum_to_bignum(void)
{ {
drepl(tag_bignum(fixnum_to_bignum(untag_fixnum_fast(dpeek())))); drepl(tag<F_BIGNUM>(fixnum_to_bignum(untag_fixnum(dpeek()))));
} }
void primitive_float_to_bignum(void) void primitive_float_to_bignum(void)
{ {
drepl(tag_bignum(float_to_bignum(dpeek()))); drepl(tag<F_BIGNUM>(float_to_bignum(dpeek())));
} }
#define POP_BIGNUMS(x,y) \ #define POP_BIGNUMS(x,y) \
F_BIGNUM * y = untag_bignum_fast(dpop()); \ F_BIGNUM * y = untag<F_BIGNUM>(dpop()); \
F_BIGNUM * x = untag_bignum_fast(dpop()); F_BIGNUM * x = untag<F_BIGNUM>(dpop());
void primitive_bignum_eq(void) void primitive_bignum_eq(void)
{ {
@ -145,25 +145,25 @@ void primitive_bignum_eq(void)
void primitive_bignum_add(void) void primitive_bignum_add(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_add(x,y))); dpush(tag<F_BIGNUM>(bignum_add(x,y)));
} }
void primitive_bignum_subtract(void) void primitive_bignum_subtract(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_subtract(x,y))); dpush(tag<F_BIGNUM>(bignum_subtract(x,y)));
} }
void primitive_bignum_multiply(void) void primitive_bignum_multiply(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_multiply(x,y))); dpush(tag<F_BIGNUM>(bignum_multiply(x,y)));
} }
void primitive_bignum_divint(void) void primitive_bignum_divint(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_quotient(x,y))); dpush(tag<F_BIGNUM>(bignum_quotient(x,y)));
} }
void primitive_bignum_divmod(void) void primitive_bignum_divmod(void)
@ -171,39 +171,39 @@ void primitive_bignum_divmod(void)
F_BIGNUM *q, *r; F_BIGNUM *q, *r;
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
bignum_divide(x,y,&q,&r); bignum_divide(x,y,&q,&r);
dpush(tag_bignum(q)); dpush(tag<F_BIGNUM>(q));
dpush(tag_bignum(r)); dpush(tag<F_BIGNUM>(r));
} }
void primitive_bignum_mod(void) void primitive_bignum_mod(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_remainder(x,y))); dpush(tag<F_BIGNUM>(bignum_remainder(x,y)));
} }
void primitive_bignum_and(void) void primitive_bignum_and(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_bitwise_and(x,y))); dpush(tag<F_BIGNUM>(bignum_bitwise_and(x,y)));
} }
void primitive_bignum_or(void) void primitive_bignum_or(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_bitwise_ior(x,y))); dpush(tag<F_BIGNUM>(bignum_bitwise_ior(x,y)));
} }
void primitive_bignum_xor(void) void primitive_bignum_xor(void)
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_bitwise_xor(x,y))); dpush(tag<F_BIGNUM>(bignum_bitwise_xor(x,y)));
} }
void primitive_bignum_shift(void) void primitive_bignum_shift(void)
{ {
F_FIXNUM y = untag_fixnum_fast(dpop()); F_FIXNUM y = untag_fixnum(dpop());
F_BIGNUM* x = untag_bignum_fast(dpop()); F_BIGNUM* x = untag<F_BIGNUM>(dpop());
dpush(tag_bignum(bignum_arithmetic_shift(x,y))); dpush(tag<F_BIGNUM>(bignum_arithmetic_shift(x,y)));
} }
void primitive_bignum_less(void) void primitive_bignum_less(void)
@ -232,19 +232,19 @@ void primitive_bignum_greatereq(void)
void primitive_bignum_not(void) void primitive_bignum_not(void)
{ {
drepl(tag_bignum(bignum_bitwise_not(untag_bignum_fast(dpeek())))); drepl(tag<F_BIGNUM>(bignum_bitwise_not(untag<F_BIGNUM>(dpeek()))));
} }
void primitive_bignum_bitp(void) void primitive_bignum_bitp(void)
{ {
F_FIXNUM bit = to_fixnum(dpop()); F_FIXNUM bit = to_fixnum(dpop());
F_BIGNUM *x = untag_bignum_fast(dpop()); F_BIGNUM *x = untag<F_BIGNUM>(dpop());
box_boolean(bignum_logbitp(bit,x)); box_boolean(bignum_logbitp(bit,x));
} }
void primitive_bignum_log2(void) void primitive_bignum_log2(void)
{ {
drepl(tag_bignum(bignum_integer_length(untag_bignum_fast(dpeek())))); drepl(tag<F_BIGNUM>(bignum_integer_length(untag<F_BIGNUM>(dpeek()))));
} }
unsigned int bignum_producer(unsigned int digit) unsigned int bignum_producer(unsigned int digit)
@ -255,9 +255,9 @@ unsigned int bignum_producer(unsigned int digit)
void primitive_byte_array_to_bignum(void) void primitive_byte_array_to_bignum(void)
{ {
CELL n_digits = array_capacity(untag_byte_array(dpeek())); CELL n_digits = array_capacity(untag_check<F_BYTE_ARRAY>(dpeek()));
F_BIGNUM * bignum = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0); F_BIGNUM * bignum = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0);
drepl(tag_bignum(bignum)); drepl(tag<F_BIGNUM>(bignum));
} }
void box_signed_1(s8 n) void box_signed_1(s8 n)
@ -303,7 +303,7 @@ void box_unsigned_cell(CELL cell)
void box_signed_8(s64 n) void box_signed_8(s64 n)
{ {
if(n < FIXNUM_MIN || n > FIXNUM_MAX) if(n < FIXNUM_MIN || n > FIXNUM_MAX)
dpush(tag_bignum(long_long_to_bignum(n))); dpush(tag<F_BIGNUM>(long_long_to_bignum(n)));
else else
dpush(tag_fixnum(n)); dpush(tag_fixnum(n));
} }
@ -313,9 +313,9 @@ s64 to_signed_8(CELL obj)
switch(type_of(obj)) switch(type_of(obj))
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
return untag_fixnum_fast(obj); return untag_fixnum(obj);
case BIGNUM_TYPE: case BIGNUM_TYPE:
return bignum_to_long_long(untag_bignum_fast(obj)); return bignum_to_long_long(untag<F_BIGNUM>(obj));
default: default:
type_error(BIGNUM_TYPE,obj); type_error(BIGNUM_TYPE,obj);
return -1; return -1;
@ -325,7 +325,7 @@ s64 to_signed_8(CELL obj)
void box_unsigned_8(u64 n) void box_unsigned_8(u64 n)
{ {
if(n > FIXNUM_MAX) if(n > FIXNUM_MAX)
dpush(tag_bignum(ulong_long_to_bignum(n))); dpush(tag<F_BIGNUM>(ulong_long_to_bignum(n)));
else else
dpush(tag_fixnum(n)); dpush(tag_fixnum(n));
} }
@ -335,9 +335,9 @@ u64 to_unsigned_8(CELL obj)
switch(type_of(obj)) switch(type_of(obj))
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
return untag_fixnum_fast(obj); return untag_fixnum(obj);
case BIGNUM_TYPE: case BIGNUM_TYPE:
return bignum_to_ulong_long(untag_bignum_fast(obj)); return bignum_to_ulong_long(untag<F_BIGNUM>(obj));
default: default:
type_error(BIGNUM_TYPE,obj); type_error(BIGNUM_TYPE,obj);
return -1; return -1;
@ -350,7 +350,7 @@ CELL unbox_array_size(void)
{ {
case FIXNUM_TYPE: case FIXNUM_TYPE:
{ {
F_FIXNUM n = untag_fixnum_fast(dpeek()); F_FIXNUM n = untag_fixnum(dpeek());
if(n >= 0 && n < (F_FIXNUM)ARRAY_SIZE_MAX) if(n >= 0 && n < (F_FIXNUM)ARRAY_SIZE_MAX)
{ {
dpop(); dpop();
@ -360,9 +360,9 @@ CELL unbox_array_size(void)
} }
case BIGNUM_TYPE: case BIGNUM_TYPE:
{ {
F_BIGNUM * zero = untag_bignum_fast(bignum_zero); F_BIGNUM * zero = untag<F_BIGNUM>(bignum_zero);
F_BIGNUM * max = cell_to_bignum(ARRAY_SIZE_MAX); F_BIGNUM * max = cell_to_bignum(ARRAY_SIZE_MAX);
F_BIGNUM * n = untag_bignum_fast(dpeek()); F_BIGNUM * n = untag<F_BIGNUM>(dpeek());
if(bignum_compare(n,zero) != bignum_comparison_less if(bignum_compare(n,zero) != bignum_comparison_less
&& bignum_compare(n,max) == bignum_comparison_less) && bignum_compare(n,max) == bignum_comparison_less)
{ {
@ -390,7 +390,7 @@ void primitive_bignum_to_float(void)
void primitive_str_to_float(void) void primitive_str_to_float(void)
{ {
F_BYTE_ARRAY *bytes = untag_byte_array(dpeek()); F_BYTE_ARRAY *bytes = untag_check<F_BYTE_ARRAY>(dpeek());
CELL capacity = array_capacity(bytes); CELL capacity = array_capacity(bytes);
char *c_str = (char *)(bytes + 1); char *c_str = (char *)(bytes + 1);
@ -405,13 +405,13 @@ void primitive_str_to_float(void)
void primitive_float_to_str(void) void primitive_float_to_str(void)
{ {
F_BYTE_ARRAY *array = allot_byte_array(33); F_BYTE_ARRAY *array = allot_byte_array(33);
snprintf((char *)(array + 1),32,"%.16g",untag_float(dpop())); snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
dpush(tag_object(array)); dpush(tag<F_BYTE_ARRAY>(array));
} }
#define POP_FLOATS(x,y) \ #define POP_FLOATS(x,y) \
double y = untag_float_fast(dpop()); \ double y = untag_float(dpop()); \
double x = untag_float_fast(dpop()); double x = untag_float(dpop());
void primitive_float_eq(void) void primitive_float_eq(void)
{ {
@ -475,7 +475,7 @@ void primitive_float_greatereq(void)
void primitive_float_bits(void) void primitive_float_bits(void)
{ {
box_unsigned_4(float_bits(untag_float(dpop()))); box_unsigned_4(float_bits(untag_float_check(dpop())));
} }
void primitive_bits_float(void) void primitive_bits_float(void)
@ -485,7 +485,7 @@ void primitive_bits_float(void)
void primitive_double_bits(void) void primitive_double_bits(void)
{ {
box_unsigned_8(double_bits(untag_float(dpop()))); box_unsigned_8(double_bits(untag_float_check(dpop())));
} }
void primitive_bits_double(void) void primitive_bits_double(void)
@ -495,12 +495,12 @@ void primitive_bits_double(void)
float to_float(CELL value) float to_float(CELL value)
{ {
return untag_float(value); return untag_float_check(value);
} }
double to_double(CELL value) double to_double(CELL value)
{ {
return untag_float(value); return untag_float_check(value);
} }
void box_float(float flo) void box_float(float flo)

32
vm/math.hpp
View File

@ -21,13 +21,6 @@ extern CELL bignum_zero;
extern CELL bignum_pos_one; extern CELL bignum_pos_one;
extern CELL bignum_neg_one; extern CELL bignum_neg_one;
DEFINE_UNTAG(F_BIGNUM,BIGNUM_TYPE,bignum);
INLINE CELL tag_bignum(F_BIGNUM* bignum)
{
return RETAG(bignum,BIGNUM_TYPE);
}
void primitive_fixnum_to_bignum(void); void primitive_fixnum_to_bignum(void);
void primitive_float_to_bignum(void); void primitive_float_to_bignum(void);
void primitive_bignum_eq(void); void primitive_bignum_eq(void);
@ -53,7 +46,7 @@ void primitive_byte_array_to_bignum(void);
INLINE CELL allot_integer(F_FIXNUM x) INLINE CELL allot_integer(F_FIXNUM x)
{ {
if(x < FIXNUM_MIN || x > FIXNUM_MAX) if(x < FIXNUM_MIN || x > FIXNUM_MAX)
return tag_bignum(fixnum_to_bignum(x)); return tag<F_BIGNUM>(fixnum_to_bignum(x));
else else
return tag_fixnum(x); return tag_fixnum(x);
} }
@ -61,7 +54,7 @@ INLINE CELL allot_integer(F_FIXNUM x)
INLINE CELL allot_cell(CELL x) INLINE CELL allot_cell(CELL x)
{ {
if(x > (CELL)FIXNUM_MAX) if(x > (CELL)FIXNUM_MAX)
return tag_bignum(cell_to_bignum(x)); return tag<F_BIGNUM>(cell_to_bignum(x));
else else
return tag_fixnum(x); return tag_fixnum(x);
} }
@ -83,15 +76,14 @@ DLLEXPORT u64 to_unsigned_8(CELL obj);
CELL unbox_array_size(void); CELL unbox_array_size(void);
INLINE double untag_float_fast(CELL tagged)
{
return ((F_FLOAT *)UNTAG(tagged))->n;
}
INLINE double untag_float(CELL tagged) INLINE double untag_float(CELL tagged)
{ {
type_check(FLOAT_TYPE,tagged); return untag<F_FLOAT>(tagged)->n;
return untag_float_fast(tagged); }
INLINE double untag_float_check(CELL tagged)
{
return untag_check<F_FLOAT>(tagged)->n;
} }
INLINE CELL allot_float(double n) INLINE CELL allot_float(double n)
@ -103,22 +95,22 @@ INLINE CELL allot_float(double n)
INLINE F_FIXNUM float_to_fixnum(CELL tagged) INLINE F_FIXNUM float_to_fixnum(CELL tagged)
{ {
return (F_FIXNUM)untag_float_fast(tagged); return (F_FIXNUM)untag_float(tagged);
} }
INLINE F_BIGNUM *float_to_bignum(CELL tagged) INLINE F_BIGNUM *float_to_bignum(CELL tagged)
{ {
return double_to_bignum(untag_float_fast(tagged)); return double_to_bignum(untag_float(tagged));
} }
INLINE double fixnum_to_float(CELL tagged) INLINE double fixnum_to_float(CELL tagged)
{ {
return (double)untag_fixnum_fast(tagged); return (double)untag_fixnum(tagged);
} }
INLINE double bignum_to_float(CELL tagged) INLINE double bignum_to_float(CELL tagged)
{ {
return bignum_to_double(untag_bignum_fast(tagged)); return bignum_to_double(untag<F_BIGNUM>(tagged));
} }
DLLEXPORT void box_float(float flo); DLLEXPORT void box_float(float flo);

2
vm/os-unix.cpp
View File

@ -55,7 +55,7 @@ void ffi_dlclose(F_DLL *dll)
void primitive_existsp(void) void primitive_existsp(void)
{ {
struct stat sb; struct stat sb;
char *path = (char *)(untag_byte_array(dpop()) + 1); char *path = (char *)(untag_check<F_BYTE_ARRAY>(dpop()) + 1);
box_boolean(stat(path,&sb) >= 0); box_boolean(stat(path,&sb) >= 0);
} }

8
vm/quotations.cpp
View File

@ -88,7 +88,7 @@ bool quotation_jit::stack_frame_p()
CELL obj = array_nth(array.untagged(),i); CELL obj = array_nth(array.untagged(),i);
if(type_of(obj) == WORD_TYPE) if(type_of(obj) == WORD_TYPE)
{ {
if(untagged<F_WORD>(obj)->subprimitive == F) if(untag<F_WORD>(obj)->subprimitive == F)
return true; return true;
} }
else if(type_of(obj) == QUOTATION_TYPE) else if(type_of(obj) == QUOTATION_TYPE)
@ -221,7 +221,7 @@ void quotation_jit::iterate_quotation()
{ {
emit_mega_cache_lookup( emit_mega_cache_lookup(
array_nth(array.untagged(),i), array_nth(array.untagged(),i),
untag_fixnum_fast(array_nth(array.untagged(),i + 1)), untag_fixnum(array_nth(array.untagged(),i + 1)),
array_nth(array.untagged(),i + 2)); array_nth(array.untagged(),i + 2));
i += 3; i += 3;
tail_call = true; tail_call = true;
@ -290,12 +290,12 @@ void primitive_array_to_quotation(void)
quot->compiledp = F; quot->compiledp = F;
quot->cached_effect = F; quot->cached_effect = F;
quot->cache_counter = F; quot->cache_counter = F;
drepl(tag_quotation(quot)); drepl(tag<F_QUOTATION>(quot));
} }
void primitive_quotation_xt(void) void primitive_quotation_xt(void)
{ {
F_QUOTATION *quot = untag_quotation(dpeek()); F_QUOTATION *quot = untag_check<F_QUOTATION>(dpeek());
drepl(allot_cell((CELL)quot->xt)); drepl(allot_cell((CELL)quot->xt));
} }

7
vm/quotations.hpp
View File

@ -1,10 +1,3 @@
DEFINE_UNTAG(F_QUOTATION,QUOTATION_TYPE,quotation)
INLINE CELL tag_quotation(F_QUOTATION *quotation)
{
return RETAG(quotation,QUOTATION_TYPE);
}
struct quotation_jit : public jit { struct quotation_jit : public jit {
gc_root<F_ARRAY> array; gc_root<F_ARRAY> array;
bool compiling, relocate; bool compiling, relocate;

16
vm/run.cpp
View File

@ -126,7 +126,7 @@ bool stack_to_array(CELL bottom, CELL top)
{ {
F_ARRAY *a = allot_array_internal<F_ARRAY>(depth / CELLS); F_ARRAY *a = allot_array_internal<F_ARRAY>(depth / CELLS);
memcpy(a + 1,(void*)bottom,depth); memcpy(a + 1,(void*)bottom,depth);
dpush(tag_array(a)); dpush(tag<F_ARRAY>(a));
return true; return true;
} }
} }
@ -153,12 +153,12 @@ CELL array_to_stack(F_ARRAY *array, CELL bottom)
void primitive_set_datastack(void) void primitive_set_datastack(void)
{ {
ds = array_to_stack(untag_array(dpop()),ds_bot); ds = array_to_stack(untag_check<F_ARRAY>(dpop()),ds_bot);
} }
void primitive_set_retainstack(void) void primitive_set_retainstack(void)
{ {
rs = array_to_stack(untag_array(dpop()),rs_bot); rs = array_to_stack(untag_check<F_ARRAY>(dpop()),rs_bot);
} }
/* Used to implement call( */ /* Used to implement call( */
@ -167,7 +167,7 @@ void primitive_check_datastack(void)
F_FIXNUM out = to_fixnum(dpop()); F_FIXNUM out = to_fixnum(dpop());
F_FIXNUM in = to_fixnum(dpop()); F_FIXNUM in = to_fixnum(dpop());
F_FIXNUM height = out - in; F_FIXNUM height = out - in;
F_ARRAY *array = untag_array(dpop()); F_ARRAY *array = untag_check<F_ARRAY>(dpop());
F_FIXNUM length = array_capacity(array); F_FIXNUM length = array_capacity(array);
F_FIXNUM depth = (ds - ds_bot + CELLS) / CELLS; F_FIXNUM depth = (ds - ds_bot + CELLS) / CELLS;
if(depth - height != length) if(depth - height != length)
@ -189,13 +189,13 @@ void primitive_check_datastack(void)
void primitive_getenv(void) void primitive_getenv(void)
{ {
F_FIXNUM e = untag_fixnum_fast(dpeek()); F_FIXNUM e = untag_fixnum(dpeek());
drepl(userenv[e]); drepl(userenv[e]);
} }
void primitive_setenv(void) void primitive_setenv(void)
{ {
F_FIXNUM e = untag_fixnum_fast(dpop()); F_FIXNUM e = untag_fixnum(dpop());
CELL value = dpop(); CELL value = dpop();
userenv[e] = value; userenv[e] = value;
} }
@ -217,7 +217,7 @@ void primitive_sleep(void)
void primitive_set_slot(void) void primitive_set_slot(void)
{ {
F_FIXNUM slot = untag_fixnum_fast(dpop()); F_FIXNUM slot = untag_fixnum(dpop());
CELL obj = dpop(); CELL obj = dpop();
CELL value = dpop(); CELL value = dpop();
set_slot(obj,slot,value); set_slot(obj,slot,value);
@ -225,7 +225,7 @@ void primitive_set_slot(void)
void primitive_load_locals(void) void primitive_load_locals(void)
{ {
F_FIXNUM count = untag_fixnum_fast(dpop()); F_FIXNUM count = untag_fixnum(dpop());
memcpy((CELL *)(rs + CELLS),(CELL *)(ds - CELLS * (count - 1)),CELLS * count); memcpy((CELL *)(rs + CELLS),(CELL *)(ds - CELLS * (count - 1)),CELLS * count);
ds -= CELLS * count; ds -= CELLS * count;
rs += CELLS * count; rs += CELLS * count;

10
vm/run.hpp
View File

@ -144,7 +144,7 @@ INLINE CELL tag_header(CELL cell)
INLINE void check_header(CELL cell) INLINE void check_header(CELL cell)
{ {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
assert(TAG(cell) == FIXNUM_TYPE && untag_fixnum_fast(cell) < TYPE_COUNT); assert(TAG(cell) == FIXNUM_TYPE && untag_fixnum(cell) < TYPE_COUNT);
#endif #endif
} }
@ -159,14 +159,6 @@ INLINE CELL hi_tag(CELL tagged)
return untag_header(get(UNTAG(tagged))); return untag_header(get(UNTAG(tagged)));
} }
INLINE CELL tag_object(void *cell)
{
#ifdef FACTOR_DEBUG
assert(hi_tag((CELL)cell) >= HEADER_TYPE);
#endif
return RETAG(cell,OBJECT_TYPE);
}
INLINE CELL type_of(CELL tagged) INLINE CELL type_of(CELL tagged)
{ {
CELL tag = TAG(tagged); CELL tag = TAG(tagged);

42
vm/strings.cpp
View File

@ -12,7 +12,7 @@ CELL string_nth(F_STRING* string, CELL index)
return ch; return ch;
else else
{ {
F_BYTE_ARRAY *aux = untag_byte_array_fast(string->aux); F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
return (cget(BREF(aux,index * sizeof(u16))) << 7) ^ ch; return (cget(BREF(aux,index * sizeof(u16))) << 7) ^ ch;
} }
} }
@ -39,14 +39,14 @@ void set_string_nth_slow(F_STRING *string_, CELL index, CELL ch)
character is set. Initially all of character is set. Initially all of
the bits are clear. */ the bits are clear. */
aux = allot_array_internal<F_BYTE_ARRAY>( aux = allot_array_internal<F_BYTE_ARRAY>(
untag_fixnum_fast(string->length) untag_fixnum(string->length)
* sizeof(u16)); * sizeof(u16));
write_barrier(string.value()); write_barrier(string.value());
string->aux = tag_object(aux); string->aux = tag<F_BYTE_ARRAY>(aux);
} }
else else
aux = untag_byte_array_fast(string->aux); aux = untag<F_BYTE_ARRAY>(string->aux);
cput(BREF(aux,index * sizeof(u16)),(ch >> 7) ^ 1); cput(BREF(aux,index * sizeof(u16)),(ch >> 7) ^ 1);
} }
@ -100,7 +100,7 @@ void primitive_string(void)
{ {
CELL initial = to_cell(dpop()); CELL initial = to_cell(dpop());
CELL length = unbox_array_size(); CELL length = unbox_array_size();
dpush(tag_object(allot_string(length,initial))); dpush(tag<F_STRING>(allot_string(length,initial)));
} }
static bool reallot_string_in_place_p(F_STRING *string, CELL capacity) static bool reallot_string_in_place_p(F_STRING *string, CELL capacity)
@ -118,7 +118,7 @@ F_STRING* reallot_string(F_STRING *string_, CELL capacity)
if(string->aux != F) if(string->aux != F)
{ {
F_BYTE_ARRAY *aux = untag_byte_array_fast(string->aux); F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
aux->capacity = tag_fixnum(capacity * 2); aux->capacity = tag_fixnum(capacity * 2);
} }
@ -139,9 +139,9 @@ F_STRING* reallot_string(F_STRING *string_, CELL capacity)
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16)); F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
write_barrier(new_string.value()); write_barrier(new_string.value());
new_string->aux = tag_object(new_aux); new_string->aux = tag<F_BYTE_ARRAY>(new_aux);
F_BYTE_ARRAY *aux = untag_byte_array_fast(string->aux); F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16)); memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
} }
@ -152,38 +152,38 @@ F_STRING* reallot_string(F_STRING *string_, CELL capacity)
void primitive_resize_string(void) void primitive_resize_string(void)
{ {
F_STRING* string = untag_string(dpop()); F_STRING* string = untag_check<F_STRING>(dpop());
CELL capacity = unbox_array_size(); CELL capacity = unbox_array_size();
dpush(tag_object(reallot_string(string,capacity))); dpush(tag<F_STRING>(reallot_string(string,capacity)));
} }
void primitive_string_nth(void) void primitive_string_nth(void)
{ {
F_STRING *string = untag_string_fast(dpop()); F_STRING *string = untag<F_STRING>(dpop());
CELL index = untag_fixnum_fast(dpop()); CELL index = untag_fixnum(dpop());
dpush(tag_fixnum(string_nth(string,index))); dpush(tag_fixnum(string_nth(string,index)));
} }
void primitive_set_string_nth(void) void primitive_set_string_nth(void)
{ {
F_STRING *string = untag_string_fast(dpop()); F_STRING *string = untag<F_STRING>(dpop());
CELL index = untag_fixnum_fast(dpop()); CELL index = untag_fixnum(dpop());
CELL value = untag_fixnum_fast(dpop()); CELL value = untag_fixnum(dpop());
set_string_nth(string,index,value); set_string_nth(string,index,value);
} }
void primitive_set_string_nth_fast(void) void primitive_set_string_nth_fast(void)
{ {
F_STRING *string = untag_string_fast(dpop()); F_STRING *string = untag<F_STRING>(dpop());
CELL index = untag_fixnum_fast(dpop()); CELL index = untag_fixnum(dpop());
CELL value = untag_fixnum_fast(dpop()); CELL value = untag_fixnum(dpop());
set_string_nth_fast(string,index,value); set_string_nth_fast(string,index,value);
} }
void primitive_set_string_nth_slow(void) void primitive_set_string_nth_slow(void)
{ {
F_STRING *string = untag_string_fast(dpop()); F_STRING *string = untag<F_STRING>(dpop());
CELL index = untag_fixnum_fast(dpop()); CELL index = untag_fixnum(dpop());
CELL value = untag_fixnum_fast(dpop()); CELL value = untag_fixnum(dpop());
set_string_nth_slow(string,index,value); set_string_nth_slow(string,index,value);
} }

4
vm/strings.hpp
View File

@ -1,6 +1,6 @@
INLINE CELL string_capacity(F_STRING *str) INLINE CELL string_capacity(F_STRING *str)
{ {
return untag_fixnum_fast(str->length); return untag_fixnum(str->length);
} }
INLINE CELL string_size(CELL size) INLINE CELL string_size(CELL size)
@ -11,8 +11,6 @@ INLINE CELL string_size(CELL size)
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index)) #define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index)) #define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
DEFINE_UNTAG(F_STRING,STRING_TYPE,string)
F_STRING* allot_string_internal(CELL capacity); F_STRING* allot_string_internal(CELL capacity);
F_STRING* allot_string(CELL capacity, CELL fill); F_STRING* allot_string(CELL capacity, CELL fill);
void primitive_string(void); void primitive_string(void);

2
vm/tagged.hpp
View File

@ -49,7 +49,7 @@ template <typename T> T *untag_check(CELL value)
return tagged<T>(value).untag_check(); return tagged<T>(value).untag_check();
} }
template <typename T> T *untagged(CELL value) template <typename T> T *untag(CELL value)
{ {
return tagged<T>(value).untagged(); return tagged<T>(value).untagged();
} }

4
vm/tuples.cpp
View File

@ -17,7 +17,7 @@ void primitive_tuple(void)
for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--) for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--)
put(AREF(tuple,i),F); put(AREF(tuple,i),F);
dpush(tag_tuple(tuple)); dpush(tag<F_TUPLE>(tuple));
} }
/* push a new tuple on the stack, filling its slots from the stack */ /* push a new tuple on the stack, filling its slots from the stack */
@ -25,7 +25,7 @@ void primitive_tuple_boa(void)
{ {
gc_root<F_TUPLE_LAYOUT> layout(dpop()); gc_root<F_TUPLE_LAYOUT> layout(dpop());
gc_root<F_TUPLE> tuple(allot_tuple(layout.value())); gc_root<F_TUPLE> tuple(allot_tuple(layout.value()));
CELL size = untag_fixnum_fast(layout.untagged()->size) * CELLS; CELL size = untag_fixnum(layout.untagged()->size) * CELLS;
memcpy(tuple.untagged() + 1,(CELL *)(ds - (size - CELLS)),size); memcpy(tuple.untagged() + 1,(CELL *)(ds - (size - CELLS)),size);
ds -= size; ds -= size;
dpush(tuple.value()); dpush(tuple.value());

14
vm/tuples.hpp
View File

@ -1,21 +1,9 @@
INLINE CELL tag_tuple(F_TUPLE *tuple)
{
return RETAG(tuple,TUPLE_TYPE);
}
INLINE CELL tuple_size(F_TUPLE_LAYOUT *layout) INLINE CELL tuple_size(F_TUPLE_LAYOUT *layout)
{ {
CELL size = untag_fixnum_fast(layout->size); CELL size = untag_fixnum(layout->size);
return sizeof(F_TUPLE) + size * CELLS; return sizeof(F_TUPLE) + size * CELLS;
} }
DEFINE_UNTAG(F_TUPLE,TUPLE_TYPE,tuple)
INLINE F_TUPLE_LAYOUT *untag_tuple_layout(CELL obj)
{
return (F_TUPLE_LAYOUT *)UNTAG(obj);
}
INLINE CELL tuple_nth(F_TUPLE *tuple, CELL slot) INLINE CELL tuple_nth(F_TUPLE *tuple, CELL slot)
{ {
return get(AREF(tuple,slot)); return get(AREF(tuple,slot));

8
vm/words.cpp
View File

@ -32,13 +32,13 @@ void primitive_word(void)
{ {
CELL vocab = dpop(); CELL vocab = dpop();
CELL name = dpop(); CELL name = dpop();
dpush(tag_object(allot_word(vocab,name))); dpush(tag<F_WORD>(allot_word(vocab,name)));
} }
/* word-xt ( word -- start end ) */ /* word-xt ( word -- start end ) */
void primitive_word_xt(void) void primitive_word_xt(void)
{ {
F_WORD *word = untag_word(dpop()); F_WORD *word = untag_check<F_WORD>(dpop());
F_CODE_BLOCK *code = (profiling_p ? word->profiling : word->code); F_CODE_BLOCK *code = (profiling_p ? word->profiling : word->code);
dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK))); dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK)));
dpush(allot_cell((CELL)code + code->block.size)); dpush(allot_cell((CELL)code + code->block.size));
@ -65,12 +65,12 @@ void update_word_xt(CELL word_)
void primitive_optimized_p(void) void primitive_optimized_p(void)
{ {
drepl(tag_boolean(word_optimized_p(untag_word(dpeek())))); drepl(tag_boolean(word_optimized_p(untag_check<F_WORD>(dpeek()))));
} }
void primitive_wrapper(void) void primitive_wrapper(void)
{ {
F_WRAPPER *wrapper = allot<F_WRAPPER>(sizeof(F_WRAPPER)); F_WRAPPER *wrapper = allot<F_WRAPPER>(sizeof(F_WRAPPER));
wrapper->object = dpeek(); wrapper->object = dpeek();
drepl(tag_object(wrapper)); drepl(tag<F_WRAPPER>(wrapper));
} }

4
vm/words.hpp
View File

@ -1,5 +1,3 @@
DEFINE_UNTAG(F_WORD,WORD_TYPE,word)
F_WORD *allot_word(CELL vocab, CELL name); F_WORD *allot_word(CELL vocab, CELL name);
void primitive_word(void); void primitive_word(void);
@ -13,6 +11,4 @@ INLINE bool word_optimized_p(F_WORD *word)
void primitive_optimized_p(void); void primitive_optimized_p(void);
DEFINE_UNTAG(F_WRAPPER,WRAPPER_TYPE,wrapper)
void primitive_wrapper(void); void primitive_wrapper(void);