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

Sprinkle VM source with assertions, add a missing local root to quotations.c, fix GROWABLE_ARRAY macros for GC safety

db4
Slava Pestov 2009-04-28 00:11:09 -05:00
parent bba3bdd2bd
commit 15ef4f651b
13 changed files with 137 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -13,7 +13,7 @@ CFLAGS = -Wall
FFI_TEST_CFLAGS = -fPIC
ifdef DEBUG
CFLAGS += -g
CFLAGS += -g -DFACTOR_DEBUG
else
CFLAGS += -O3
endif

2
vm/bignumint.h
View File

@ -64,7 +64,7 @@ typedef F_FIXNUM bignum_length_type;
#define BIGNUM_LENGTH(bignum) (untag_fixnum_fast((bignum)->capacity) - 1)
#define BIGNUM_NEGATIVE_P(bignum) (array_nth(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_ZERO_P(bignum) \

25
vm/code_block.c
View File

@ -184,6 +184,13 @@ void update_word_references(F_CODE_BLOCK *compiled)
}
}
INLINE void check_code_address(CELL address)
{
#ifdef FACTOR_DEBUG
assert(address >= code_heap.segment->start && address < code_heap.segment->end);
#endif
}
/* Update references to words. This is done after a new code block
is added to the heap. */
@ -191,6 +198,8 @@ is added to the heap. */
collections */
void mark_code_block(F_CODE_BLOCK *compiled)
{
check_code_address((CELL)compiled);
mark_block(&compiled->block);
copy_handle(&compiled->literals);
@ -287,6 +296,11 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index)
/* Compute an address to store at a relocation */
void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
{
#ifdef FACTOR_DEBUG
type_check(ARRAY_TYPE,compiled->literals);
type_check(BYTE_ARRAY_TYPE,compiled->relocation);
#endif
CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1);
F_ARRAY *literals = untag_object(compiled->literals);
F_FIXNUM absolute_value;
@ -410,6 +424,12 @@ F_CODE_BLOCK *add_code_block(
CELL relocation,
CELL literals)
{
#ifdef FACTOR_DEBUG
type_check(ARRAY_TYPE,literals);
type_check(BYTE_ARRAY_TYPE,relocation);
assert(hi_tag(code) == ARRAY_TYPE);
#endif
CELL code_format = compiled_code_format();
CELL code_length = align8(array_capacity(code) * code_format);
@ -436,6 +456,11 @@ F_CODE_BLOCK *add_code_block(
compiled->literals = literals;
compiled->relocation = relocation;
#ifdef FACTOR_DEBUG
type_check(ARRAY_TYPE,compiled->literals);
type_check(BYTE_ARRAY_TYPE,compiled->relocation);
#endif
/* code */
deposit_integers((CELL)(compiled + 1),code,code_format);

4
vm/code_heap.c
View File

@ -97,7 +97,7 @@ void primitive_modify_code_heap(void)
{
F_ARRAY *compiled_code = untag_array(data);
F_ARRAY *literals = untag_array(array_nth(compiled_code,0));
CELL literals = array_nth(compiled_code,0);
CELL relocation = array_nth(compiled_code,1);
F_ARRAY *labels = untag_array(array_nth(compiled_code,2));
F_ARRAY *code = untag_array(array_nth(compiled_code,3));
@ -110,7 +110,7 @@ void primitive_modify_code_heap(void)
code,
labels,
relocation,
tag_object(literals));
literals);
UNREGISTER_UNTAGGED(word);
UNREGISTER_UNTAGGED(alist);

56
vm/data_gc.c
View File

@ -1,5 +1,16 @@
#include "master.h"
INLINE void check_data_pointer(CELL pointer)
{
#ifdef FACTOR_DEBUG
if(!growing_data_heap)
{
assert(pointer >= data_heap->segment->start
&& pointer < data_heap->segment->end);
}
#endif
}
/* Scan all the objects in the card */
void copy_card(F_CARD *ptr, CELL gen, CELL here)
{
@ -211,6 +222,8 @@ INLINE CELL copy_object_impl(CELL pointer)
/* Follow a chain of forwarding pointers */
CELL resolve_forwarding(CELL untagged, CELL tag)
{
check_data_pointer(untagged);
CELL header = get(untagged);
/* another forwarding pointer */
if(TAG(header) == GC_COLLECTED)
@ -218,6 +231,7 @@ CELL resolve_forwarding(CELL untagged, CELL tag)
/* we've found the destination */
else
{
check_header(header);
CELL pointer = RETAG(untagged,tag);
if(should_copy(untagged))
pointer = RETAG(copy_object_impl(pointer),tag);
@ -231,21 +245,30 @@ pointer address without copying anything; otherwise, install
a new forwarding pointer. */
INLINE CELL copy_object(CELL pointer)
{
check_data_pointer(pointer);
CELL tag = TAG(pointer);
CELL header = get(UNTAG(pointer));
if(TAG(header) == GC_COLLECTED)
return resolve_forwarding(UNTAG(header),tag);
else
{
check_header(header);
return RETAG(copy_object_impl(pointer),tag);
}
}
void copy_handle(CELL *handle)
{
CELL pointer = *handle;
if(!immediate_p(pointer) && should_copy(pointer))
*handle = copy_object(pointer);
if(!immediate_p(pointer))
{
check_data_pointer(pointer);
if(should_copy(pointer))
*handle = copy_object(pointer);
}
}
CELL copy_next_from_nursery(CELL scan)
@ -264,9 +287,12 @@ CELL copy_next_from_nursery(CELL scan)
{
CELL pointer = *obj;
if(!immediate_p(pointer)
&& (pointer >= nursery_start && pointer < nursery_end))
*obj = copy_object(pointer);
if(!immediate_p(pointer))
{
check_data_pointer(pointer);
if(pointer >= nursery_start && pointer < nursery_end)
*obj = copy_object(pointer);
}
}
}
@ -292,10 +318,13 @@ CELL copy_next_from_aging(CELL scan)
{
CELL pointer = *obj;
if(!immediate_p(pointer)
&& !(pointer >= newspace_start && pointer < newspace_end)
&& !(pointer >= tenured_start && pointer < tenured_end))
*obj = copy_object(pointer);
if(!immediate_p(pointer))
{
check_data_pointer(pointer);
if(!(pointer >= newspace_start && pointer < newspace_end)
&& !(pointer >= tenured_start && pointer < tenured_end))
*obj = copy_object(pointer);
}
}
}
@ -318,8 +347,12 @@ CELL copy_next_from_tenured(CELL scan)
{
CELL pointer = *obj;
if(!immediate_p(pointer) && !(pointer >= newspace_start && pointer < newspace_end))
*obj = copy_object(pointer);
if(!immediate_p(pointer))
{
check_data_pointer(pointer);
if(!(pointer >= newspace_start && pointer < newspace_end))
*obj = copy_object(pointer);
}
}
}
@ -474,6 +507,7 @@ void garbage_collection(CELL gen,
copy_roots();
/* collect objects referenced from older generations */
copy_cards();
/* do some tracing */
copy_reachable_objects(scan,&newspace->here);

2
vm/data_gc.h
View File

@ -93,7 +93,7 @@ INLINE void *allot_object(CELL type, CELL a)
#ifdef GC_DEBUG
if(!gc_off)
{
if(gc_count++ % 1000 == 0)
if(gc_count++ % 100 == 0)
gc();
}

3
vm/factor.c
View File

@ -118,7 +118,10 @@ void init_factor(F_PARAMETERS *p)
init_stacks(p->ds_size,p->rs_size);
load_image(p);
init_c_io();
#ifndef FACTOR_DEBUG
init_signals();
#endif
if(p->console)
open_console();

6
vm/master.h
View File

@ -2,7 +2,11 @@
#define __FACTOR_MASTER_H__
#ifndef WINCE
#include <errno.h>
#include <errno.h>
#endif
#ifdef FACTOR_DEBUG
#include <assert.h>
#endif
#include <fcntl.h>

3
vm/profiler.c
View File

@ -48,7 +48,8 @@ void update_word_xt(F_WORD *word)
word->xt = (XT)(word->code + 1);
}
void set_profiling(bool profiling)
/* Allocates memory */
static void set_profiling(bool profiling)
{
if(profiling == profiling_p)
return;

15
vm/quotations.c
View File

@ -204,6 +204,8 @@ void jit_compile(CELL quot, bool relocate)
for(i = 0; i < length; i++)
{
CELL obj = array_nth(untag_object(array),i);
REGISTER_ROOT(obj);
F_WORD *word;
F_WRAPPER *wrapper;
@ -325,6 +327,8 @@ void jit_compile(CELL quot, bool relocate)
EMIT(userenv[JIT_PUSH_IMMEDIATE])
break;
}
UNREGISTER_ROOT(obj);
}
if(!tail_call)
@ -339,6 +343,10 @@ void jit_compile(CELL quot, bool relocate)
GROWABLE_BYTE_ARRAY_TRIM(relocation);
GROWABLE_ARRAY_TRIM(code);
GROWABLE_ARRAY_DONE(literals);
GROWABLE_BYTE_ARRAY_DONE(relocation);
GROWABLE_ARRAY_DONE(code);
F_CODE_BLOCK *compiled = add_code_block(
QUOTATION_TYPE,
untag_object(code),
@ -351,10 +359,6 @@ void jit_compile(CELL quot, bool relocate)
if(relocate)
relocate_code_block(compiled);
GROWABLE_ARRAY_DONE(literals);
GROWABLE_BYTE_ARRAY_DONE(relocation);
GROWABLE_ARRAY_DONE(code);
UNREGISTER_ROOT(array);
UNREGISTER_ROOT(quot);
}
@ -536,10 +540,13 @@ void compile_all_words(void)
{
F_WORD *word = untag_word(array_nth(untag_array(words),i));
REGISTER_UNTAGGED(word);
if(word->optimizedp == F)
jit_compile_word(word,word->def,false);
UNREGISTER_UNTAGGED(word);
update_word_xt(word);
}
UNREGISTER_ROOT(words);

8
vm/run.h
View File

@ -129,8 +129,16 @@ INLINE CELL tag_header(CELL cell)
return cell << TAG_BITS;
}
INLINE void check_header(CELL cell)
{
#ifdef FACTOR_DEBUG
assert(TAG(cell) == FIXNUM_TYPE && untag_fixnum_fast(cell) < TYPE_COUNT);
#endif
}
INLINE CELL untag_header(CELL cell)
{
check_header(cell);
return cell >> TAG_BITS;
}

2
vm/types.c
View File

@ -224,7 +224,7 @@ void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts)
UNREGISTER_UNTAGGED(elts);
write_barrier((CELL)array->array);
write_barrier(array->array);
memcpy((void *)AREF(underlying,array->count),
(void *)AREF(elts,0),

47
vm/types.h
View File

@ -40,25 +40,37 @@ INLINE CELL tag_boolean(CELL untagged)
DEFINE_UNTAG(F_ARRAY,ARRAY_TYPE,array)
INLINE CELL array_capacity(F_ARRAY* array)
{
#ifdef FACTOR_DEBUG
CELL header = untag_header(array->header);
assert(header == ARRAY_TYPE || header == BIGNUM_TYPE || header == BYTE_ARRAY_TYPE);
#endif
return array->capacity >> TAG_BITS;
}
#define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS)
#define UNAREF(array,ptr) (((CELL)(ptr)-(CELL)(array)-sizeof(F_ARRAY)) / CELLS)
INLINE CELL array_nth(F_ARRAY *array, CELL slot)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
assert(untag_header(array->header) == ARRAY_TYPE);
#endif
return get(AREF(array,slot));
}
INLINE void set_array_nth(F_ARRAY *array, CELL slot, CELL value)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
assert(untag_header(array->header) == ARRAY_TYPE);
#endif
put(AREF(array,slot),value);
write_barrier((CELL)array);
}
INLINE CELL array_capacity(F_ARRAY* array)
{
return array->capacity >> TAG_BITS;
}
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
@ -164,11 +176,12 @@ typedef struct {
CELL array;
} F_GROWABLE_ARRAY;
/* Allocates memory */
INLINE F_GROWABLE_ARRAY make_growable_array(void)
{
F_GROWABLE_ARRAY result;
result.count = 0;
result.array = tag_object(allot_array(ARRAY_TYPE,10000,F));
result.array = tag_object(allot_array(ARRAY_TYPE,100,F));
return result;
}
@ -185,14 +198,16 @@ void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts);
#define GROWABLE_ARRAY_APPEND(result,elts) \
growable_array_append(&result##_g,elts)
INLINE CELL growable_array_trim(F_GROWABLE_ARRAY *array)
INLINE void growable_array_trim(F_GROWABLE_ARRAY *array)
{
return tag_object(reallot_array(untag_object(array->array),array->count));
array->array = tag_object(reallot_array(untag_object(array->array),array->count));
}
#define GROWABLE_ARRAY_TRIM(result) CELL result = growable_array_trim(&result##_g)
#define GROWABLE_ARRAY_TRIM(result) growable_array_trim(&result##_g)
#define GROWABLE_ARRAY_DONE(result) UNREGISTER_ROOT(result##_g.array)
#define GROWABLE_ARRAY_DONE(result) \
UNREGISTER_ROOT(result##_g.array); \
CELL result = result##_g.array;
/* Macros to simulate a byte vector in C */
typedef struct {
@ -204,7 +219,7 @@ INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void)
{
F_GROWABLE_BYTE_ARRAY result;
result.count = 0;
result.array = tag_object(allot_byte_array(10000));
result.array = tag_object(allot_byte_array(100));
return result;
}
@ -217,11 +232,13 @@ void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL
#define GROWABLE_BYTE_ARRAY_APPEND(result,elts,len) \
growable_byte_array_append(&result##_g,elts,len)
INLINE CELL growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array)
INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array)
{
return tag_object(reallot_byte_array(untag_object(byte_array->array),byte_array->count));
byte_array->array = tag_object(reallot_byte_array(untag_object(byte_array->array),byte_array->count));
}
#define GROWABLE_BYTE_ARRAY_TRIM(result) CELL result = growable_byte_array_trim(&result##_g)
#define GROWABLE_BYTE_ARRAY_TRIM(result) growable_byte_array_trim(&result##_g)
#define GROWABLE_BYTE_ARRAY_DONE(result) UNREGISTER_ROOT(result##_g.array);
#define GROWABLE_BYTE_ARRAY_DONE(result) \
UNREGISTER_ROOT(result##_g.array); \
CELL result = result##_g.array;