Enforce that all structures have types derived from 'structure'.
Take advantage of this invariant to simplify struct type checks elsewhere. Group (meta)structure definition with basic types.
This commit is contained in:
parent
b993d6617f
commit
960d7917c9
4
Makefile
4
Makefile
|
|
@ -6,7 +6,7 @@ RM := rm -f
|
|||
|
||||
CPPFLAGS := -I.
|
||||
CFLAGS := -std=c99 -Wall
|
||||
LDFLAGS := -lrt -lm
|
||||
LDFLAGS := -lrt -lm -g
|
||||
|
||||
CFLAGS += $(shell echo $(MODS:%=-DHAVE_MOD_%) | tr 'a-z' 'A-Z')
|
||||
|
||||
|
|
@ -20,7 +20,7 @@ ifeq ($(DEBUG),yes)
|
|||
PROFILE := no
|
||||
dummy := $(shell $(RM) rosella $(OBJS) $(GCDA) $(GCNO))
|
||||
else
|
||||
CFLAGS += -march=native -O2 -fomit-frame-pointer -mssse3 -mfpmath=sse
|
||||
CFLAGS += -g -march=native -O2 -fomit-frame-pointer -mssse3 -mfpmath=sse
|
||||
CFLAGS += -DNDEBUG
|
||||
endif
|
||||
|
||||
|
|
|
|||
68
builtin.c
68
builtin.c
|
|
@ -9,7 +9,6 @@
|
|||
#include "interp.h"
|
||||
|
||||
static gc_root_t builtin_list;
|
||||
static gc_root_t structure_type_root;
|
||||
static gc_root_t template_type_root;
|
||||
static gc_root_t lambda_type_root;
|
||||
|
||||
|
|
@ -22,7 +21,6 @@ static void bi_string_to_number(interp_state_t *state);
|
|||
void builtin_init(void)
|
||||
{
|
||||
register_gc_root(&builtin_list, NIL);
|
||||
register_gc_root(&structure_type_root, UNDEFINED);
|
||||
register_gc_root(&template_type_root, UNDEFINED);
|
||||
register_gc_root(&lambda_type_root, UNDEFINED);
|
||||
|
||||
|
|
@ -70,11 +68,6 @@ value_t lookup_builtin(const char *name)
|
|||
return FALSE_VALUE;
|
||||
}
|
||||
|
||||
value_t get_structure_type(void)
|
||||
{
|
||||
return structure_type_root.value;
|
||||
}
|
||||
|
||||
value_t get_template_type(void)
|
||||
{
|
||||
return template_type_root.value;
|
||||
|
|
@ -89,27 +82,14 @@ value_t get_lambda_type(void)
|
|||
|
||||
static void register_structure(void)
|
||||
{
|
||||
/* Structure: Instances of this structure describe structures. */
|
||||
/* It is both a structure and a structure description, and thus an instance of itself. */
|
||||
structure_type_root.value = make_struct(UNDEFINED, STRUCTURE_SLOTS);
|
||||
_get_struct(structure_type_root.value)->type = structure_type_root.value;
|
||||
|
||||
/* Slot 1: List of superclasses, most to least specific */
|
||||
_get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL;
|
||||
/* Slot 2: Total number of slots (excl. type) */
|
||||
_get_struct(structure_type_root.value)->slots[SS(NSLOTS)] = fixnum_value(STRUCTURE_SLOTS);
|
||||
/* Slot 3: Callable object used as proxy when structure is APPLY'd. */
|
||||
/* Can be LAMBDA, callable structure instance, builtin, or FALSE_VALUE. */
|
||||
_get_struct(structure_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE;
|
||||
|
||||
register_builtin(BI_STRUCTURE, structure_type_root.value);
|
||||
register_builtin(BI_STRUCTURE, get_structure_type());
|
||||
}
|
||||
|
||||
static void register_template(void)
|
||||
{
|
||||
/* Template: Instances of this structure describe what a LAMBDA
|
||||
* will look like when instanciated with the 'lambda' bytecode. */
|
||||
template_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS);
|
||||
template_type_root.value = make_struct(get_structure_type());
|
||||
|
||||
/* Slot 1: List of superclasses, most to least specific */
|
||||
_get_struct(template_type_root.value)->slots[SS(SUPERS)] = NIL;
|
||||
|
|
@ -124,7 +104,7 @@ static void register_template(void)
|
|||
static void register_lambda(void)
|
||||
{
|
||||
/* Lambda: Instances of this structure are fundamental callable objects. */
|
||||
lambda_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS);
|
||||
lambda_type_root.value = make_struct(get_structure_type());
|
||||
|
||||
/* Slot 1: List of superclasses, most to least specific */
|
||||
_get_struct(lambda_type_root.value)->slots[SS(SUPERS)] = NIL;
|
||||
|
|
@ -138,48 +118,6 @@ static void register_lambda(void)
|
|||
|
||||
#undef SS
|
||||
|
||||
typedef struct seen_struct_type
|
||||
{
|
||||
value_t struct_type;
|
||||
struct seen_struct_type *prev;
|
||||
} seen_struct_type_t;
|
||||
|
||||
static bool _struct_is_a(value_t value, value_t type, seen_struct_type_t *seen)
|
||||
{
|
||||
seen_struct_type_t new_seen;
|
||||
|
||||
/* The trivial cases: non-struct and exact match */
|
||||
if (!is_struct(value)) return false;
|
||||
if (_get_struct(value)->type == type) return true;
|
||||
|
||||
/* Detect cycles */
|
||||
for (seen_struct_type_t *s = seen; s; s = s->prev)
|
||||
{
|
||||
if (s->struct_type == _get_struct(value)->type)
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If type is structure, see if value is derived from type. */
|
||||
new_seen.struct_type = _get_struct(value)->type;
|
||||
new_seen.prev = seen;
|
||||
if (_struct_is_a(_get_struct(value)->type, structure_type_root.value, &new_seen))
|
||||
{
|
||||
for (value_t supers = _SLOT_VALUE(STRUCTURE, _get_struct(value)->type, SUPERS);
|
||||
!is_nil(supers); supers = _CDR(supers))
|
||||
{
|
||||
if (CAR(supers) == type)
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
bool struct_is_a(value_t value, value_t type)
|
||||
{
|
||||
return _struct_is_a(value, type, NULL);
|
||||
}
|
||||
|
||||
static void bi_string_to_number(interp_state_t *state)
|
||||
{
|
||||
char *str;
|
||||
|
|
|
|||
12
builtin.h
12
builtin.h
|
|
@ -20,14 +20,6 @@
|
|||
/* Name of builtin function */
|
||||
#define BI_STRING_TO_NUMBER "string->number"
|
||||
|
||||
/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
|
||||
#define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s])
|
||||
|
||||
#define STRUCTURE_SLOT_SUPERS 0
|
||||
#define STRUCTURE_SLOT_NSLOTS 1
|
||||
#define STRUCTURE_SLOT_CALLABLE 2
|
||||
#define STRUCTURE_SLOTS 3
|
||||
|
||||
#define TEMPLATE_SLOT_GLOBAL_VARS 0
|
||||
#define TEMPLATE_SLOT_INSTANCE_VARS 1
|
||||
#define TEMPLATE_SLOT_FRAME_VARS 2
|
||||
|
|
@ -42,7 +34,6 @@
|
|||
#define LAMBDA_SLOT_TAIL_CALL 4
|
||||
#define LAMBDA_SLOTS 5
|
||||
|
||||
value_t get_structure_type(void);
|
||||
value_t get_template_type(void);
|
||||
value_t get_lambda_type(void);
|
||||
|
||||
|
|
@ -50,8 +41,5 @@ void builtin_init(void);
|
|||
void register_builtin(const char *name, value_t value);
|
||||
value_t lookup_builtin(const char *name);
|
||||
|
||||
/* True if 'value' is (1) a structure, and (2) an instance of 'type'. */
|
||||
bool struct_is_a(value_t value, value_t type);
|
||||
|
||||
#endif
|
||||
/* vim:set sw=2 expandtab: */
|
||||
|
|
|
|||
78
gc.c
78
gc.c
|
|
@ -52,6 +52,8 @@ static gc_root_t gc_root_list = {
|
|||
.next = &gc_root_list
|
||||
};
|
||||
|
||||
static gc_root_t structure_type_root;
|
||||
|
||||
void register_gc_root(gc_root_t *root, value_t v)
|
||||
{
|
||||
root->value = v;
|
||||
|
|
@ -231,13 +233,17 @@ int byte_strcmp(value_t s1, value_t s2)
|
|||
return memcmp(str1->bytes, str2->bytes, str1->size);
|
||||
}
|
||||
|
||||
value_t make_struct(value_t type, size_t nslots)
|
||||
value_t make_struct(value_t type)
|
||||
{
|
||||
gc_root_t type_root;
|
||||
fixnum_t nslots;
|
||||
struct_t *s;
|
||||
|
||||
register_gc_root(&type_root, type);
|
||||
|
||||
release_assert(struct_is_a(type_root.value, get_structure_type()));
|
||||
nslots = get_fixnum(_SLOT_VALUE(STRUCTURE, type_root.value, NSLOTS));
|
||||
|
||||
s = (struct_t*)gc_alloc(STRUCT_BYTES(nslots));
|
||||
s->tag = TYPE_TAG_STRUCT;
|
||||
s->type = type_root.value;
|
||||
|
|
@ -252,6 +258,74 @@ value_t make_struct(value_t type, size_t nslots)
|
|||
return object_value(s);
|
||||
}
|
||||
|
||||
static void structure_init(void)
|
||||
{
|
||||
struct_t *s;
|
||||
|
||||
/* Instances of this structure describe structures. */
|
||||
/* It is both a structure and a structure description, and thus an instance of itself. */
|
||||
s = (struct_t*)gc_alloc(STRUCT_BYTES(STRUCTURE_SLOTS));
|
||||
s->tag = TYPE_TAG_STRUCT;
|
||||
s->type = object_value(s);
|
||||
s->nslots = STRUCTURE_SLOTS;
|
||||
s->hash = make_hash_value();
|
||||
|
||||
register_gc_root(&structure_type_root, object_value(s));
|
||||
|
||||
#define SS(x) STRUCTURE_SLOT_ ## x
|
||||
/* Slot 1: List of superclasses, most to least specific */
|
||||
_get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL;
|
||||
/* Slot 2: Total number of slots (excl. type) */
|
||||
_get_struct(structure_type_root.value)->slots[SS(NSLOTS)] = fixnum_value(STRUCTURE_SLOTS);
|
||||
/* Slot 3: Callable object used as proxy when structure is APPLY'd. */
|
||||
/* Can be LAMBDA, callable structure instance, builtin, or FALSE_VALUE. */
|
||||
_get_struct(structure_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE;
|
||||
#undef SS
|
||||
}
|
||||
|
||||
bool struct_is_a(value_t value, value_t type)
|
||||
{
|
||||
value_t tortoise, hare;
|
||||
|
||||
/* The trivial cases: non-struct and exact match */
|
||||
if (!is_struct(value)) return false;
|
||||
if (_get_struct(value)->type == type) return true;
|
||||
|
||||
/* Look for type in supers; detect cycles using "tortoise and hare" algorithm */
|
||||
tortoise = _SLOT_VALUE(STRUCTURE, _get_struct(value)->type, SUPERS);
|
||||
hare = tortoise;
|
||||
|
||||
if (is_nil(hare)) return false;
|
||||
if (CAR(hare) == type) return true;
|
||||
|
||||
hare = _CDR(hare);
|
||||
|
||||
if (is_nil(hare)) return false;
|
||||
if (CAR(hare) == type) return true;
|
||||
|
||||
while (hare != tortoise)
|
||||
{
|
||||
hare = _CDR(hare);
|
||||
|
||||
if (is_nil(hare)) return false;
|
||||
if (CAR(hare) == type) return true;
|
||||
|
||||
hare = _CDR(hare);
|
||||
|
||||
if (is_nil(hare)) return false;
|
||||
if (CAR(hare) == type) return true;
|
||||
|
||||
tortoise = CDR(tortoise);
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
value_t get_structure_type(void)
|
||||
{
|
||||
return structure_type_root.value;
|
||||
}
|
||||
|
||||
struct_t *get_struct(value_t v)
|
||||
{
|
||||
release_assert(is_struct(v));
|
||||
|
|
@ -509,6 +583,8 @@ void gc_init(size_t gen0_size, size_t gen1_min_size, size_t gen1_max_size)
|
|||
clear_gc_stats();
|
||||
|
||||
gc_enabled = true;
|
||||
|
||||
structure_init();
|
||||
}
|
||||
|
||||
void clear_gc_stats(void)
|
||||
|
|
|
|||
14
gc.h
14
gc.h
|
|
@ -81,6 +81,14 @@ typedef void (builtin_fn_t)(struct interp_state *state);
|
|||
#define _CADR(x) _CAR(_CDR(x))
|
||||
#define _CDDR(x) _CDR(_CDR(x))
|
||||
|
||||
/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
|
||||
#define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s])
|
||||
|
||||
#define STRUCTURE_SLOT_SUPERS 0
|
||||
#define STRUCTURE_SLOT_NSLOTS 1
|
||||
#define STRUCTURE_SLOT_CALLABLE 2
|
||||
#define STRUCTURE_SLOTS 3
|
||||
|
||||
/* Invoke this macro after creating any reference from a Gen-1 GC object to a Gen-0 object. */
|
||||
/* If unsure, invoke the macro; at most there will be a slight cost in performance. */
|
||||
/* Failing to invoke the macro before the next Gen-0 GC can lead to incorrect behavior. */
|
||||
|
|
@ -213,8 +221,12 @@ int byte_strcmp(value_t s1, value_t s2);
|
|||
value_t get_hash_value(value_t val);
|
||||
value_t combine_hash_values(value_t h1, value_t h2);
|
||||
|
||||
value_t make_struct(value_t type, size_t nslots);
|
||||
value_t make_struct(value_t type);
|
||||
struct_t *get_struct(value_t v);
|
||||
value_t get_structure_type(void);
|
||||
|
||||
/* True if 'value' is (1) a structure, and (2) an instance of 'type'. */
|
||||
bool struct_is_a(value_t value, value_t type);
|
||||
|
||||
value_t make_weak_box(value_t value);
|
||||
weak_box_t *get_weak_box(value_t v);
|
||||
|
|
|
|||
58
interp.c
58
interp.c
|
|
@ -98,6 +98,11 @@ value_t run_interpreter(value_t lambda, value_t argv)
|
|||
state.nframe = get_fixnum(_LAMBDA_SLOT(state.lambda.value, FRAME_VARS));
|
||||
release_assert((0 <= state.nframe) && (state.nframe <= 120));
|
||||
|
||||
state.globals.value = _LAMBDA_SLOT(state.lambda.value, GLOBAL_VARS);
|
||||
state.instances.value = _LAMBDA_SLOT(state.lambda.value, INSTANCE_VARS);
|
||||
release_assert(is_vector(state.globals.value));
|
||||
release_assert(is_vector(state.instances.value));
|
||||
|
||||
run_byte_code(&state);
|
||||
perform_tail_call(&state);
|
||||
}
|
||||
|
|
@ -110,6 +115,8 @@ value_t run_interpreter(value_t lambda, value_t argv)
|
|||
state.in1.value = UNDEFINED;
|
||||
state.in2.value = UNDEFINED;
|
||||
state.in3.value = UNDEFINED;
|
||||
state.globals.value = UNDEFINED;
|
||||
state.instances.value = UNDEFINED;
|
||||
|
||||
if (run_finalizers)
|
||||
{
|
||||
|
|
@ -121,12 +128,12 @@ value_t run_interpreter(value_t lambda, value_t argv)
|
|||
gc_root_t f_root;
|
||||
|
||||
register_gc_root(&f_root, f);
|
||||
run_finalizers = false;
|
||||
|
||||
/* Note that recursion is limited to a single level by the static variable. */
|
||||
run_finalizers = false;
|
||||
run_interpreter(f_root.value, cons(v, NIL));
|
||||
|
||||
run_finalizers = true;
|
||||
|
||||
unregister_gc_root(&f_root);
|
||||
}
|
||||
}
|
||||
|
|
@ -178,7 +185,6 @@ static void struct_set(value_t v, fixnum_t idx, value_t newval)
|
|||
{
|
||||
struct_t *s = get_struct(v);
|
||||
|
||||
release_assert(struct_is_a(s->type, get_structure_type()));
|
||||
release_assert((idx >= 0) && (idx < s->nslots));
|
||||
|
||||
s->slots[idx] = newval;
|
||||
|
|
@ -209,7 +215,7 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
|
|||
return templ;
|
||||
|
||||
register_gc_root(&templ_root, templ);
|
||||
register_gc_root(&lambda_root, make_struct(get_lambda_type(), LAMBDA_SLOTS));
|
||||
register_gc_root(&lambda_root, make_struct(get_lambda_type()));
|
||||
|
||||
/* Need to do this first, since it can call the garbage collector. */
|
||||
temp = make_vector(get_byte_string(get_struct(templ_root.value)
|
||||
|
|
@ -248,15 +254,11 @@ static void translate_callable(interp_state_t *state)
|
|||
while (!is_builtin_fn(state->lambda.value) &&
|
||||
!struct_is_a(state->lambda.value, get_lambda_type()))
|
||||
{
|
||||
/* If it's not a lambda, built-in function, or typed structure, then
|
||||
* it's not callable and I have no idea what to do with it. */
|
||||
release_assert(struct_is_a(get_struct(state->lambda.value)->type, get_structure_type()));
|
||||
|
||||
/* Prepend structure instance to argument list, per proxy protocol. */
|
||||
state->argv.value = cons(state->lambda.value, state->argv.value);
|
||||
|
||||
/* Follow link to next callable. */
|
||||
state->lambda.value = _SLOT_VALUE(STRUCTURE, _get_struct(state->lambda.value)->type, CALLABLE);
|
||||
/* Follow link to next callable. Must be a structure! */
|
||||
state->lambda.value = _SLOT_VALUE(STRUCTURE, get_struct(state->lambda.value)->type, CALLABLE);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -419,12 +421,7 @@ static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uin
|
|||
case 0x10: return boolean_value(is_builtin_fn(ST1));
|
||||
case 0x11: return boolean_value(is_weak_box(ST1));
|
||||
case 0x18: return make_box(ST1);
|
||||
case 0x19: {
|
||||
fixnum_t nslots;
|
||||
release_assert(struct_is_a(ST1, get_structure_type()));
|
||||
nslots = get_fixnum(_SLOT_VALUE(STRUCTURE, ST1, NSLOTS));
|
||||
return make_struct(ST1, nslots);
|
||||
}
|
||||
case 0x19: return make_struct(ST1);
|
||||
case 0x1a: return make_float((native_float_t)get_fixnum(ST1));
|
||||
case 0x1b: return make_lambda(state, ST1);
|
||||
case 0x1c: return make_weak_box(ST1);
|
||||
|
|
@ -535,7 +532,7 @@ static value_t get_input(const interp_state_t *state, fixnum_t var)
|
|||
return NIL;
|
||||
case 1 ... 63:
|
||||
{
|
||||
vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, GLOBAL_VARS));
|
||||
vector_t *vec = _get_vector(state->globals.value);
|
||||
var -= 1;
|
||||
|
||||
release_assert(var < vec->size);
|
||||
|
|
@ -543,7 +540,7 @@ static value_t get_input(const interp_state_t *state, fixnum_t var)
|
|||
}
|
||||
case 64 ... 127:
|
||||
{
|
||||
vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, INSTANCE_VARS));
|
||||
vector_t *vec = _get_vector(state->instances.value);
|
||||
var -= 64;
|
||||
|
||||
release_assert(var < vec->size);
|
||||
|
|
@ -551,7 +548,6 @@ static value_t get_input(const interp_state_t *state, fixnum_t var)
|
|||
}
|
||||
case 128 ... 247:
|
||||
{
|
||||
/* Frame is allocated by interpreter, so we know it's a vector already. */
|
||||
vector_t *vec = _get_vector(state->frame.value);
|
||||
var -= 128;
|
||||
|
||||
|
|
@ -591,17 +587,19 @@ static void set_output(const interp_state_t *state, fixnum_t var, value_t val)
|
|||
|
||||
static void register_state(interp_state_t *state, value_t lambda, value_t argv)
|
||||
{
|
||||
register_gc_root(&state->lambda, lambda);
|
||||
register_gc_root(&state->argv, argv);
|
||||
register_gc_root(&state->kw_args, NIL);
|
||||
register_gc_root(&state->kw_vals, NIL);
|
||||
register_gc_root(&state->ctx, FALSE_VALUE);
|
||||
register_gc_root(&state->k, FALSE_VALUE);
|
||||
register_gc_root(&state->lambda, lambda);
|
||||
register_gc_root(&state->argv, argv);
|
||||
register_gc_root(&state->kw_args, NIL);
|
||||
register_gc_root(&state->kw_vals, NIL);
|
||||
register_gc_root(&state->ctx, FALSE_VALUE);
|
||||
register_gc_root(&state->k, FALSE_VALUE);
|
||||
|
||||
register_gc_root(&state->frame, make_vector(120, UNDEFINED));
|
||||
register_gc_root(&state->in1, FALSE_VALUE);
|
||||
register_gc_root(&state->in2, FALSE_VALUE);
|
||||
register_gc_root(&state->in3, FALSE_VALUE);
|
||||
register_gc_root(&state->globals, UNDEFINED);
|
||||
register_gc_root(&state->instances, UNDEFINED);
|
||||
register_gc_root(&state->frame, make_vector(120, UNDEFINED));
|
||||
register_gc_root(&state->in1, FALSE_VALUE);
|
||||
register_gc_root(&state->in2, FALSE_VALUE);
|
||||
register_gc_root(&state->in3, FALSE_VALUE);
|
||||
}
|
||||
|
||||
static void unregister_state(interp_state_t *state)
|
||||
|
|
@ -613,6 +611,8 @@ static void unregister_state(interp_state_t *state)
|
|||
unregister_gc_root(&state->ctx);
|
||||
unregister_gc_root(&state->k);
|
||||
|
||||
unregister_gc_root(&state->globals);
|
||||
unregister_gc_root(&state->instances);
|
||||
unregister_gc_root(&state->frame);
|
||||
unregister_gc_root(&state->in1);
|
||||
unregister_gc_root(&state->in2);
|
||||
|
|
|
|||
2
interp.h
2
interp.h
|
|
@ -6,6 +6,8 @@
|
|||
typedef struct interp_state
|
||||
{
|
||||
gc_root_t lambda;
|
||||
gc_root_t globals;
|
||||
gc_root_t instances;
|
||||
gc_root_t frame;
|
||||
gc_root_t argv;
|
||||
gc_root_t kw_args;
|
||||
|
|
|
|||
51
reader.c
51
reader.c
|
|
@ -56,6 +56,24 @@ static value_t patch_placeholders(reader_state_t *state, value_t v);
|
|||
|
||||
static void tree_replace(value_t *in, value_t oldval, value_t newval);
|
||||
|
||||
static inline void next_char(reader_state_t *state)
|
||||
{
|
||||
if (state->ch != EOF)
|
||||
{
|
||||
state->ch = fgetc(state->file);
|
||||
|
||||
if (state->ch == '\n')
|
||||
{
|
||||
++state->line;
|
||||
state->column = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
++state->column;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
value_t read_value_from_file(FILE *f)
|
||||
{
|
||||
reader_state_t state;
|
||||
|
|
@ -651,22 +669,18 @@ static value_t read_vector(reader_state_t *state)
|
|||
static value_t read_struct(reader_state_t *state)
|
||||
{
|
||||
gc_root_t list_root;
|
||||
size_t slots = 0;
|
||||
value_t value;
|
||||
value_t item;
|
||||
|
||||
register_gc_root(&list_root, read_list(state));
|
||||
|
||||
for (item = CDR(list_root.value); !is_nil(item); item = CDR(item))
|
||||
++slots;
|
||||
|
||||
value = make_struct(_CAR(list_root.value), slots);
|
||||
value = make_struct(CAR(list_root.value));
|
||||
|
||||
item = _CDR(list_root.value);
|
||||
for (size_t i = 0; i < slots; ++i)
|
||||
for (size_t i = 0; i < _get_struct(value)->nslots; ++i)
|
||||
{
|
||||
_get_struct(value)->slots[i] = _CAR(item);
|
||||
/* No write barrier needed here. */
|
||||
_get_struct(value)->slots[i] = CAR(item);
|
||||
/* No write barrier needed here; structure is still in Gen-0. */
|
||||
item = _CDR(item);
|
||||
}
|
||||
|
||||
|
|
@ -856,8 +870,7 @@ static bool _tree_replace(value_t *in, value_t oldval, value_t newval,
|
|||
}
|
||||
else if (is_struct(*in))
|
||||
{
|
||||
updated = _tree_replace(&_get_struct(*in)->type, oldval, newval, &this_seen);
|
||||
|
||||
/* make_struct() won't allow type field to be a placeholder. */
|
||||
for (size_t i = 0; i < _get_struct(*in)->nslots; ++i)
|
||||
{
|
||||
if (_tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen))
|
||||
|
|
@ -880,24 +893,6 @@ static void tree_replace(value_t *in, value_t oldval, value_t newval)
|
|||
(void)_tree_replace(in, oldval, newval, NULL);
|
||||
}
|
||||
|
||||
static void next_char(reader_state_t *state)
|
||||
{
|
||||
if (state->ch != EOF)
|
||||
{
|
||||
state->ch = fgetc(state->file);
|
||||
|
||||
if (state->ch == '\n')
|
||||
{
|
||||
++state->line;
|
||||
state->column = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
++state->column;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void skip_whitespace(reader_state_t *state)
|
||||
{
|
||||
for (;;)
|
||||
|
|
|
|||
Loading…
Reference in New Issue