summaryrefslogtreecommitdiffstats
path: root/struct.c
diff options
context:
space:
mode:
Diffstat (limited to 'struct.c')
-rw-r--r--struct.c308
1 files changed, 273 insertions, 35 deletions
diff --git a/struct.c b/struct.c
index 298eae0b..214cdf56 100644
--- a/struct.c
+++ b/struct.c
@@ -44,19 +44,25 @@
#include "gc.h"
#include "args.h"
#include "cadr.h"
+#include "txr.h"
#include "struct.h"
#define max(a, b) ((a) > (b) ? (a) : (b))
+#define STATIC_SLOT_BASE 0x10000000
+
struct struct_type {
val name;
cnum id;
cnum nslots;
+ cnum nstslots;
val super;
struct struct_type *super_handle;
val slots;
+ val stinitfun;
val initfun;
val boactor;
+ val *stslot;
};
struct struct_inst {
@@ -76,6 +82,11 @@ static val struct_type_finalize(val obj);
static_forward(struct cobj_ops struct_type_ops);
static_forward(struct cobj_ops struct_inst_ops);
+static val make_struct_type_compat(val name, val super, val slots,
+ val initfun, val boactor);
+static val call_super_method(val inst, val sym, struct args *);
+static val call_super_fun(val type, val sym, struct args *);
+
void struct_init(void)
{
protect(&struct_type_hash, &slot_hash, &struct_type_finalize_f,
@@ -84,8 +95,16 @@ void struct_init(void)
struct_type_hash = make_hash(nil, nil, nil);
slot_hash = make_hash(nil, nil, t);
struct_type_finalize_f = func_n1(struct_type_finalize);
- reg_fun(intern(lit("make-struct-type"), user_package),
- func_n5(make_struct_type));
+
+ if (opt_compat && opt_compat <= 117)
+ reg_fun(intern(lit("make-struct-type"), user_package),
+ func_n5(make_struct_type_compat));
+ else
+ reg_fun(intern(lit("make-struct-type"), user_package),
+ func_n7(make_struct_type));
+
+ reg_fun(intern(lit("make-struct-type"), system_package),
+ func_n7(make_struct_type));
reg_fun(intern(lit("find-struct-type"), user_package),
func_n1(find_struct_type));
reg_fun(intern(lit("struct-type-p"), user_package), func_n1(struct_type_p));
@@ -94,6 +113,15 @@ void struct_init(void)
reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
reg_fun(intern(lit("slot"), user_package), func_n2(slot));
reg_fun(intern(lit("slotset"), user_package), func_n3(slotset));
+ reg_fun(intern(lit("static-slot"), user_package), func_n2(static_slot));
+ reg_fun(intern(lit("static-slot-set"), user_package),
+ func_n3(static_slot_set));
+ reg_fun(intern(lit("call-super-method"), user_package),
+ func_n2v(call_super_method));
+ reg_fun(intern(lit("call-super-fun"), user_package),
+ func_n2v(call_super_fun));
+ reg_fun(intern(lit("slot-p"), user_package), func_n2(slot_p));
+ reg_fun(intern(lit("static-slot-p"), user_package), func_n2(static_slot_p));
reg_fun(intern(lit("structp"), user_package), func_n1(structp));
reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type));
reg_fun(intern(lit("method"), user_package), func_n2(method));
@@ -117,7 +145,19 @@ static val struct_type_finalize(val obj)
return nil;
}
-val make_struct_type(val name, val super, val slots, val initfun, val boactor)
+static void call_stinitfun_chain(struct struct_type *st, val stype)
+{
+ if (st) {
+ if (st->super)
+ call_stinitfun_chain(st->super_handle, stype);
+ if (st->stinitfun)
+ funcall1(st->stinitfun, stype);
+ }
+}
+
+val make_struct_type(val name, val super,
+ val static_slots, val slots,
+ val static_initfun, val initfun, val boactor)
{
val self = lit("make-struct-type");
@@ -148,32 +188,64 @@ val make_struct_type(val name, val super, val slots, val initfun, val boactor)
coerce(struct struct_type *,
cobj_handle(super, struct_type_s)), 0);
val super_slots = if2(su, su->slots);
- val all_slots = uniq(append2(super_slots, slots));
+ val all_slots = uniq(append2(super_slots, append2(static_slots, slots)));
val stype = cobj(coerce(mem_t *, st), struct_type_s, &struct_type_ops);
val id = num_fast(++struct_id_counter);
- val slot;
- cnum sl;
+ val iter;
+ cnum sl, stsl;
st->name = name;
st->id = c_num(id);
- st->nslots = c_num(length(all_slots));
+ st->nslots = st->nstslots = 0;
st->slots = all_slots;
st->super = super;
+ st->stslot = 0;
st->super_handle = su;
+ st->stinitfun = static_initfun;
st->initfun = initfun;
st->boactor = boactor;
- sethash(struct_type_hash, name, stype);
+ gc_finalize(stype, struct_type_finalize_f);
- for (sl = 0, slot = all_slots; slot; sl++, slot = cdr(slot))
- sethash(slot_hash, cons(car(slot), id), num_fast(sl));
+ for (sl = 0, stsl = STATIC_SLOT_BASE, iter = all_slots;
+ iter;
+ iter = cdr(iter))
+ {
+ val slot = car(iter);
+ val new_tslot_p = memq(slot, static_slots);
+ int inherited_p = !new_tslot_p && !memq(slot, slots);
+ val ts_p = if3(inherited_p,
+ static_slot_p(super, slot),
+ memq(slot, static_slots));
+
+ if (ts_p)
+ sethash(slot_hash, cons(slot, id), num(stsl++));
+ else
+ sethash(slot_hash, cons(slot, id), num_fast(sl++));
+
+ if (sl >= STATIC_SLOT_BASE)
+ uw_throwf(error_s, lit("~a: too many slots"), self, nao);
+ }
- gc_finalize(stype, struct_type_finalize_f);
+ stsl -= STATIC_SLOT_BASE;
+ st->stslot = coerce(val *, chk_calloc(stsl, sizeof *st->stslot));
+ st->nslots = sl;
+ st->nstslots = stsl;
+
+ sethash(struct_type_hash, name, stype);
+
+ call_stinitfun_chain(st, stype);
return stype;
}
}
+static val make_struct_type_compat(val name, val super, val slots,
+ val initfun, val boactor)
+{
+ return make_struct_type(name, super, nil, slots, nil, initfun, boactor);
+}
+
val find_struct_type(val sym)
{
return gethash(struct_type_hash, sym);
@@ -204,14 +276,27 @@ static void struct_type_print(val obj, val out, val pretty)
format(out, lit("#<struct-type ~s>"), st->name, nao);
}
+static void struct_type_destroy(val obj)
+{
+ struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+ free(st->stslot);
+ free(st);
+}
+
static void struct_type_mark(val obj)
{
struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+ cnum stsl;
+
gc_mark(st->name);
gc_mark(st->super);
gc_mark(st->slots);
+ gc_mark(st->stinitfun);
gc_mark(st->initfun);
gc_mark(st->boactor);
+
+ for (stsl = 0; stsl < st->nstslots; stsl++)
+ gc_mark(st->stslot[stsl]);
}
static void call_initfun_chain(struct struct_type *st, val strct)
@@ -343,7 +428,7 @@ static void cache_set_insert(slot_cache_entry_t *set, cnum id, cnum slot)
set[entry].slot = slot;
}
-static val *lookup_slot(struct struct_inst *si, val sym)
+static loc lookup_slot(val inst, struct struct_inst *si, val sym)
{
slot_cache_t slot_cache = sym->s.slot_cache;
cnum id = si->id;
@@ -352,15 +437,24 @@ static val *lookup_slot(struct struct_inst *si, val sym)
slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
cnum slot = cache_set_lookup(*set, id);
- if (slot >= 0) {
- return &si->slot[slot];
+ if (slot >= STATIC_SLOT_BASE) {
+ val type = si->type;
+ struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+ return mkloc(st->stslot[slot - STATIC_SLOT_BASE], type);
+ } else if (slot >= 0) {
+ return mkloc(si->slot[slot], inst);
} else {
val key = cons(sym, num_fast(id));
val sl = gethash(slot_hash, key);
cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
if (sl) {
cache_set_insert(*set, id, slnum);
- return &si->slot[slnum];
+ if (slnum >= STATIC_SLOT_BASE) {
+ val type = si->type;
+ struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+ return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], type);
+ }
+ return mkloc(si->slot[slnum], inst);
}
}
} else {
@@ -376,11 +470,58 @@ static val *lookup_slot(struct struct_inst *si, val sym)
if (sl) {
cache_set_insert(*set, id, slnum);
- return &si->slot[slnum];
+ if (slnum >= STATIC_SLOT_BASE) {
+ val type = si->type;
+ struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+ return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], type);
+ }
+ return mkloc(si->slot[slnum], inst);
}
}
- return 0;
+ return nulloc;
+}
+
+static loc lookup_static_slot(val stype, struct struct_type *st, val sym)
+{
+ slot_cache_t slot_cache = sym->s.slot_cache;
+ cnum id = st->id;
+
+ if (slot_cache != 0) {
+ slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
+ cnum slot = cache_set_lookup(*set, id);
+
+ if (slot >= STATIC_SLOT_BASE) {
+ return mkloc(st->stslot[slot - STATIC_SLOT_BASE], stype);
+ } else if (slot < 0) {
+ val key = cons(sym, num_fast(id));
+ val sl = gethash(slot_hash, key);
+ cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+ if (sl) {
+ cache_set_insert(*set, id, slnum);
+ if (slnum >= STATIC_SLOT_BASE)
+ return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype);
+ }
+ }
+ } else {
+ slot_cache = coerce(slot_cache_t,
+ chk_calloc(SLOT_CACHE_SIZE,
+ sizeof (slot_cache_set_t)));
+ slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
+ val key = cons(sym, num_fast(id));
+ val sl = gethash(slot_hash, key);
+ cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+
+ sym->s.slot_cache = slot_cache;
+
+ if (sl) {
+ cache_set_insert(*set, id, slnum);
+ if (slnum >= STATIC_SLOT_BASE)
+ return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype);
+ }
+ }
+
+ return nulloc;
}
static noreturn void no_such_slot(val ctx, val type, val slot)
@@ -395,9 +536,9 @@ val slot(val strct, val sym)
struct struct_inst *si = struct_handle(strct, self);
if (symbolp(sym)) {
- val *ptr = lookup_slot(si, sym);
- if (ptr)
- return *ptr;
+ loc ptr = lookup_slot(strct, si, sym);
+ if (!nullocp(ptr))
+ return deref(ptr);
}
no_such_slot(self, si->type, sym);
@@ -409,16 +550,109 @@ val slotset(val strct, val sym, val newval)
struct struct_inst *si = struct_handle(strct, self);
if (symbolp(sym)) {
- val *ptr = lookup_slot(si, sym);
- if (ptr) {
- set(mkloc(*ptr, strct), newval);
- return newval;
- }
+ loc ptr = lookup_slot(strct, si, sym);
+ if (!nullocp(ptr))
+ return set(ptr, newval);
}
no_such_slot(self, si->type, sym);
}
+val static_slot(val stype, val sym)
+{
+ struct struct_type *st = coerce(struct struct_type *,
+ cobj_handle(stype, struct_type_s));
+
+ if (symbolp(sym)) {
+ loc ptr = lookup_static_slot(stype, st, sym);
+ if (!nullocp(ptr))
+ return deref(ptr);
+ }
+
+ no_such_slot(lit("static-slot"), stype, sym);
+}
+
+val static_slot_set(val stype, val sym, val newval)
+{
+ struct struct_type *st = coerce(struct struct_type *,
+ cobj_handle(stype, struct_type_s));
+
+ if (symbolp(sym)) {
+ loc ptr = lookup_static_slot(stype, st, sym);
+ if (!nullocp(ptr))
+ return set(ptr, newval);
+ }
+
+ no_such_slot(lit("static-slot-set"), stype, sym);
+}
+
+static val call_super_method(val inst, val sym, struct args *args)
+{
+ val type = struct_type(inst);
+ val suptype = super(type);
+
+ if (suptype) {
+ val meth = static_slot(suptype, sym);
+ args_decl(args_copy, max(args->fill + 1, ARGS_MIN));
+ args_add(args_copy, inst);
+ args_cat_zap(args_copy, args);
+ return generic_funcall(meth, args_copy);
+ }
+
+ uw_throwf(error_s, lit("call-super-method: ~s has no supertype"),
+ suptype, nao);
+}
+
+static val call_super_fun(val type, val sym, struct args *args)
+{
+ val suptype = super(type);
+
+ if (suptype) {
+ val fun = static_slot(suptype, sym);
+ return generic_funcall(fun, args);
+ }
+
+ uw_throwf(error_s, lit("call-super-fun: ~s has no supertype"),
+ type, nao);
+}
+
+val slot_p(val type, val sym)
+{
+ if (type && symbolp(type)) {
+ val stype = find_struct_type(type);
+ if (!stype)
+ no_such_struct(lit("slot-p"), type);
+ return slot_p(stype, sym);
+ } else {
+ struct struct_type *st = coerce(struct struct_type *,
+ cobj_handle(type, struct_type_s));
+ return tnil(memq(sym, st->slots));
+ }
+}
+
+val static_slot_p(val type, val sym)
+{
+ if (type && symbolp(type)) {
+ val stype = find_struct_type(type);
+ if (!stype)
+ no_such_struct(lit("type-slot-p"), type);
+ return static_slot_p(stype, sym);
+ } else {
+ struct struct_type *st = coerce(struct struct_type *,
+ cobj_handle(type, struct_type_s));
+ if (memq(sym, st->slots)) {
+ val key = cons(sym, num_fast(st->id));
+ val sl = gethash(slot_hash, key);
+ cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+
+ if (sl && slnum >= STATIC_SLOT_BASE)
+ return t;
+ }
+
+ return nil;
+ }
+}
+
val structp(val obj)
{
return tnil(cobjp(obj) && obj->co.ops == &struct_inst_ops);
@@ -451,21 +685,25 @@ static void struct_inst_print(val obj, val out, val pretty)
struct struct_type *st = coerce(struct struct_type *, si->type->co.handle);
val save_mode = test_set_indent_mode(out, num_fast(indent_off),
num_fast(indent_data));
- val save_indent, slots;
- cnum sl, nslots = st->nslots;
+ val save_indent, iter, once;
put_string(lit("#S("), out);
obj_print_impl(st->name, out, pretty);
save_indent = inc_indent(out, one);
- for (slots = st->slots, sl = 0; sl < nslots; sl++, slots = cdr(slots)) {
- if (sl == 0)
+ for (iter = st->slots, once = t; iter; iter = cdr(iter)) {
+ val sym = car(iter);
+ if (!static_slot_p(si->type, sym)) {
+ if (once) {
+ put_char(chr(' '), out);
+ once = nil;
+ } else {
+ width_check(out, chr(' '));
+ }
+ obj_print_impl(sym, out, pretty);
put_char(chr(' '), out);
- else
- width_check(out, chr(' '));
- obj_print_impl(car(slots), out, pretty);
- put_char(chr(' '), out);
- obj_print_impl(si->slot[sl], out, pretty);
+ obj_print_impl(slot(obj, sym), out, pretty);
+ }
}
put_char(chr(')'), out);
set_indent_mode(out, save_mode);
@@ -518,7 +756,7 @@ static cnum struct_inst_hash(val obj)
}
static_def(struct cobj_ops struct_type_ops =
- cobj_ops_init(eq, struct_type_print, cobj_destroy_free_op,
+ cobj_ops_init(eq, struct_type_print, struct_type_destroy,
struct_type_mark, cobj_hash_op))
static_def(struct cobj_ops struct_inst_ops =
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-20 08:56:13 +0000