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);
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) \
((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_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
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) \
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_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)
{
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)
{
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)
{
F_BYTE_ARRAY *array = untag_byte_array(dpop());
F_BYTE_ARRAY *array = untag_check<F_BYTE_ARRAY>(dpop());
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)

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);
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)
{
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);
}
@ -80,16 +80,16 @@ void primitive_callstack(void)
F_CALLSTACK *callstack = allot_callstack(size);
memcpy(FIRST_STACK_FRAME(callstack),top,size);
dpush(tag_object(callstack));
dpush(tag<F_CALLSTACK>(callstack));
}
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,
FIRST_STACK_FRAME(stack),
untag_fixnum_fast(stack->length),
untag_fixnum(stack->length),
memcpy);
/* We cannot return here ... */
@ -114,7 +114,7 @@ CELL frame_executing(F_STACK_FRAME *frame)
return F;
else
{
F_ARRAY *array = untag_array_fast(compiled->literals);
F_ARRAY *array = untag<F_ARRAY>(compiled->literals);
return array_nth(array,0);
}
}
@ -174,13 +174,13 @@ void primitive_callstack_to_array(void)
frame_index = 0;
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 *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;
@ -195,7 +195,7 @@ Used by the single stepper. */
void primitive_innermost_stack_frame_quot(void)
{
F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop()));
untag_check<F_CALLSTACK>(dpop()));
type_check(QUOTATION_TYPE,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)
{
F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop()));
untag_check<F_CALLSTACK>(dpop()));
type_check(QUOTATION_TYPE,frame_executing(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;
}
DEFINE_UNTAG(F_CALLSTACK,CALLSTACK_TYPE,callstack)
#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
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)
{
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;
@ -114,7 +114,7 @@ void update_literal_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compile
if(REL_TYPE(rel) == RT_IMMEDIATE)
{
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);
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)
{
F_QUOTATION *quot = untag_quotation_fast(obj);
F_QUOTATION *quot = untag<F_QUOTATION>(obj);
return (CELL)quot->xt;
}
else
{
F_WORD *word = untag_word_fast(obj);
F_WORD *word = untag<F_WORD>(obj);
return (CELL)word->xt;
}
}
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;
if(quot == F || max_pic_size == 0)
return (CELL)word->xt;
else
{
F_QUOTATION *untagged = untag_quotation_fast(quot);
F_QUOTATION *untagged = untag<F_QUOTATION>(quot);
if(untagged->compiledp == F)
return (CELL)word->xt;
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)
{
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 xt;
@ -313,7 +313,7 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index)
CELL symbol = array_nth(literals,index);
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)
return (void *)undefined_symbol;
@ -329,7 +329,7 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index)
else if(type_of(symbol) == ARRAY_TYPE)
{
CELL i;
F_ARRAY *names = untag_array_fast(symbol);
F_ARRAY *names = untag<F_ARRAY>(symbol);
for(i = 0; i < array_capacity(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
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;
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)
{
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);
if(word->profiling)
word->profiling = forward_xt(word->profiling);
}
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_quotation_fast(obj);
break;
case QUOTATION_TYPE:
F_QUOTATION *quot = untag<F_QUOTATION>(obj);
if(quot->compiledp != F)
quot->code = forward_xt(quot->code);
}
else if(type_of(obj) == CALLSTACK_TYPE)
{
F_CALLSTACK *stack = untag_callstack_fast(obj);
break;
case CALLSTACK_TYPE:
F_CALLSTACK *stack = untag<F_CALLSTACK>(obj);
iterate_callstack_object(stack,forward_frame_xt);
break;
default:
break;
}
}
@ -175,7 +180,7 @@ void fixup_object_xts(void)
update_word_xt(obj);
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)
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 = gc_locals_region->start - CELLS;
extra_roots_region = alloc_segment(getpagesize());
extra_roots = extra_roots_region->start - CELLS;
gc_bignums_region = alloc_segment(getpagesize());
gc_bignums = gc_bignums_region->start - CELLS;
secure_gc = secure_gc_;
@ -224,8 +224,8 @@ CELL unaligned_object_size(CELL pointer)
case STRING_TYPE:
return string_size(string_capacity((F_STRING*)pointer));
case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer);
layout = untag_tuple_layout(tuple->layout);
tuple = untag<F_TUPLE>(pointer);
layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
return tuple_size(layout);
case QUOTATION_TYPE:
return sizeof(F_QUOTATION);
@ -241,7 +241,7 @@ CELL unaligned_object_size(CELL pointer)
return sizeof(F_WRAPPER);
case CALLSTACK_TYPE:
return callstack_size(
untag_fixnum_fast(((F_CALLSTACK *)pointer)->length));
untag_fixnum(((F_CALLSTACK *)pointer)->length));
default:
critical_error("Invalid header",pointer);
return -1; /* can't happen */
@ -284,8 +284,8 @@ CELL binary_payload_start(CELL pointer)
case ARRAY_TYPE:
return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer));
case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer);
layout = untag_tuple_layout(tuple->layout);
tuple = untag<F_TUPLE>(pointer);
layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
return tuple_size(layout);
case WRAPPER_TYPE:
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)
{
print_chars(untag_string(word->vocabulary));
print_chars(untag<F_STRING>(word->vocabulary));
print_string(":");
}
if(type_of(word->name) == STRING_TYPE)
print_chars(untag_string(word->name));
print_chars(untag<F_STRING>(word->name));
else
{
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)
{
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);
print_string(" ");
@ -102,31 +102,31 @@ void print_nested_obj(CELL obj, F_FIXNUM nesting)
switch(type_of(obj))
{
case FIXNUM_TYPE:
print_fixnum(untag_fixnum_fast(obj));
print_fixnum(untag_fixnum(obj));
break;
case WORD_TYPE:
print_word(untag_word(obj),nesting - 1);
print_word(untag<F_WORD>(obj),nesting - 1);
break;
case STRING_TYPE:
print_factor_string(untag_string(obj));
print_factor_string(untag<F_STRING>(obj));
break;
case F_TYPE:
print_string("f");
break;
case TUPLE_TYPE:
print_string("T{");
print_tuple(untag_tuple_fast(obj),nesting - 1);
print_tuple(untag<F_TUPLE>(obj),nesting - 1);
print_string(" }");
break;
case ARRAY_TYPE:
print_string("{");
print_array(untag_array_fast(obj),nesting - 1);
print_array(untag<F_ARRAY>(obj),nesting - 1);
print_string(" }");
break;
case QUOTATION_TYPE:
print_string("[");
quot = untag_quotation_fast(obj);
print_array(untag_array_fast(quot->array),nesting - 1);
quot = untag<F_QUOTATION>(obj);
print_array(untag<F_ARRAY>(quot->array),nesting - 1);
print_string(" ]");
break;
default:

26
vm/dispatch.cpp
View File

@ -5,11 +5,11 @@ CELL megamorphic_cache_misses;
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;
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)
return array_nth(pair,1);
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)
{
F_ARRAY *buckets = untag_array_fast(table);
F_ARRAY *buckets = untag<F_ARRAY>(table);
CELL bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
if(type_of(bucket) == WORD_TYPE || bucket == F)
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)
{
F_TUPLE *tuple = untag_tuple_fast(object);
F_TUPLE_LAYOUT *layout = untag_tuple_layout(tuple->layout);
F_TUPLE *tuple = untag<F_TUPLE>(object);
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;
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)
{
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);
if(result != F)
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)
{
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;
#ifdef FACTOR_DEBUG
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)
{
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)
return method;
else
@ -109,7 +109,7 @@ static CELL lookup_hairy_method(CELL object, CELL methods)
CELL lookup_method(CELL object, CELL methods)
{
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
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)
{
F_ARRAY *array = untag_array_fast(cache);
F_ARRAY *array = untag<F_ARRAY>(cache);
CELL hashcode = method_cache_hashcode(klass,array);
set_array_nth(array,hashcode,klass);
set_array_nth(array,hashcode + 1,method);
@ -148,7 +148,7 @@ void primitive_mega_cache_miss(void)
megamorphic_cache_misses++;
CELL cache = dpop();
F_FIXNUM index = untag_fixnum_fast(dpop());
F_FIXNUM index = untag_fixnum(dpop());
CELL methods = dpop();
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 */
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
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))
critical_error("allot_object() missed GC check",0);
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
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);
}
#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);
/* 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))
{
case FIXNUM_TYPE:
type = untag_fixnum_fast(klass);
type = untag_fixnum(klass);
if(type >= HEADER_TYPE)
seen_hi_tag = true;
break;
@ -86,7 +86,7 @@ struct inline_cache_jit : public jit {
void inline_cache_jit::emit_check(CELL klass)
{
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];
else
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 */
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)
{
return array_capacity(untag_array(cache_entries)) / 2;
return array_capacity(untag_check<F_ARRAY>(cache_entries)) / 2;
}
/* Allocates memory */
@ -196,7 +196,7 @@ XT inline_cache_miss(CELL return_address)
deallocate_inline_cache(return_address);
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_WORD> generic_word(dpop());
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)
{
dpush(tag_object(allot_string(0,0)));
dpush(tag<F_STRING>(allot_string(0,0)));
return;
}
@ -135,7 +135,7 @@ void primitive_fputc(void)
void primitive_fwrite(void)
{
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);
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_ARRAY *quadruple = untag_array_fast(code_template);
F_ARRAY *quadruple = untag<F_ARRAY>(code_template);
CELL rel_class = array_nth(quadruple,1);
CELL rel_type = array_nth(quadruple,2);
CELL offset = array_nth(quadruple,3);
@ -35,9 +35,9 @@ F_REL jit::rel_to_emit(CELL code_template, bool *rel_p)
else
{
*rel_p = true;
return (untag_fixnum_fast(rel_type) << 28)
| (untag_fixnum_fast(rel_class) << 24)
| ((code.count + untag_fixnum_fast(offset)));
return (untag_fixnum(rel_type) << 28)
| (untag_fixnum(rel_class) << 24)
| ((code.count + untag_fixnum(offset)));
}
}

5
vm/jit.hpp
View File

@ -29,8 +29,9 @@ struct jit {
emit_with(userenv[JIT_WORD_CALL],word);
}
void emit_subprimitive(CELL word) {
gc_root<F_ARRAY> code_template(untagged<F_WORD>(word)->subprimitive);
void emit_subprimitive(CELL word_) {
gc_root<F_WORD> word(word_);
gc_root<F_ARRAY> code_template(word->subprimitive);
if(array_nth(code_template.untagged(),1) != F) literal(T);
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);
}
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;
}
@ -80,8 +83,10 @@ INLINE CELL tag_fixnum(F_FIXNUM untagged)
typedef void *XT;
#define NO_TYPE_CHECK static const CELL type_number = TYPE_COUNT
struct F_OBJECT {
static const CELL type_number = TYPE_COUNT;
NO_TYPE_CHECK;
CELL header;
};
@ -96,6 +101,7 @@ struct F_ARRAY : public F_OBJECT {
/* These are really just arrays, but certain elements have special
significance */
struct F_TUPLE_LAYOUT : public F_ARRAY {
NO_TYPE_CHECK;
/* tagged */
CELL klass;
/* tagged fixnum */

108
vm/math.cpp
View File

@ -10,9 +10,9 @@ F_FIXNUM to_fixnum(CELL tagged)
switch(TAG(tagged))
{
case FIXNUM_TYPE:
return untag_fixnum_fast(tagged);
return untag_fixnum(tagged);
case BIGNUM_TYPE:
return bignum_to_fixnum(untag_bignum_fast(tagged));
return bignum_to_fixnum(untag<F_BIGNUM>(tagged));
default:
type_error(FIXNUM_TYPE,tagged);
return -1; /* can't happen */
@ -26,7 +26,7 @@ CELL to_cell(CELL tagged)
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)
@ -38,14 +38,14 @@ void primitive_float_to_fixnum(void)
overflow, they call these functions. */
F_FASTCALL void overflow_fixnum_add(F_FIXNUM x, F_FIXNUM y)
{
drepl(tag_bignum(fixnum_to_bignum(
untag_fixnum_fast(x) + untag_fixnum_fast(y))));
drepl(tag<F_BIGNUM>(fixnum_to_bignum(
untag_fixnum(x) + untag_fixnum(y))));
}
F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y)
{
drepl(tag_bignum(fixnum_to_bignum(
untag_fixnum_fast(x) - untag_fixnum_fast(y))));
drepl(tag<F_BIGNUM>(fixnum_to_bignum(
untag_fixnum(x) - untag_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);
F_BIGNUM *by = fixnum_to_bignum(y);
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
by -1. */
void primitive_fixnum_divint(void)
{
F_FIXNUM y = untag_fixnum_fast(dpop()); \
F_FIXNUM x = untag_fixnum_fast(dpeek());
F_FIXNUM y = untag_fixnum(dpop()); \
F_FIXNUM x = untag_fixnum(dpeek());
F_FIXNUM result = x / y;
if(result == -FIXNUM_MIN)
drepl(allot_integer(-FIXNUM_MIN));
@ -81,7 +81,7 @@ void primitive_fixnum_divmod(void)
}
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);
}
}
@ -96,8 +96,8 @@ void primitive_fixnum_divmod(void)
void primitive_fixnum_shift(void)
{
F_FIXNUM y = untag_fixnum_fast(dpop()); \
F_FIXNUM x = untag_fixnum_fast(dpeek());
F_FIXNUM y = untag_fixnum(dpop()); \
F_FIXNUM x = untag_fixnum(dpeek());
if(x == 0)
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)));
}
/* Bignums */
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)
{
drepl(tag_bignum(float_to_bignum(dpeek())));
drepl(tag<F_BIGNUM>(float_to_bignum(dpeek())));
}
#define POP_BIGNUMS(x,y) \
F_BIGNUM * y = untag_bignum_fast(dpop()); \
F_BIGNUM * x = untag_bignum_fast(dpop());
F_BIGNUM * y = untag<F_BIGNUM>(dpop()); \
F_BIGNUM * x = untag<F_BIGNUM>(dpop());
void primitive_bignum_eq(void)
{
@ -145,25 +145,25 @@ void primitive_bignum_eq(void)
void primitive_bignum_add(void)
{
POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_add(x,y)));
dpush(tag<F_BIGNUM>(bignum_add(x,y)));
}
void primitive_bignum_subtract(void)
{
POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_subtract(x,y)));
dpush(tag<F_BIGNUM>(bignum_subtract(x,y)));
}
void primitive_bignum_multiply(void)
{
POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_multiply(x,y)));
dpush(tag<F_BIGNUM>(bignum_multiply(x,y)));
}
void primitive_bignum_divint(void)
{
POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_quotient(x,y)));
dpush(tag<F_BIGNUM>(bignum_quotient(x,y)));
}
void primitive_bignum_divmod(void)
@ -171,39 +171,39 @@ void primitive_bignum_divmod(void)
F_BIGNUM *q, *r;
POP_BIGNUMS(x,y);
bignum_divide(x,y,&q,&r);
dpush(tag_bignum(q));
dpush(tag_bignum(r));
dpush(tag<F_BIGNUM>(q));
dpush(tag<F_BIGNUM>(r));
}
void primitive_bignum_mod(void)
{
POP_BIGNUMS(x,y);
dpush(tag_bignum(bignum_remainder(x,y)));
dpush(tag<F_BIGNUM>(bignum_remainder(x,y)));
}
void primitive_bignum_and(void)
{
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)
{
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)
{
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)
{
F_FIXNUM y = untag_fixnum_fast(dpop());
F_BIGNUM* x = untag_bignum_fast(dpop());
dpush(tag_bignum(bignum_arithmetic_shift(x,y)));
F_FIXNUM y = untag_fixnum(dpop());
F_BIGNUM* x = untag<F_BIGNUM>(dpop());
dpush(tag<F_BIGNUM>(bignum_arithmetic_shift(x,y)));
}
void primitive_bignum_less(void)
@ -232,19 +232,19 @@ void primitive_bignum_greatereq(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)
{
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));
}
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)
@ -255,9 +255,9 @@ unsigned int bignum_producer(unsigned int digit)
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);
drepl(tag_bignum(bignum));
drepl(tag<F_BIGNUM>(bignum));
}
void box_signed_1(s8 n)
@ -303,7 +303,7 @@ void box_unsigned_cell(CELL cell)
void box_signed_8(s64 n)
{
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
dpush(tag_fixnum(n));
}
@ -313,9 +313,9 @@ s64 to_signed_8(CELL obj)
switch(type_of(obj))
{
case FIXNUM_TYPE:
return untag_fixnum_fast(obj);
return untag_fixnum(obj);
case BIGNUM_TYPE:
return bignum_to_long_long(untag_bignum_fast(obj));
return bignum_to_long_long(untag<F_BIGNUM>(obj));
default:
type_error(BIGNUM_TYPE,obj);
return -1;
@ -325,7 +325,7 @@ s64 to_signed_8(CELL obj)
void box_unsigned_8(u64 n)
{
if(n > FIXNUM_MAX)
dpush(tag_bignum(ulong_long_to_bignum(n)));
dpush(tag<F_BIGNUM>(ulong_long_to_bignum(n)));
else
dpush(tag_fixnum(n));
}
@ -335,9 +335,9 @@ u64 to_unsigned_8(CELL obj)
switch(type_of(obj))
{
case FIXNUM_TYPE:
return untag_fixnum_fast(obj);
return untag_fixnum(obj);
case BIGNUM_TYPE:
return bignum_to_ulong_long(untag_bignum_fast(obj));
return bignum_to_ulong_long(untag<F_BIGNUM>(obj));
default:
type_error(BIGNUM_TYPE,obj);
return -1;
@ -350,7 +350,7 @@ CELL unbox_array_size(void)
{
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)
{
dpop();
@ -360,9 +360,9 @@ CELL unbox_array_size(void)
}
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 * n = untag_bignum_fast(dpeek());
F_BIGNUM * n = untag<F_BIGNUM>(dpeek());
if(bignum_compare(n,zero) != 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)
{
F_BYTE_ARRAY *bytes = untag_byte_array(dpeek());
F_BYTE_ARRAY *bytes = untag_check<F_BYTE_ARRAY>(dpeek());
CELL capacity = array_capacity(bytes);
char *c_str = (char *)(bytes + 1);
@ -405,13 +405,13 @@ void primitive_str_to_float(void)
void primitive_float_to_str(void)
{
F_BYTE_ARRAY *array = allot_byte_array(33);
snprintf((char *)(array + 1),32,"%.16g",untag_float(dpop()));
dpush(tag_object(array));
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
dpush(tag<F_BYTE_ARRAY>(array));
}
#define POP_FLOATS(x,y) \
double y = untag_float_fast(dpop()); \
double x = untag_float_fast(dpop());
double y = untag_float(dpop()); \
double x = untag_float(dpop());
void primitive_float_eq(void)
{
@ -475,7 +475,7 @@ void primitive_float_greatereq(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)
@ -485,7 +485,7 @@ void primitive_bits_float(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)
@ -495,12 +495,12 @@ void primitive_bits_double(void)
float to_float(CELL value)
{
return untag_float(value);
return untag_float_check(value);
}
double to_double(CELL value)
{
return untag_float(value);
return untag_float_check(value);
}
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_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_float_to_bignum(void);
void primitive_bignum_eq(void);
@ -53,7 +46,7 @@ void primitive_byte_array_to_bignum(void);
INLINE CELL allot_integer(F_FIXNUM x)
{
if(x < FIXNUM_MIN || x > FIXNUM_MAX)
return tag_bignum(fixnum_to_bignum(x));
return tag<F_BIGNUM>(fixnum_to_bignum(x));
else
return tag_fixnum(x);
}
@ -61,7 +54,7 @@ INLINE CELL allot_integer(F_FIXNUM x)
INLINE CELL allot_cell(CELL x)
{
if(x > (CELL)FIXNUM_MAX)
return tag_bignum(cell_to_bignum(x));
return tag<F_BIGNUM>(cell_to_bignum(x));
else
return tag_fixnum(x);
}
@ -83,15 +76,14 @@ DLLEXPORT u64 to_unsigned_8(CELL obj);
CELL unbox_array_size(void);
INLINE double untag_float_fast(CELL tagged)
{
return ((F_FLOAT *)UNTAG(tagged))->n;
}
INLINE double untag_float(CELL tagged)
{
type_check(FLOAT_TYPE,tagged);
return untag_float_fast(tagged);
return untag<F_FLOAT>(tagged)->n;
}
INLINE double untag_float_check(CELL tagged)
{
return untag_check<F_FLOAT>(tagged)->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)
{
return (F_FIXNUM)untag_float_fast(tagged);
return (F_FIXNUM)untag_float(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)
{
return (double)untag_fixnum_fast(tagged);
return (double)untag_fixnum(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);

2
vm/os-unix.cpp
View File

@ -55,7 +55,7 @@ void ffi_dlclose(F_DLL *dll)
void primitive_existsp(void)
{
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);
}

8
vm/quotations.cpp
View File

@ -88,7 +88,7 @@ bool quotation_jit::stack_frame_p()
CELL obj = array_nth(array.untagged(),i);
if(type_of(obj) == WORD_TYPE)
{
if(untagged<F_WORD>(obj)->subprimitive == F)
if(untag<F_WORD>(obj)->subprimitive == F)
return true;
}
else if(type_of(obj) == QUOTATION_TYPE)
@ -221,7 +221,7 @@ void quotation_jit::iterate_quotation()
{
emit_mega_cache_lookup(
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));
i += 3;
tail_call = true;
@ -290,12 +290,12 @@ void primitive_array_to_quotation(void)
quot->compiledp = F;
quot->cached_effect = F;
quot->cache_counter = F;
drepl(tag_quotation(quot));
drepl(tag<F_QUOTATION>(quot));
}
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));
}

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 {
gc_root<F_ARRAY> array;
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);
memcpy(a + 1,(void*)bottom,depth);
dpush(tag_array(a));
dpush(tag<F_ARRAY>(a));
return true;
}
}
@ -153,12 +153,12 @@ CELL array_to_stack(F_ARRAY *array, CELL bottom)
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)
{
rs = array_to_stack(untag_array(dpop()),rs_bot);
rs = array_to_stack(untag_check<F_ARRAY>(dpop()),rs_bot);
}
/* Used to implement call( */
@ -167,7 +167,7 @@ void primitive_check_datastack(void)
F_FIXNUM out = to_fixnum(dpop());
F_FIXNUM in = to_fixnum(dpop());
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 depth = (ds - ds_bot + CELLS) / CELLS;
if(depth - height != length)
@ -189,13 +189,13 @@ void primitive_check_datastack(void)
void primitive_getenv(void)
{
F_FIXNUM e = untag_fixnum_fast(dpeek());
F_FIXNUM e = untag_fixnum(dpeek());
drepl(userenv[e]);
}
void primitive_setenv(void)
{
F_FIXNUM e = untag_fixnum_fast(dpop());
F_FIXNUM e = untag_fixnum(dpop());
CELL value = dpop();
userenv[e] = value;
}
@ -217,7 +217,7 @@ void primitive_sleep(void)
void primitive_set_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
F_FIXNUM slot = untag_fixnum(dpop());
CELL obj = dpop();
CELL value = dpop();
set_slot(obj,slot,value);
@ -225,7 +225,7 @@ void primitive_set_slot(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);
ds -= 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)
{
#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
}
@ -159,14 +159,6 @@ INLINE CELL hi_tag(CELL 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)
{
CELL tag = TAG(tagged);

42
vm/strings.cpp
View File

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

4
vm/strings.hpp
View File

@ -1,6 +1,6 @@
INLINE CELL string_capacity(F_STRING *str)
{
return untag_fixnum_fast(str->length);
return untag_fixnum(str->length);
}
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 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(CELL capacity, CELL fill);
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();
}
template <typename T> T *untagged(CELL value)
template <typename T> T *untag(CELL value)
{
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--)
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 */
@ -25,7 +25,7 @@ void primitive_tuple_boa(void)
{
gc_root<F_TUPLE_LAYOUT> layout(dpop());
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);
ds -= size;
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)
{
CELL size = untag_fixnum_fast(layout->size);
CELL size = untag_fixnum(layout->size);
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)
{
return get(AREF(tuple,slot));

8
vm/words.cpp
View File

@ -32,13 +32,13 @@ void primitive_word(void)
{
CELL vocab = dpop();
CELL name = dpop();
dpush(tag_object(allot_word(vocab,name)));
dpush(tag<F_WORD>(allot_word(vocab,name)));
}
/* word-xt ( word -- start end ) */
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);
dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK)));
dpush(allot_cell((CELL)code + code->block.size));
@ -65,12 +65,12 @@ void update_word_xt(CELL word_)
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)
{
F_WRAPPER *wrapper = allot<F_WRAPPER>(sizeof(F_WRAPPER));
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);
void primitive_word(void);
@ -13,6 +11,4 @@ INLINE bool word_optimized_p(F_WORD *word)
void primitive_optimized_p(void);
DEFINE_UNTAG(F_WRAPPER,WRAPPER_TYPE,wrapper)
void primitive_wrapper(void);