summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--buf.c4
-rw-r--r--chksum.c15
-rw-r--r--ffi.c54
-rw-r--r--ffi.h2
-rw-r--r--filter.c4
-rw-r--r--gc.c4
-rw-r--r--hash.c62
-rw-r--r--hash.h3
-rw-r--r--lib.c197
-rw-r--r--lib.h27
-rw-r--r--match.c2
-rw-r--r--parser.c21
-rw-r--r--parser.h3
-rw-r--r--rand.c20
-rw-r--r--rand.h1
-rw-r--r--regex.c36
-rw-r--r--regex.h2
-rw-r--r--socket.c2
-rw-r--r--stream.c115
-rw-r--r--stream.h2
-rw-r--r--struct.c46
-rw-r--r--struct.h1
-rw-r--r--strudel.c2
-rw-r--r--sysif.c12
-rw-r--r--syslog.c2
-rw-r--r--tree.c56
-rw-r--r--tree.h1
-rw-r--r--unwind.c9
-rw-r--r--vm.c15
-rw-r--r--vm.h2
30 files changed, 451 insertions, 271 deletions
diff --git a/buf.c b/buf.c
index a5592749..32e06e74 100644
--- a/buf.c
+++ b/buf.c
@@ -1074,7 +1074,7 @@ static struct strm_ops buf_strm_ops =
static struct buf_strm *buf_strm(val stream, val self)
{
struct buf_strm *s = coerce(struct buf_strm *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
type_assert (stream->co.ops == &buf_strm_ops.cobj_ops,
(lit("~a: ~a is not a buffer stream"), self, stream, nao));
@@ -1093,7 +1093,7 @@ val make_buf_stream(val buf_opt)
s->pos = zero;
s->is_byte_oriented = 0;
s->unget_c = nil;
- stream = cobj(coerce(mem_t *, s), stream_s, &buf_strm_ops.cobj_ops);
+ stream = cobj(coerce(mem_t *, s), stream_cls, &buf_strm_ops.cobj_ops);
s->buf = buf;
return stream;
diff --git a/chksum.c b/chksum.c
index 1f2ea3eb..081feb79 100644
--- a/chksum.c
+++ b/chksum.c
@@ -46,6 +46,7 @@
#include "chksum.h"
static val sha256_ctx_s, md5_ctx_s;
+static struct cobj_class *sha256_ctx_cls, *md5_ctx_cls;
static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash,
val self)
@@ -178,7 +179,7 @@ val sha256_begin(void)
{
SHA256_t *ps256 = coerce(SHA256_t *, chk_malloc(sizeof *ps256));
SHA256_init(ps256);
- return cobj(coerce(mem_t *, ps256), sha256_ctx_s, &sha256_ops);
+ return cobj(coerce(mem_t *, ps256), sha256_ctx_cls, &sha256_ops);
}
static int sha256_utf8_byte_callback(int b, mem_t *ctx)
@@ -192,7 +193,7 @@ static int sha256_utf8_byte_callback(int b, mem_t *ctx)
val sha256_hash(val ctx, val obj)
{
val self = lit("sha256-hash");
- SHA256_t *ps256 = coerce(SHA256_t *, cobj_handle(self, ctx, sha256_ctx_s));
+ SHA256_t *ps256 = coerce(SHA256_t *, cobj_handle(self, ctx, sha256_ctx_cls));
switch (type(obj)) {
case STR:
@@ -232,7 +233,7 @@ val sha256_end(val ctx, val buf_in)
{
val self = lit("sha256-end");
unsigned char *hash;
- SHA256_t *ps256 = coerce(SHA256_t *, cobj_handle(self, ctx, sha256_ctx_s));
+ SHA256_t *ps256 = coerce(SHA256_t *, cobj_handle(self, ctx, sha256_ctx_cls));
val buf = chksum_ensure_buf(self, buf_in, num_fast(SHA256_DIGEST_LENGTH),
&hash, lit("SHA-256"));
@@ -442,7 +443,7 @@ val md5_begin(void)
{
MD5_t *pmd5 = coerce(MD5_t *, chk_malloc(sizeof *pmd5));
MD5_init(pmd5);
- return cobj(coerce(mem_t *, pmd5), md5_ctx_s, &md5_ops);
+ return cobj(coerce(mem_t *, pmd5), md5_ctx_cls, &md5_ops);
}
static int md5_utf8_byte_callback(int b, mem_t *ctx)
@@ -456,7 +457,7 @@ static int md5_utf8_byte_callback(int b, mem_t *ctx)
val md5_hash(val ctx, val obj)
{
val self = lit("md5-hash");
- MD5_t *pmd5 = coerce(MD5_t *, cobj_handle(self, ctx, md5_ctx_s));
+ MD5_t *pmd5 = coerce(MD5_t *, cobj_handle(self, ctx, md5_ctx_cls));
switch (type(obj)) {
case STR:
@@ -496,7 +497,7 @@ val md5_end(val ctx, val buf_in)
{
val self = lit("md5-end");
unsigned char *hash;
- MD5_t *pmd5 = coerce(MD5_t *, cobj_handle(self, ctx, md5_ctx_s));
+ MD5_t *pmd5 = coerce(MD5_t *, cobj_handle(self, ctx, md5_ctx_cls));
val buf = chksum_ensure_buf(self, buf_in, num_fast(MD5_DIGEST_LENGTH),
&hash, lit("SHA-256"));
@@ -509,6 +510,8 @@ void chksum_init(void)
{
sha256_ctx_s = intern(lit("sha256-ctx"), user_package);
md5_ctx_s = intern(lit("md5-ctx"), user_package);
+ sha256_ctx_cls = cobj_register(sha256_ctx_s);
+ md5_ctx_cls = cobj_register(md5_ctx_s);
reg_fun(intern(lit("sha256-stream"), user_package), func_n3o(sha256_stream, 1));
reg_fun(intern(lit("sha256"), user_package), func_n2o(sha256, 1));
reg_fun(intern(lit("sha256-begin"), user_package), func_n0(sha256_begin));
diff --git a/ffi.c b/ffi.c
index 44652e84..282c9e55 100644
--- a/ffi.c
+++ b/ffi.c
@@ -163,6 +163,10 @@ static ffi_type ffi_type_sint64, ffi_type_uint64;
static ffi_type ffi_type_float, ffi_type_double;
#endif
+static struct cobj_class *ffi_type_cls, *ffi_call_desc_cls;
+static struct cobj_class *ffi_closure_cls, *union_cls;
+struct cobj_class *carray_cls;
+
struct smemb {
val mname;
val mtype;
@@ -223,7 +227,7 @@ static struct txr_ffi_type *ffi_type_struct(val obj)
static struct txr_ffi_type *ffi_type_struct_checked(val self, val obj)
{
- return coerce(struct txr_ffi_type *, cobj_handle(self, obj, ffi_type_s));
+ return coerce(struct txr_ffi_type *, cobj_handle(self, obj, ffi_type_cls));
}
#if HAVE_LIBFFI
@@ -248,7 +252,7 @@ static void ffi_type_print_op(val obj, val out, val pretty, struct strm_ctx *ctx
{
struct txr_ffi_type *tft = ffi_type_struct(obj);
put_string(lit("#<"), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->co.cls->cls_sym, out, pretty, ctx);
format(out, lit(" ~!~s>"), tft->syntax, nao);
}
@@ -360,7 +364,8 @@ static struct txr_ffi_closure *ffi_closure_struct(val obj)
static struct txr_ffi_closure *ffi_closure_struct_checked(val self, val obj)
{
- return coerce(struct txr_ffi_closure *, cobj_handle(self, obj, ffi_closure_s));
+ return coerce(struct txr_ffi_closure *, cobj_handle(self, obj,
+ ffi_closure_cls));
}
static void ffi_closure_print_op(val obj, val out,
@@ -368,7 +373,7 @@ static void ffi_closure_print_op(val obj, val out,
{
struct txr_ffi_closure *tfcl = ffi_closure_struct(obj);
put_string(lit("#<"), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->co.cls->cls_sym, out, pretty, ctx);
format(out, lit(" ~s ~s>"), tfcl->fun, tfcl->call_desc, nao);
}
@@ -3103,7 +3108,7 @@ static val make_ffi_type_builtin(val syntax, val lisp_type, ffi_kind_t kind,
struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
chk_calloc(1, sizeof *tft));
- val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_builtin_ops);
+ val obj = cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_builtin_ops);
tft->self = obj;
tft->kind = kind;
@@ -3152,7 +3157,7 @@ static val make_ffi_type_pointer(val syntax, val lisp_type,
struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
chk_calloc(1, sizeof *tft));
- val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_ptr_ops);
+ val obj = cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_ptr_ops);
tft->self = obj;
tft->kind = FFI_KIND_PTR;
@@ -3315,7 +3320,7 @@ static val make_ffi_type_struct(val syntax, val lisp_type,
chk_calloc(nmemb, sizeof *memb));
val obj = if3(use_existing,
tft->self,
- cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops));
+ cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_struct_ops));
ucnum offs = 0;
ucnum most_align = 0;
int need_out_handler = 0;
@@ -3482,7 +3487,7 @@ static val make_ffi_type_union(val syntax, val use_existing, val self)
chk_calloc(nmemb, sizeof *memb));
val obj = if3(use_existing,
tft->self,
- cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops));
+ cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_struct_ops));
ucnum most_align = 0;
ucnum biggest_size = 0;
const unsigned bits_int = 8 * sizeof(int);
@@ -3593,7 +3598,7 @@ static val make_ffi_type_array(val syntax, val lisp_type,
struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
chk_calloc(1, sizeof *tft));
cnum nelem = c_num(dim, self);
- val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops);
+ val obj = cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_struct_ops);
struct txr_ffi_type *etft = ffi_type_struct(eltype);
@@ -3644,7 +3649,7 @@ static val make_ffi_type_enum(val syntax, val enums,
val sym_num = make_hash(nil, nil, t);
val num_sym = make_hash(nil, nil, nil);
- val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_enum_ops);
+ val obj = cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_enum_ops);
cnum lowest = INT_PTR_MAX;
cnum highest = INT_PTR_MIN;
cnum cur = -1;
@@ -4726,7 +4731,7 @@ static struct txr_ffi_call_desc *ffi_call_desc(val obj)
static struct txr_ffi_call_desc *ffi_call_desc_checked(val self, val obj)
{
return coerce(struct txr_ffi_call_desc *, cobj_handle(self, obj,
- ffi_call_desc_s));
+ ffi_call_desc_cls));
}
static void ffi_call_desc_print_op(val obj, val out,
@@ -4734,7 +4739,7 @@ static void ffi_call_desc_print_op(val obj, val out,
{
struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj);
put_string(lit("#<"), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->co.cls->cls_sym, out, pretty, ctx);
format(out, lit(" ~s ~s ~!~s>"), tfcd->name, tfcd->rettype,
tfcd->argtypes, nao);
}
@@ -4772,7 +4777,7 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes,
struct txr_ffi_call_desc *tfcd = coerce(struct txr_ffi_call_desc *,
chk_calloc(1, sizeof *tfcd));
ffi_type **args = coerce(ffi_type **, chk_xalloc(nt, sizeof *args, self));
- val obj = cobj(coerce(mem_t *, tfcd), ffi_call_desc_s, &ffi_call_desc_ops);
+ val obj = cobj(coerce(mem_t *, tfcd), ffi_call_desc_cls, &ffi_call_desc_ops);
ffi_status ffis = FFI_OK;
tfcd->variadic = (nt != nf);
@@ -5031,7 +5036,7 @@ val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in)
chk_calloc(1, sizeof *tfcl));
struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(real_self, call_desc);
val self = if3(tfcd->name, tfcd->name, real_self);
- val obj = cobj(coerce(mem_t *, tfcl), ffi_closure_s, &ffi_closure_ops);
+ val obj = cobj(coerce(mem_t *, tfcl), ffi_closure_cls, &ffi_closure_ops);
val safe_p = default_arg_strict(safe_p_in, t);
ffi_status ffis = FFI_OK;
@@ -5265,14 +5270,14 @@ static struct carray *carray_struct(val carray)
static struct carray *carray_struct_checked(val self, val carray)
{
- return coerce(struct carray*, cobj_handle(self, carray, carray_s));
+ return coerce(struct carray*, cobj_handle(self, carray, carray_cls));
}
static void carray_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
{
struct carray *scry = carray_struct(obj);
put_string(lit("#<"), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->co.cls->cls_sym, out, pretty, ctx);
format(out, lit(" ~a"), if3(scry->nelem < 0,
lit("unknown-len"), num(scry->nelem)), nao);
format(out, lit(" ~s>"), scry->eltype, nao);
@@ -5320,7 +5325,7 @@ val make_carray(val type, mem_t *data, cnum nelem, val ref, cnum offs)
scry->nelem = nelem;
scry->ref = nil;
scry->artype[0] = scry->artype[1] = nil;
- obj = cobj(coerce(mem_t *, scry), carray_s, &carray_borrowed_ops);
+ obj = cobj(coerce(mem_t *, scry), carray_cls, &carray_borrowed_ops);
scry->eltype = type;
scry->ref = ref;
scry->offs = offs;
@@ -5329,7 +5334,7 @@ val make_carray(val type, mem_t *data, cnum nelem, val ref, cnum offs)
val carrayp(val obj)
{
- return cobjclassp(obj, carray_s);
+ return cobjclassp(obj, carray_cls);
}
val carray_set_length(val carray, val nelem)
@@ -6043,7 +6048,7 @@ static val cptr_getobj(val cptr, val type_in)
{
val self = lit("cptr-get");
mem_t *data = cptr_get(cptr);
- val type = default_arg(type_in, ffi_type_lookup_checked(self, cptr->co.cls));
+ val type = default_arg(type_in, ffi_type_lookup_checked(self, cptr->cp.cls));
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
if (data != 0)
return tft->get(tft, data, self);
@@ -6054,7 +6059,7 @@ static val cptr_out(val cptr, val obj, val type_in)
{
val self = lit("cptr-out");
mem_t *data = cptr_get(cptr);
- val type = default_arg(type_in, ffi_type_lookup_checked(self, cptr->co.cls));
+ val type = default_arg(type_in, ffi_type_lookup_checked(self, cptr->cp.cls));
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
if (data != 0) {
if (tft->out != 0)
@@ -6078,7 +6083,7 @@ static struct uni *uni_struct(val obj)
static struct uni *uni_struct_checked(val self, val obj)
{
- return coerce(struct uni *, cobj_handle(self, obj, union_s));
+ return coerce(struct uni *, cobj_handle(self, obj, union_cls));
}
static void union_destroy_op(val obj)
@@ -6105,7 +6110,7 @@ static struct cobj_ops union_ops =
static val make_union_common(mem_t *data, struct txr_ffi_type *tft)
{
struct uni *us = coerce(struct uni *, chk_calloc(1, sizeof *us));
- val obj = cobj(coerce(mem_t *, us), union_s, &union_ops);
+ val obj = cobj(coerce(mem_t *, us), union_cls, &union_ops);
us->tft = tft;
us->data = data;
return obj;
@@ -6398,6 +6403,11 @@ void ffi_init(void)
ffi_type_s = intern(lit("ffi-type"), user_package);
ffi_call_desc_s = intern(lit("ffi-call-desc"), user_package);
ffi_closure_s = intern(lit("ffi-closure"), user_package);
+ ffi_type_cls = cobj_register(ffi_type_s);
+ ffi_call_desc_cls = cobj_register(ffi_call_desc_s);
+ ffi_closure_cls = cobj_register(ffi_closure_s);
+ carray_cls = cobj_register(carray_s);
+ union_cls = cobj_register(union_s);
reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile));
reg_fun(intern(lit("ffi-type-operator-p"), user_package), func_n1(ffi_type_operator_p));
reg_fun(intern(lit("ffi-type-p"), user_package), func_n1(ffi_type_p));
diff --git a/ffi.h b/ffi.h
index 7668d968..f8b1bc6d 100644
--- a/ffi.h
+++ b/ffi.h
@@ -71,6 +71,8 @@ extern val bool_s;
extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s;
+extern struct cobj_class *carray_cls;
+
val ffi_type_compile(val syntax);
val ffi_type_operator_p(val sym);
val ffi_type_p(val sym);
diff --git a/filter.c b/filter.c
index 348a697c..8e9d4b21 100644
--- a/filter.c
+++ b/filter.c
@@ -135,7 +135,7 @@ static val regex_from_trie(val trie)
return list(compound_s, a, rx, nao);
}
case COBJ:
- if (d->co.cls == hash_s)
+ if (d->co.cls == hash_cls)
return list(compound_s, a, regex_from_trie(d), nao);
/* fallthrough */
default:
@@ -143,7 +143,7 @@ static val regex_from_trie(val trie)
}
}
case COBJ:
- if (trie->co.cls == hash_s) {
+ if (trie->co.cls == hash_cls) {
if (zerop(hash_count(trie))) {
return tnil(!get_hash_userdata(trie));
} else {
diff --git a/gc.c b/gc.c
index d29c3596..446060ec 100644
--- a/gc.c
+++ b/gc.c
@@ -428,9 +428,11 @@ tail_call:
mark_obj(obj->ls.props->term);
mark_obj_tail(obj->ls.list);
case COBJ:
+ obj->co.ops->mark(obj);
+ mark_obj_tail(obj->co.cls->cls_sym);
case CPTR:
obj->co.ops->mark(obj);
- mark_obj_tail(obj->co.cls);
+ mark_obj_tail(obj->cp.cls);
case ENV:
mark_obj(obj->e.vbindings);
mark_obj(obj->e.fbindings);
diff --git a/hash.c b/hash.c
index 69b5eee0..f900806e 100644
--- a/hash.c
+++ b/hash.c
@@ -95,6 +95,7 @@ val weak_keys_k, weak_vals_k, userdata_k;
val equal_based_k, eql_based_k, eq_based_k;
val hash_seed_s;
+struct cobj_class *hash_cls, *hash_iter_cls;
/*
* Dynamic lists built up during gc.
*/
@@ -779,7 +780,7 @@ static val do_make_hash(val weak_keys, val weak_vals,
struct hash *h = coerce(struct hash *, chk_malloc(sizeof *h));
val mod = num_fast(256);
val table = vector(mod, nil);
- val hash = cobj(coerce(mem_t *, h), hash_s, &hash_ops);
+ val hash = cobj(coerce(mem_t *, h), hash_cls, &hash_ops);
h->seed = convert(u32_t, c_unum(default_arg(seed,
if3(hash_seed_s,
@@ -829,11 +830,11 @@ val make_eq_hash(val weak_keys, val weak_vals)
val make_similar_hash(val existing)
{
val self = lit("make-similar-hash");
- struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_s));
+ struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_cls));
struct hash *h = coerce(struct hash *, chk_malloc(sizeof *h));
val mod = num_fast(256);
val table = vector(mod, nil);
- val hash = cobj(coerce(mem_t *, h), hash_s, &hash_ops);
+ val hash = cobj(coerce(mem_t *, h), hash_cls, &hash_ops);
h->modulus = c_num(mod, self);
h->count = 0;
@@ -865,10 +866,10 @@ static val copy_hash_chain(val chain)
val copy_hash(val existing)
{
val self = lit("copy-hash");
- struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_s));
+ struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_cls));
struct hash *h = coerce(struct hash *, chk_malloc(sizeof *h));
val mod = num_fast(ex->modulus);
- val hash = cobj(coerce(mem_t *, h), hash_s, &hash_ops);
+ val hash = cobj(coerce(mem_t *, h), hash_cls, &hash_ops);
val table = vector(mod, nil);
cnum i;
@@ -891,7 +892,7 @@ val copy_hash(val existing)
val gethash_c(val self, val hash, val key, loc new_p)
{
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
int lim = hash_traversal_limit;
ucnum hv = h->hops->hash_fun(key, &lim, h->seed);
loc pchain = mkloc(h->table->v.vec[hv % h->modulus], h->table);
@@ -904,7 +905,7 @@ val gethash_c(val self, val hash, val key, loc new_p)
val gethash_e(val self, val hash, val key)
{
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
int lim = hash_traversal_limit;
ucnum hv = h->hops->hash_fun(key, &lim, h->seed);
val chain = h->table->v.vec[hv % h->modulus];
@@ -958,7 +959,7 @@ val pushhash(val hash, val key, val value)
val remhash(val hash, val key)
{
val self = lit("remhash");
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
int lim = hash_traversal_limit;
ucnum hv = h->hops->hash_fun(key, &lim, h->seed);
val *pchain = &h->table->v.vec[hv % h->modulus];
@@ -982,7 +983,7 @@ val remhash(val hash, val key)
val clearhash(val hash)
{
val self = lit("clearhash");
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
val mod = num_fast(256);
val table = vector(mod, nil);
cnum oldcount = h->count;
@@ -996,7 +997,7 @@ val clearhash(val hash)
val hash_count(val hash)
{
val self = lit("hash-count");
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
return num_fast(h->count);
}
@@ -1009,14 +1010,14 @@ val us_hash_count(val hash)
val get_hash_userdata(val hash)
{
val self = lit("get-hash-userdata");
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
return h->userdata;
}
val set_hash_userdata(val hash, val data)
{
val self = lit("set-hash-userdata");
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
val olddata = h->userdata;
set(mkloc(h->userdata, hash), data);
return olddata;
@@ -1024,7 +1025,7 @@ val set_hash_userdata(val hash, val data)
val hashp(val obj)
{
- return cobjclassp(obj, hash_s);
+ return cobjclassp(obj, hash_cls);
}
static void hash_iter_mark(val hash_iter)
@@ -1045,7 +1046,7 @@ static struct cobj_ops hash_iter_ops = cobj_ops_init(eq,
void hash_iter_init(struct hash_iter *hi, val hash, val self)
{
- struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
+ struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
hi->next = 0;
hi->chain = -1;
hi->cons = nil;
@@ -1116,7 +1117,7 @@ val hash_begin(val hash)
val hi_obj;
struct hash_iter *hi = coerce(struct hash_iter *, chk_malloc(sizeof *hi));
hash_iter_init(hi, hash, self);
- hi_obj = cobj(coerce(mem_t *, hi), hash_iter_s, &hash_iter_ops);
+ hi_obj = cobj(coerce(mem_t *, hi), hash_iter_cls, &hash_iter_ops);
gc_hint(hash);
return hi_obj;
}
@@ -1125,7 +1126,7 @@ val hash_next(val iter)
{
val self = lit("hash-next");
struct hash_iter *hi = coerce(struct hash_iter *,
- cobj_handle(self, iter, hash_iter_s));
+ cobj_handle(self, iter, hash_iter_cls));
return hash_iter_next_impl(hi, iter);
}
@@ -1134,7 +1135,7 @@ val hash_peek(val iter)
{
val self = lit("hash-peek");
struct hash_iter *hi = coerce(struct hash_iter *,
- cobj_handle(self, iter, hash_iter_s));
+ cobj_handle(self, iter, hash_iter_cls));
return hash_iter_peek(hi);
}
@@ -1142,7 +1143,7 @@ val hash_reset(val iter, val hash)
{
val self = lit("hash-reset");
struct hash_iter *hi = coerce(struct hash_iter *,
- cobj_handle(self, iter, hash_iter_s));
+ cobj_handle(self, iter, hash_iter_cls));
if (hi->hash) {
struct hash *h = coerce(struct hash *, hash->co.handle);
@@ -1597,8 +1598,8 @@ val hash_alist(val hash)
val hash_uni(val hash1, val hash2, val joinfun, val map1fun, val map2fun)
{
val self = lit("hash-uni");
- struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
- struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
+ struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_cls));
+ struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_cls));
if (h1->hops != h2->hops)
uw_throwf(error_s, lit("~a: ~s and ~s are incompatible hashes"),
@@ -1645,8 +1646,8 @@ val hash_uni(val hash1, val hash2, val joinfun, val map1fun, val map2fun)
val hash_diff(val hash1, val hash2)
{
val self = lit("hash-diff");
- struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
- struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
+ struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_cls));
+ struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_cls));
if (h1->hops != h2->hops)
uw_throwf(error_s, lit("~a: ~s and ~a are incompatible hashes"),
@@ -1670,8 +1671,8 @@ val hash_diff(val hash1, val hash2)
val hash_symdiff(val hash1, val hash2)
{
val self = lit("hash-symdiff");
- struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
- struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
+ struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_cls));
+ struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_cls));
if (h1->hops != h2->hops)
uw_throwf(error_s, lit("~a: ~s and ~a are incompatible hashes"),
@@ -1703,8 +1704,8 @@ val hash_symdiff(val hash1, val hash2)
val hash_isec(val hash1, val hash2, val joinfun)
{
val self = lit("hash-isec");
- struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
- struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
+ struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_cls));
+ struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_cls));
if (h1->hops != h2->hops)
uw_throwf(error_s, lit("~a: ~s and ~s are incompatible hashes"),
@@ -1889,6 +1890,12 @@ static val gen_hash_seed(void)
return unum(sec ^ (usec << 12) ^ pid);
}
+void hash_early_init(void)
+{
+ hash_cls = cobj_register(nil);
+ hash_iter_cls = cobj_register(nil);
+}
+
void hash_init(void)
{
weak_keys_k = intern(lit("weak-keys"), keyword_package);
@@ -1900,6 +1907,9 @@ void hash_init(void)
hash_seed_s = intern(lit("*hash-seed*"), user_package);
val ghu = func_n1(get_hash_userdata);
+ hash_cls->cls_sym = hash_s;
+ hash_iter_cls->cls_sym = hash_iter_s;
+
reg_var(hash_seed_s, zero);
reg_fun(intern(lit("make-hash"), user_package), func_n4o(make_seeded_hash, 3));
diff --git a/hash.h b/hash.h
index 542b3e1a..8792b609 100644
--- a/hash.h
+++ b/hash.h
@@ -35,6 +35,8 @@ struct hash_iter {
extern val weak_keys_k, weak_vals_k, userdata_k;
extern val equal_based_k, eql_based_k, eq_based_k;
+extern struct cobj_class *hash_cls;
+
ucnum equal_hash(val obj, int *count, ucnum);
val make_seeded_hash(val weak_keys, val weak_vals, val equal_based, val seed);
val make_hash(val weak_keys, val weak_vals, val equal_based);
@@ -99,4 +101,5 @@ INLINE loc gethash_l(val self, val hash, val key, loc new_p)
return cdr_l(gethash_c(self, hash, key, new_p));
}
+void hash_early_init(void);
void hash_init(void);
diff --git a/lib.c b/lib.c
index 588e5dac..d90ab1de 100644
--- a/lib.c
+++ b/lib.c
@@ -81,6 +81,7 @@
#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))
+#define nelem(array) (sizeof (array) / sizeof (array)[0])
#if !HAVE_POSIX_SIGS
int async_sig_enabled = 0;
@@ -135,6 +136,12 @@ val prog_string;
char dec_point = '.';
#endif
+static struct cobj_class cobj_class[64], *cobj_ptr = cobj_class;
+
+static val cobj_hash;
+
+struct cobj_class *seq_iter_cls;
+
static val recycled_conses;
const seq_kind_t seq_kind_tab[MAXTYPE+1] = {
@@ -202,6 +209,19 @@ static val code2type(int code)
return nil;
}
+val builtin_type_p(val sym)
+{
+ type_t i;
+
+ for (i = NIL; i <= MAXTYPE; i++) {
+ val type = code2type(i);
+ if (subtypep(type, sym))
+ return t;
+ }
+
+ return nil;
+}
+
val typeof(val obj)
{
switch (tag(obj)) {
@@ -216,7 +236,10 @@ val typeof(val obj)
int typecode = type(obj);
if (typecode == COBJ) {
- return obj->co.cls;
+ if (obj->co.cls == struct_cls)
+ return struct_type_name(obj);
+ else
+ return obj->co.cls->cls_sym;
} else {
val typesym = code2type(typecode);
if (!typesym)
@@ -231,9 +254,9 @@ val typeof(val obj)
val subtypep(val sub, val sup)
{
- if (sub == nil || sup == t) {
+ if (sub == sup) {
return t;
- } else if (sub == sup) {
+ } else if (sub == nil || sup == t) {
return t;
} else if (sup == atom_s) {
return tnil(sub != cons_s && sub != lcons_s);
@@ -294,7 +317,7 @@ seq_info_t seq_info(val obj)
ret.kind = seq_kind_tab[to];
return ret;
} else {
- val cls = obj->co.cls;
+ val cls = obj->co.cls->cls_sym;
if (cls == hash_s) {
ret.kind = SEQ_HASHLIKE;
@@ -858,7 +881,7 @@ void seq_iter_init_with_info(val self, seq_iter_t *it,
}
}
}
- if (it->inf.obj->co.cls == tree_iter_s)
+ if (it->inf.obj->co.cls == tree_iter_cls)
{
it->ui.iter = if3(support_rewind,
copy_tree_iter(it->inf.obj),
@@ -980,7 +1003,7 @@ val seq_begin(val obj)
val self = lit("seq-begin");
val si_obj;
struct seq_iter *si = coerce(struct seq_iter *, chk_calloc(1, sizeof *si));
- si_obj = cobj(coerce(mem_t *, si), seq_iter_s, &seq_iter_ops);
+ si_obj = cobj(coerce(mem_t *, si), seq_iter_cls, &seq_iter_ops);
seq_iter_init(self, si, obj);
return si_obj;
}
@@ -989,7 +1012,7 @@ val seq_next(val iter, val end_val)
{
val self = lit("seq-next");
struct seq_iter *si = coerce(struct seq_iter *,
- cobj_handle(self, iter, seq_iter_s));
+ cobj_handle(self, iter, seq_iter_cls));
val item = nil;
return if3(seq_get(si, &item), item, end_val);
}
@@ -998,7 +1021,7 @@ val seq_reset(val iter, val obj)
{
val self = lit("seq-reset");
struct seq_iter *si = coerce(struct seq_iter *,
- cobj_handle(self, iter, seq_iter_s));
+ cobj_handle(self, iter, seq_iter_cls));
seq_iter_init(self, si, obj);
return iter;
}
@@ -1030,7 +1053,7 @@ val iter_begin(val obj)
val si_obj;
struct seq_iter *si = coerce(struct seq_iter *,
chk_calloc(1, sizeof *si));
- si_obj = cobj(coerce(mem_t *, si), seq_iter_s, &seq_iter_ops);
+ si_obj = cobj(coerce(mem_t *, si), seq_iter_cls, &seq_iter_ops);
seq_iter_init_with_info(self, si, sinf, 0);
return si_obj;
}
@@ -1049,7 +1072,7 @@ val iter_more(val iter)
case BGNUM:
return t;
case COBJ:
- if (iter->co.cls == seq_iter_s)
+ if (iter->co.cls == seq_iter_cls)
{
struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle);
val item = nil;
@@ -1076,7 +1099,7 @@ val iter_item(val iter)
case BGNUM:
return iter;
case COBJ:
- if (iter->co.cls == seq_iter_s)
+ if (iter->co.cls == seq_iter_cls)
{
struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle);
val item = nil;
@@ -1113,7 +1136,7 @@ val iter_step(val iter)
return next;
}
case COBJ:
- if (iter->co.cls == seq_iter_s)
+ if (iter->co.cls == seq_iter_cls)
{
struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle);
val item = nil;
@@ -1151,7 +1174,7 @@ val iter_reset(val iter, val obj)
case BGNUM:
return obj;
case COBJ:
- if (iter->co.cls == seq_iter_s)
+ if (iter->co.cls == seq_iter_cls)
{
struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle);
seq_iter_init_with_info(self, si, sinf, 0);
@@ -1179,10 +1202,10 @@ val throw_mismatch(val self, val obj, type_t t)
type_mismatch(lit("~a: ~s is not of type ~s"), self, obj, code2type(t), nao);
}
-val class_check(val self, val cobj, val class_sym)
+val class_check(val self, val cobj, struct cobj_class *cls)
{
- type_assert (cobjclassp(cobj, class_sym),
- (lit("~a: ~s is not of type ~s"), self, cobj, class_sym, nao));
+ type_assert (cobjclassp(cobj, cls),
+ (lit("~a: ~s is not of type ~s"), self, cobj, cls->cls_sym, nao));
return t;
}
@@ -1751,7 +1774,7 @@ val make_like(val list, val thatobj)
if (from_list_meth)
return funcall1(from_list_meth, list);
}
- if (thatobj->co.cls == carray_s)
+ if (thatobj->co.cls == carray_cls)
return carray_list(list, carray_type(thatobj), nil);
break;
case NIL:
@@ -1905,7 +1928,7 @@ again:
replace_buf(tailobj, items, t, t);
return ptail;
case COBJ:
- if (tailobj->co.cls == carray_s) {
+ if (tailobj->co.cls == carray_cls) {
carray_replace(tailobj, items, t, t);
return ptail;
}
@@ -7528,7 +7551,7 @@ INLINE val do_generic_funcall(val fun, struct args *args_in)
}
break;
case COBJ:
- if (fun->co.cls == hash_s) {
+ if (fun->co.cls == hash_cls) {
bug_unless (args->argc >= ARGS_MIN);
args_normalize_least(args, 3);
@@ -7542,7 +7565,7 @@ INLINE val do_generic_funcall(val fun, struct args *args_in)
default:
callerror(fun, lit("too many arguments"));
}
- } else if (fun->co.cls == regex_s) {
+ } else if (fun->co.cls == regex_cls) {
bug_unless (args->argc >= ARGS_MIN);
args_normalize_least(args, 3);
@@ -7558,13 +7581,13 @@ INLINE val do_generic_funcall(val fun, struct args *args_in)
default:
callerror(fun, lit("too many arguments"));
}
- } else if (fun->co.cls == vm_desc_s) {
+ } else if (fun->co.cls == vm_desc_cls) {
if (args->fill || args->list)
callerror(fun, lit("too many arguments"));
return vm_execute_toplevel(fun);
- } else if (fun->co.cls == carray_s) {
+ } else if (fun->co.cls == carray_cls) {
goto carray;
- } else if (fun->co.cls == tree_s) {
+ } else if (fun->co.cls == tree_cls) {
switch (args->fill) {
case 0:
callerror(fun, lit("missing required arguments"));
@@ -9141,14 +9164,44 @@ val lazy_str_get_trailing_list(val lstr, val index)
}
}
-val cobj(mem_t *handle, val cls_sym, struct cobj_ops *ops)
+struct cobj_class *cobj_register(val cls_sym)
{
- val obj = make_obj();
- obj->co.type = COBJ;
- obj->co.handle = handle;
- obj->co.ops = ops;
- obj->co.cls = cls_sym;
- return obj;
+ if ((size_t) (cobj_ptr - cobj_class) >= nelem(cobj_class))
+ internal_error("cobj array too small");
+ cobj_ptr->cls_sym = cls_sym;
+ return cobj_ptr++;
+}
+
+struct cobj_class *cobj_register_super(val cls_sym, struct cobj_class *super)
+{
+ struct cobj_class *cls = cobj_register(cls_sym);
+ cls->super = super;
+ return cls;
+}
+
+static void cobj_populate_hash(void)
+{
+ struct cobj_class *ptr;
+ for (ptr = cobj_class; ptr < cobj_ptr; ptr++)
+ sethash(cobj_hash, ptr->cls_sym, ptr->cls_sym);
+}
+
+int cobj_class_exists(val cls_sym)
+{
+ return gethash(cobj_hash, cls_sym) != 0;
+}
+
+val cobj(mem_t *handle, struct cobj_class *cls, struct cobj_ops *ops)
+{
+ if (cls != 0) {
+ val obj = make_obj();
+ obj->co.type = COBJ;
+ obj->co.handle = handle;
+ obj->co.ops = ops;
+ obj->co.cls = cls;
+ return obj;
+ }
+ internal_error("cobj creation with null class pointer");
}
val cobjp(val obj)
@@ -9156,28 +9209,33 @@ val cobjp(val obj)
return type(obj) == COBJ ? t : nil;
}
-val cobjclassp(val obj, val cls_sym)
+val cobjclassp(val obj, struct cobj_class *cls)
{
- return tnil(is_ptr(obj) && obj->t.type == COBJ &&
- (obj->co.cls == cls_sym || subtypep(obj->co.cls, cls_sym)));
+ if (is_ptr(obj) && obj->t.type == COBJ) {
+ struct cobj_class *pcls;
+ for (pcls = obj->co.cls; pcls != 0; pcls = pcls->super)
+ if (pcls == cls)
+ return t;
+ }
+ return nil;
}
-mem_t *cobj_handle(val self, val cobj, val cls_sym)
+mem_t *cobj_handle(val self, val cobj, struct cobj_class *cls)
{
- class_check(self, cobj, cls_sym);
+ class_check(self, cobj, cls);
return cobj->co.handle;
}
-struct cobj_ops *cobj_ops(val self, val cobj, val cls_sym)
+struct cobj_ops *cobj_ops(val self, val cobj, struct cobj_class *cls)
{
- class_check(self, cobj, cls_sym);
+ class_check(self, cobj, cls);
return cobj->co.ops;
}
void cobj_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
{
put_string(lit("#<"), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->co.cls->cls_sym, out, pretty, ctx);
format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao);
}
@@ -9186,7 +9244,7 @@ void cptr_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
put_string(lit("#<cptr"), out);
if (obj->co.cls) {
put_char(chr(' '), out);
- obj_print_impl(obj->co.cls, out, pretty, ctx);
+ obj_print_impl(obj->cp.cls, out, pretty, ctx);
}
format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao);
}
@@ -9212,10 +9270,10 @@ static struct cobj_ops cptr_ops = cobj_ops_init(cobj_equal_handle_op,
val cptr_typed(mem_t *handle, val type_sym, struct cobj_ops *ops)
{
val obj = make_obj();
- obj->co.type = CPTR;
- obj->co.handle = handle;
- obj->co.ops = (ops != 0 ? ops : &cptr_ops);
- obj->co.cls = type_sym;
+ obj->cp.type = CPTR;
+ obj->cp.handle = handle;
+ obj->cp.ops = (ops != 0 ? ops : &cptr_ops);
+ obj->cp.cls = type_sym;
return obj;
}
@@ -9232,7 +9290,7 @@ val cptrp(val obj)
val cptr_type(val cptr)
{
(void) cptr_handle(cptr, nil, lit("cptr-type"));
- return cptr->co.cls;
+ return cptr->cp.cls;
}
val cptr_size_hint(val cptr, val size)
@@ -9294,9 +9352,9 @@ mem_t *cptr_handle(val cptr, val type_sym, val self)
if (type(cptr) != CPTR) {
uw_throwf(error_s, lit("~a: ~s isn't a cptr"), self, cptr, nao);
} else {
- mem_t *ptr = cptr->co.handle;
+ mem_t *ptr = cptr->cp.handle;
- if (type_sym && cptr->co.cls != type_sym && (ptr != 0 || cptr->co.cls))
+ if (type_sym && cptr->cp.cls != type_sym && (ptr != 0 || cptr->cp.cls))
uw_throwf(error_s, lit("~a: cptr ~s isn't of type ~s"), self, cptr,
type_sym, nao);
@@ -9312,7 +9370,7 @@ mem_t *cptr_get(val cptr)
mem_t **cptr_addr_of(val cptr, val type_sym, val self)
{
(void) cptr_handle(cptr, type_sym, self);
- return &cptr->co.handle;
+ return &cptr->cp.handle;
}
val assoc(val key, val list)
@@ -11616,15 +11674,15 @@ val copy(val seq)
case TNOD:
return copy_tnode(seq);
case COBJ:
- if (seq->co.cls == hash_s)
+ if (seq->co.cls == hash_cls)
return copy_hash(seq);
- if (seq->co.cls == random_state_s)
+ if (seq->co.cls == random_state_cls)
return make_random_state(seq, nil);
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return copy_carray(seq);
- if (seq->co.cls == tree_s)
+ if (seq->co.cls == tree_cls)
return copy_search_tree(seq);
- if (seq->co.cls == tree_iter_s)
+ if (seq->co.cls == tree_iter_cls)
return copy_tree_iter(seq);
if (obj_struct_p(seq))
return copy_struct(seq);
@@ -11654,9 +11712,9 @@ val length(val seq)
case BUF:
return length_buf(seq);
case COBJ:
- if (seq->co.cls == hash_s)
+ if (seq->co.cls == hash_cls)
return hash_count(seq);
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return length_carray(seq);
if (obj_struct_p(seq)) {
val length_meth = get_special_slot(seq, length_m);
@@ -11692,9 +11750,9 @@ val sub(val seq, val from, val to)
case BUF:
return sub_buf(seq, from, to);
case COBJ:
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return carray_sub(seq, from, to);
- if (seq->co.cls == tree_s)
+ if (seq->co.cls == tree_cls)
return sub_tree(seq, from, to);
if (obj_struct_p(seq)) {
val lambda_meth = get_special_slot(seq, lambda_m);
@@ -11715,11 +11773,11 @@ val ref(val seq, val ind)
case NIL:
return nil;
case COBJ:
- if (seq->co.cls == hash_s)
+ if (seq->co.cls == hash_cls)
return gethash(seq, ind);
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return carray_ref(seq, ind);
- if (seq->co.cls == tree_s)
+ if (seq->co.cls == tree_cls)
return tree_lookup(seq, ind);
if (obj_struct_p(seq)) {
val lambda_meth = get_special_slot(seq, lambda_m);
@@ -11767,9 +11825,9 @@ val refset(val seq, val ind, val newval)
case BUF:
return buf_put_uchar(seq, ind, newval);
case COBJ:
- if (seq->co.cls == hash_s)
+ if (seq->co.cls == hash_cls)
return sethash(seq, ind, newval);
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return carray_refset(seq, ind, newval);
if (obj_struct_p(seq)) {
{
@@ -11812,7 +11870,7 @@ val replace(val seq, val items, val from, val to)
case BUF:
return replace_buf(seq, items, from, to);
case COBJ:
- if (seq->co.cls == carray_s)
+ if (seq->co.cls == carray_cls)
return carray_replace(seq, items, from, to);
if (obj_struct_p(seq))
return replace_obj(seq, items, from, to);
@@ -11829,7 +11887,7 @@ val dwim_set(val place_p, val seq, varg vargs)
switch (type(seq)) {
case COBJ:
if (type(seq) == COBJ) {
- if (seq->co.cls == hash_s) {
+ if (seq->co.cls == hash_cls) {
args_normalize_least(vargs, 3);
switch (vargs->fill) {
@@ -11913,7 +11971,7 @@ val dwim_del(val place_p, val seq, val ind_range)
nao);
break;
case COBJ:
- if (seq->co.cls == hash_s) {
+ if (seq->co.cls == hash_cls) {
(void) remhash(seq, ind_range);
return seq;
}
@@ -12439,7 +12497,7 @@ static void obj_init(void)
&null_list, &equal_f, &eq_f, &eql_f,
&car_f, &cdr_f, &null_f, &list_f,
&identity_f, &identity_star_f, &less_f, &greater_f,
- &prog_string,
+ &prog_string, &cobj_hash,
convert(val *, 0));
nil_string = lit("nil");
@@ -12593,6 +12651,8 @@ static void obj_init(void)
wrap_k = intern(lit("wrap"), keyword_package);
reflect_k = intern(lit("reflect"), keyword_package);
+ seq_iter_cls = cobj_register(seq_iter_s);
+
equal_f = func_n2(equal);
eq_f = func_n2(eq);
eql_f = func_n2(eql);
@@ -12605,6 +12665,10 @@ static void obj_init(void)
less_f = func_n2(less);
greater_f = func_n2(greater);
prog_string = string(progname);
+
+ cobj_hash = make_hash(nil, nil, nil);
+
+ cobj_populate_hash();
}
static val simple_qref_args_p(val args, val pos)
@@ -13696,7 +13760,7 @@ val obj_print(val obj, val out, val pretty)
}
} else {
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, out, stream_s));
+ cobj_handle(self, out, stream_cls));
ctx = &ctx_struct;
ctx->strm = s;
ctx->counter = zero;
@@ -13809,6 +13873,7 @@ void init(val *stack_bottom)
t = one;
gc_init(stack_bottom);
+ hash_early_init();
#if CONFIG_LOCALE_TOLERANCE
locale_init();
#endif
diff --git a/lib.h b/lib.h
index 6a6c0841..077f5d98 100644
--- a/lib.h
+++ b/lib.h
@@ -238,10 +238,22 @@ struct lazy_string {
struct lazy_string_props *props;
};
+struct cobj_class {
+ val cls_sym;
+ struct cobj_class *super;
+};
+
struct cobj {
obj_common;
mem_t *handle;
struct cobj_ops *ops;
+ struct cobj_class *cls;
+};
+
+struct cptr {
+ obj_common;
+ mem_t *handle;
+ struct cobj_ops *ops;
val cls;
};
@@ -330,6 +342,7 @@ union obj {
struct lazy_cons lc;
struct lazy_string ls;
struct cobj co;
+ struct cptr cp;
struct env e;
struct bignum bn;
struct flonum fl;
@@ -550,6 +563,7 @@ extern alloc_bytes_t malloc_bytes;
extern alloc_bytes_t gc_bytes;
val identity(val obj);
+val builtin_type_p(val sym);
val typeof(val obj);
val subtypep(val sub, val sup);
val typep(val obj, val type);
@@ -577,7 +591,6 @@ INLINE val type_check(val self, val obj, type_t typecode)
throw_mismatch(self, obj, typecode);
return t;
}
-val class_check(val self, val cobj, val class_sym);
val car(val cons);
val cdr(val cons);
INLINE val us_car(val cons) { return cons->c.car; }
@@ -1085,11 +1098,15 @@ val length_str_gt(val str, val len);
val length_str_ge(val str, val len);
val length_str_lt(val str, val len);
val length_str_le(val str, val len);
-val cobj(mem_t *handle, val cls_sym, struct cobj_ops *ops);
+struct cobj_class *cobj_register(val cls_sym);
+struct cobj_class *cobj_register_super(val cls_sym, struct cobj_class *super);
+int cobj_class_exists(val cls_sym);
+val cobj(mem_t *handle, struct cobj_class *cls, struct cobj_ops *ops);
val cobjp(val obj);
-val cobjclassp(val obj, val cls_sym);
-mem_t *cobj_handle(val self, val cobj, val cls_sym);
-struct cobj_ops *cobj_ops(val self, val cobj, val cls_sym);
+val cobjclassp(val obj, struct cobj_class *);
+val class_check(val self, val cobj, struct cobj_class *cls);
+mem_t *cobj_handle(val self, val cobj, struct cobj_class *cls);
+struct cobj_ops *cobj_ops(val self, val cobj, struct cobj_class *cls);
val cptr(mem_t *ptr);
val cptr_typed(mem_t *handle, val type_sym, struct cobj_ops *ops);
val cptrp(val obj);
diff --git a/match.c b/match.c
index a7a22f4b..a8e12494 100644
--- a/match.c
+++ b/match.c
@@ -1626,7 +1626,7 @@ static val do_match_line(match_line_ctx *c)
break;
}
case COBJ:
- if (elem->co.cls == regex_s) {
+ if (elem->co.cls == regex_cls) {
val past = match_regex(c->dataline, elem, c->pos);
if (nilp(past)) {
LOG_MISMATCH("regex");
diff --git a/parser.c b/parser.c
index 331e6b7f..0deb3867 100644
--- a/parser.c
+++ b/parser.c
@@ -75,6 +75,9 @@ val listener_pprint_s, listener_greedy_eval_s;
val rec_source_loc_s, read_unknown_structs_s;
val json_s;
val intr_s;
+
+struct cobj_class *parser_cls;
+
static lino_t *lino_ctx;
static int repl_level = 0;
@@ -172,7 +175,7 @@ val parser(val stream, val name, val lineno)
parser_t *p = coerce(parser_t *, chk_malloc(sizeof *p));
val parser;
parser_common_init(p);
- parser = cobj(coerce(mem_t *, p), parser_s, &parser_ops);
+ parser = cobj(coerce(mem_t *, p), parser_cls, &parser_ops);
p->parser = parser;
p->lineno = c_num(default_arg(lineno, one), self);
p->name = name;
@@ -183,7 +186,7 @@ val parser(val stream, val name, val lineno)
parser_t *parser_get_impl(val self, val parser)
{
- return coerce(parser_t *, cobj_handle(self, parser, parser_s));
+ return coerce(parser_t *, cobj_handle(self, parser, parser_cls));
}
val ensure_parser(val stream, val name)
@@ -655,7 +658,7 @@ static val lisp_parse_impl(val self, enum prime_parser prime,
error_stream = default_arg_strict(error_stream, std_null);
error_stream = if3(error_stream == t, std_output, error_stream);
- class_check (self, error_stream, stream_s);
+ class_check (self, error_stream, stream_cls);
if (lineno && !missingp(lineno))
pi->lineno = c_num(lineno, self);
@@ -830,7 +833,7 @@ val txr_parse(val source_in, val error_stream,
dyn_env = make_env(nil, nil, dyn_env);
error_stream = default_arg_strict(error_stream, std_null);
error_stream = if3(error_stream == t, std_output, error_stream);
- class_check (self, error_stream, stream_s);
+ class_check (self, error_stream, stream_cls);
parse_once(self, input_stream, name);
@@ -1675,7 +1678,7 @@ val repl(val bindings, val in_stream, val out_stream, val env)
val parser_errors(val parser)
{
val self = lit("parser-errors");
- parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
+ parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_cls));
return num(p->errors);
}
@@ -1685,7 +1688,7 @@ val parse_errors(val stream)
val errors = nil;
val parser = gethash(stream_parser_hash, stream);
if (parser) {
- parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
+ parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_cls));
if (p->errors)
errors = num(p->errors);
}
@@ -1871,11 +1874,17 @@ void parse_init(void)
read_unknown_structs_s = intern(lit("*read-unknown-structs*"), user_package);
json_s = intern(lit("json"), user_package);
unique_s = gensym(nil);
+
+ parser_cls = cobj_register(parser_s);
+
protect(&stream_parser_hash, &unique_s, &catch_all, convert(val *, 0));
stream_parser_hash = make_hash(t, nil, nil);
catch_all = cons(t, nil);
+
parser_l_init();
+
lino_init(&linenoise_txr_binding);
+
reg_var(listener_hist_len_s, num_fast(500));
reg_var(listener_multi_line_p_s, t);
reg_var(listener_sel_inclusive_p_s, nil);
diff --git a/parser.h b/parser.h
index 81dcc223..3d682daa 100644
--- a/parser.h
+++ b/parser.h
@@ -77,6 +77,9 @@ extern val form_to_ln_hash;
extern val parser_s, unique_s, circref_s;
extern val rec_source_loc_s, read_unknown_structs_s;
extern val json_s;
+
+extern struct cobj_class *parser_cls;
+
void yydebug_onoff(int);
void yyerror(scanner_t *scanner, parser_t *, const char *s);
void yyerr(scanner_t *scanner, const char *s);
diff --git a/rand.c b/rand.c
index 92f49917..cad1fd3e 100644
--- a/rand.c
+++ b/rand.c
@@ -62,6 +62,8 @@ struct rand_state {
val random_state_s, random_state_var_s, random_warmup_s;
+struct cobj_class *random_state_cls;
+
static struct cobj_ops random_state_ops = cobj_ops_init(eq,
cobj_print_op,
cobj_destroy_free_op,
@@ -79,12 +81,12 @@ static rand32_t rand_tab[16] = {
static val make_state(void)
{
struct rand_state *r = coerce(struct rand_state *, chk_malloc(sizeof *r));
- return cobj(coerce(mem_t *, r), random_state_s, &random_state_ops);
+ return cobj(coerce(mem_t *, r), random_state_cls, &random_state_ops);
}
val random_state_p(val obj)
{
- return cobjclassp(obj, random_state_s);
+ return cobjclassp(obj, random_state_cls);
}
INLINE rand32_t *rstate(struct rand_state *r, int offs)
@@ -138,7 +140,7 @@ val make_random_state(val seed, val warmup)
val rs = make_state();
int i = 0;
struct rand_state *r = coerce(struct rand_state *,
- cobj_handle(self, rs, random_state_s));
+ cobj_handle(self, rs, random_state_cls));
seed = default_null_arg(seed);
warmup = default_null_arg(warmup);
@@ -177,7 +179,7 @@ val make_random_state(val seed, val warmup)
#endif
} else if (random_state_p(seed)) {
struct rand_state *rseed = coerce(struct rand_state *,
- cobj_handle(self, seed, random_state_s));
+ cobj_handle(self, seed, random_state_cls));
*r = *rseed;
return rs;
} else if (vectorp(seed)) {
@@ -220,7 +222,7 @@ val random_state_get_vec(val state)
struct rand_state *r = coerce(struct rand_state *,
cobj_handle(self,
default_arg(state, random_state),
- random_state_s));
+ random_state_cls));
int i;
val vec = vector(num_fast(17), nil);
@@ -238,7 +240,7 @@ val random_fixnum(val state)
struct rand_state *r = coerce(struct rand_state *,
cobj_handle(self,
default_arg(state, random_state),
- random_state_s));
+ random_state_cls));
return num(rand32(r) & NUM_MAX);
}
@@ -248,7 +250,7 @@ static val random_float(val state)
struct rand_state *r = coerce(struct rand_state *,
cobj_handle(self,
default_arg(state, random_state),
- random_state_s));
+ random_state_cls));
union hack {
volatile double d;
struct {
@@ -274,7 +276,7 @@ val random(val state, val modulus)
{
val self = lit("random");
struct rand_state *r = coerce(struct rand_state *,
- cobj_handle(self, state, random_state_s));
+ cobj_handle(self, state, random_state_cls));
mp_int *m;
if (bignump(modulus) && !mp_isneg(m = mp(modulus))) {
@@ -383,6 +385,8 @@ void rand_init(void)
random_state_s = intern(lit("random-state"), user_package);
random_warmup_s = intern(lit("*random-warmup*"), user_package);
+ random_state_cls = cobj_register(random_state_s);
+
reg_var(random_state_var_s, make_random_state(num_fast(42), num_fast(8)));
reg_var(random_warmup_s, num_fast(8));
diff --git a/rand.h b/rand.h
index d1b253c6..dafc6eb1 100644
--- a/rand.h
+++ b/rand.h
@@ -27,6 +27,7 @@
#define random_state (deref(lookup_var_l(nil, random_state_var_s)))
extern val random_state_s, random_state_var_s;
+extern struct cobj_class *random_state_cls;
val make_random_state(val seed, val warmup);
val random_state_get_vec(val state);
val random_state_p(val obj);
diff --git a/regex.c b/regex.c
index 86857f01..e9567221 100644
--- a/regex.c
+++ b/regex.c
@@ -256,6 +256,9 @@ union regex_machine {
int opt_derivative_regex = 0;
+struct cobj_class *regex_cls;
+static struct cobj_class *chset_cls;
+
wchar_t spaces[] = {
0x0009, 0x000a, 0x000b, 0x000c, 0x000d, 0x0020, 0x00a0, 0x1680, 0x180e,
0x2000, 0x2001, 0x2002, 0x2003, 0x2004, 0x2005, 0x2006, 0x2007, 0x2008,
@@ -1609,17 +1612,17 @@ static val reg_nary_to_bin(val regex)
static val reg_compile_csets(val exp)
{
if (exp == space_k) {
- return cobj(coerce(mem_t *, space_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, space_cs), chset_cls, &char_set_obj_ops);
} else if (exp == digit_k) {
- return cobj(coerce(mem_t *, digit_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, digit_cs), chset_cls, &char_set_obj_ops);
} else if (exp == word_char_k) {
- return cobj(coerce(mem_t *, word_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, word_cs), chset_cls, &char_set_obj_ops);
} else if (exp == cspace_k) {
- return cobj(coerce(mem_t *, cspace_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, cspace_cs), chset_cls, &char_set_obj_ops);
} else if (exp == cdigit_k) {
- return cobj(coerce(mem_t *, cdigit_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, cdigit_cs), chset_cls, &char_set_obj_ops);
} else if (exp == cword_char_k) {
- return cobj(coerce(mem_t *, cword_cs), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, cword_cs), chset_cls, &char_set_obj_ops);
} else if (symbolp(exp) || chrp(exp)) {
return exp;
} else if (stringp(exp)) {
@@ -1630,7 +1633,7 @@ static val reg_compile_csets(val exp)
if (sym == set_s || sym == cset_s) {
char_set_t *set = char_set_compile(args, eq(sym, cset_s));
- return cobj(coerce(mem_t *, set), chset_s, &char_set_obj_ops);
+ return cobj(coerce(mem_t *, set), chset_cls, &char_set_obj_ops);
} else if (sym == compound_s || sym == zeroplus_s || sym == oneplus_s ||
sym == optional_s || sym == compl_s || sym == nongreedy_s ||
sym == or_s || sym == and_s)
@@ -1841,7 +1844,7 @@ static val reg_derivative(val exp, val ch)
return t;
} else if (chrp(exp)) {
return null(eq(exp, ch));
- } else if (cobjclassp(exp, chset_s)) {
+ } else if (cobjclassp(exp, chset_cls)) {
char_set_t *set = coerce(char_set_t *, exp->co.handle);
return if3(char_set_contains(set, c_chr(ch)), nil, t);
} else if (exp == wild_s) {
@@ -2234,7 +2237,7 @@ val regex_compile(val regex_sexp, val error_stream)
regex->kind = REGEX_DV;
regex->nstates = 0;
regex->source = nil;
- ret = cobj(coerce(mem_t *, regex), regex_s, &regex_obj_ops);
+ ret = cobj(coerce(mem_t *, regex), regex_cls, &regex_obj_ops);
regex->r.dv = dv;
regex->source = regex_source;
return ret;
@@ -2243,7 +2246,7 @@ val regex_compile(val regex_sexp, val error_stream)
val ret;
regex->kind = REGEX_NFA;
regex->source = nil;
- ret = cobj(coerce(mem_t *, regex), regex_s, &regex_obj_ops);
+ ret = cobj(coerce(mem_t *, regex), regex_cls, &regex_obj_ops);
regex->r.nfa = nfa_optimize(nfa_compile_regex(regex_sexp));
regex->nstates = nfa_count_states(regex->r.nfa.start);
regex->source = regex_source;
@@ -2253,14 +2256,14 @@ val regex_compile(val regex_sexp, val error_stream)
val regexp(val obj)
{
- return cobjclassp(obj, regex_s);
+ return cobjclassp(obj, regex_cls);
}
val regex_source(val compiled_regex)
{
val self = lit("regex-source");
regex_t *regex = coerce(regex_t *,
- cobj_handle(self, compiled_regex, regex_s));
+ cobj_handle(self, compiled_regex, regex_cls));
return regex->source;
}
@@ -2434,7 +2437,7 @@ static void print_rec(val exp, val stream, int *semi_flag)
static void regex_print(val obj, val stream, val pretty, struct strm_ctx *ctx)
{
val self = lit("regex-print");
- regex_t *regex = coerce(regex_t *, cobj_handle(self, obj, regex_s));
+ regex_t *regex = coerce(regex_t *, cobj_handle(self, obj, regex_cls));
int semi_flag = 0;
(void) pretty;
@@ -2448,7 +2451,7 @@ static void regex_print(val obj, val stream, val pretty, struct strm_ctx *ctx)
static cnum regex_run(val compiled_regex, const wchar_t *str)
{
val self = lit("regex-run");
- regex_t *regex = coerce(regex_t *, cobj_handle(self, compiled_regex, regex_s));
+ regex_t *regex = coerce(regex_t *, cobj_handle(self, compiled_regex, regex_cls));
return if3(regex->kind == REGEX_DV,
dv_run(regex->r.dv, str),
@@ -2492,7 +2495,7 @@ static void regex_machine_reset(regex_machine_t *regm)
static void regex_machine_init(val self, regex_machine_t *regm, val reg)
{
- regex_t *regex = coerce(regex_t *, cobj_handle(self, reg, regex_s));
+ regex_t *regex = coerce(regex_t *, cobj_handle(self, reg, regex_cls));
if (regex->kind == REGEX_DV) {
regm->n.is_nfa = 0;
@@ -3342,6 +3345,9 @@ void regex_init(void)
cdigit_k = intern(lit("cdigit"), keyword_package);
cword_char_k = intern(lit("cword-char"), keyword_package);
+ regex_cls = cobj_register(regex_s);
+ chset_cls = cobj_register(chset_s);
+
reg_fun(intern(lit("regex-compile"), user_package), func_n2o(regex_compile, 1));
reg_fun(intern(lit("regexp"), user_package), func_n1(regexp));
reg_fun(intern(lit("regex-source"), user_package), func_n1(regex_source));
diff --git a/regex.h b/regex.h
index d18dacc0..58a7e9e3 100644
--- a/regex.h
+++ b/regex.h
@@ -28,6 +28,8 @@
extern val space_k, digit_k, word_char_k;
extern val cspace_k, cdigit_k, cword_char_k;
+extern struct cobj_class *regex_cls;
+
extern wchar_t spaces[];
val regex_compile(val regex, val error_stream);
diff --git a/socket.c b/socket.c
index f512e98f..f8222b03 100644
--- a/socket.c
+++ b/socket.c
@@ -321,7 +321,7 @@ static val make_dgram_sock_stream(int fd, val family, val peer,
if (peer_addr != 0)
memcpy(&d->peer_addr, peer_addr, pa_len);
d->pa_len = pa_len;
- stream = cobj(coerce(mem_t *, d), stream_s, &dgram_strm_ops.cobj_ops);
+ stream = cobj(coerce(mem_t *, d), stream_cls, &dgram_strm_ops.cobj_ops);
d->stream = stream;
d->family = family;
d->peer = peer;
diff --git a/stream.c b/stream.c
index 338a1e8e..1227113e 100644
--- a/stream.c
+++ b/stream.c
@@ -99,6 +99,8 @@ val stdio_stream_s;
val socket_error_s;
#endif
+struct cobj_class *stream_cls, *stdio_stream_cls;
+
const wchli_t *path_sep_chars = wli("/");
val top_stderr;
@@ -493,7 +495,7 @@ val make_null_stream(void)
struct dev_null *n = coerce(struct dev_null *, chk_malloc(sizeof *n));
strm_base_init(&n->a);
n->fd = -1;
- return cobj(coerce(mem_t *, n), stream_s, &null_ops.cobj_ops);
+ return cobj(coerce(mem_t *, n), stream_cls, &null_ops.cobj_ops);
}
#if CONFIG_STDIO_STRICT
@@ -821,7 +823,7 @@ static val stdio_get_fd(val stream)
{
val self = lit("stream-fd");
struct stdio_handle *h = coerce(struct stdio_handle *,
- cobj_handle(self, stream, stdio_stream_s));
+ cobj_handle(self, stream, stdio_stream_cls));
return h->f ? num(fileno(h->f)) : nil;
}
@@ -1673,7 +1675,7 @@ val set_mode_props(const struct stdio_mode m, val stream)
static val make_stdio_stream_common(FILE *f, val descr, struct cobj_ops *ops)
{
struct stdio_handle *h = coerce(struct stdio_handle *, chk_malloc(sizeof *h));
- val stream = cobj(coerce(mem_t *, h), stdio_stream_s, ops);
+ val stream = cobj(coerce(mem_t *, h), stdio_stream_cls, ops);
strm_base_init(&h->a);
h->f = f;
h->descr = descr;
@@ -1737,7 +1739,7 @@ val stream_fd(val stream)
{
val self = lit("fileno");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_fd(stream);
}
@@ -1746,7 +1748,7 @@ val sock_family(val stream)
{
val self = lit("sock-family");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_sock_family(stream);
}
@@ -1754,7 +1756,7 @@ val sock_type(val stream)
{
val self = lit("sock-type");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_sock_type(stream);
}
@@ -1762,7 +1764,7 @@ val sock_peer(val stream)
{
val self = lit("sock-peer");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_sock_peer(stream);
}
@@ -1770,7 +1772,7 @@ val sock_set_peer(val stream, val peer)
{
val self = lit("sock-set-peer");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->set_sock_peer(stream, peer);
}
#endif
@@ -1882,7 +1884,7 @@ static val make_dir_stream(DIR *dir)
strm_base_init(&h->a);
h->d = dir;
h->err = nil;
- return cobj(coerce(mem_t *, h), stream_s, &dir_ops.cobj_ops);
+ return cobj(coerce(mem_t *, h), stream_cls, &dir_ops.cobj_ops);
}
struct string_in {
@@ -2005,7 +2007,7 @@ val make_string_input_stream(val string)
strm_base_init(&s->a);
s->string = string;
s->pos = zero;
- return cobj(coerce(mem_t *, s), stream_s, &string_in_ops.cobj_ops);
+ return cobj(coerce(mem_t *, s), stream_cls, &string_in_ops.cobj_ops);
}
struct byte_input {
@@ -2084,7 +2086,7 @@ val make_string_byte_input_stream(val string)
strm_base_init(&bi->a);
bi->buf = utf8_dup_to_buf(wstring, &bi->size, 0);
bi->index = 0;
- return cobj(coerce(mem_t *, bi), stream_s, &byte_in_ops.cobj_ops);
+ return cobj(coerce(mem_t *, bi), stream_cls, &byte_in_ops.cobj_ops);
}
}
@@ -2220,7 +2222,7 @@ val make_strlist_input_stream(val list)
s->string = car(list);
s->pos = zero;
s->list = cdr(list);
- return cobj(coerce(mem_t *, s), stream_s, &strlist_in_ops.cobj_ops);
+ return cobj(coerce(mem_t *, s), stream_cls, &strlist_in_ops.cobj_ops);
}
struct string_out {
@@ -2365,14 +2367,14 @@ val make_string_output_stream(void)
so->buf[0] = 0;
utf8_decoder_init(&so->ud);
so->head = so->tail = 0;
- return cobj(coerce(mem_t *, so), stream_s, &string_out_ops.cobj_ops);
+ return cobj(coerce(mem_t *, so), stream_cls, &string_out_ops.cobj_ops);
}
val get_string_from_stream(val stream)
{
val self = lit("get-string-from-stream");
struct string_out *so = coerce(struct string_out *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
if (stream->co.ops == &string_out_ops.cobj_ops) {
val out = nil;
@@ -2481,7 +2483,7 @@ val make_strlist_output_stream(void)
strm_base_init(&s->a);
s->lines = nil;
s->strstream = nil;
- stream = cobj(coerce(mem_t *, s), stream_s, &strlist_out_ops.cobj_ops);
+ stream = cobj(coerce(mem_t *, s), stream_cls, &strlist_out_ops.cobj_ops);
s->strstream = strstream;
return stream;
}
@@ -2490,7 +2492,7 @@ val get_list_from_stream(val stream)
{
val self = lit("get-list-from-stream");
struct strlist_out *s = coerce(struct strlist_out *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
if (stream->co.ops == &strlist_out_ops.cobj_ops) {
val stray = get_string_from_stream(s->strstream);
@@ -2671,7 +2673,7 @@ val make_catenated_stream(val stream_list)
val catstrm = nil;
strm_base_init(&s->a);
s->streams = nil;
- catstrm = cobj(coerce(mem_t *, s), stream_s, &cat_stream_ops.cobj_ops);
+ catstrm = cobj(coerce(mem_t *, s), stream_cls, &cat_stream_ops.cobj_ops);
s->streams = stream_list;
return catstrm;
}
@@ -2858,7 +2860,7 @@ static val make_delegate_stream(val self, val orig_stream, size_t handle_size,
struct cobj_ops *ops)
{
struct strm_ops *orig_ops = coerce(struct strm_ops *,
- cobj_ops(self, orig_stream, stream_s));
+ cobj_ops(self, orig_stream, stream_cls));
struct delegate_base *db = coerce(struct delegate_base *,
chk_calloc(1, handle_size));
val delegate_stream;
@@ -2867,7 +2869,7 @@ static val make_delegate_stream(val self, val orig_stream, size_t handle_size,
db->target_stream = nil;
db->target_ops = orig_ops;
- delegate_stream = cobj(coerce(mem_t *, db), stream_s, ops);
+ delegate_stream = cobj(coerce(mem_t *, db), stream_cls, ops);
db->target_stream = orig_stream;
@@ -2940,7 +2942,7 @@ val stream_set_prop(val stream, val ind, val prop)
{
val self = lit("stream-set-prop");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->set_prop(stream, ind, prop);
}
@@ -2948,7 +2950,7 @@ val stream_get_prop(val stream, val ind)
{
val self = lit("stream-get-prop");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
if (ind == fd_k && ops->get_fd != null_get_fd)
return ops->get_fd(stream);
@@ -2970,7 +2972,7 @@ val close_stream(val stream, val throw_on_error)
{
val self = lit("close-stream");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->close(stream, throw_on_error);
}
@@ -2978,7 +2980,7 @@ val get_error(val stream)
{
val self = lit("get-error");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_error(stream);
}
@@ -2986,7 +2988,7 @@ val get_error_str(val stream)
{
val self = lit("get-error-str");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_error_str(stream);
}
@@ -2994,7 +2996,7 @@ val clear_error(val stream)
{
val self = lit("clear-error");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->clear_error(stream);
}
@@ -3003,7 +3005,7 @@ val get_line(val stream_in)
val self = lit("get-line");
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_line(stream);
}
@@ -3012,7 +3014,7 @@ val get_char(val stream_in)
val self = lit("get-char");
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_char(stream);
}
@@ -3021,7 +3023,7 @@ val get_byte(val stream_in)
val self = lit("get-byte");
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->get_byte(stream);
}
@@ -3029,7 +3031,7 @@ val get_bytes(val self, val stream_in, mem_t *ptr, ucnum len)
{
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return unum(ops->fill_buf(stream, ptr, len, 0));
}
@@ -3038,7 +3040,7 @@ val unget_char(val ch, val stream_in)
val self = lit("unget-char");
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
if (!is_chr(ch))
type_mismatch(lit("~a: ~s is not a character"), self, ch, nao);
return ops->unget_char(stream, ch);
@@ -3050,7 +3052,7 @@ val unget_byte(val byte, val stream_in)
cnum b = c_num(byte, self);
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
if (b < 0 || b > 255)
uw_throwf(file_error_s, lit("~a: stream ~s: byte value ~a out of range"),
@@ -3067,7 +3069,7 @@ val put_buf(val buf, val pos_in, val stream_in)
ucnum len = c_unum(length_buf(buf), self);
mem_t *ptr = buf_get(buf, self);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return unum(ops->put_buf(stream, ptr, len, pos));
}
@@ -3080,7 +3082,7 @@ val fill_buf(val buf, val pos_in, val stream_in)
ucnum len = c_unum(length_buf(buf), self);
mem_t *ptr = buf_get(buf, self);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return unum(ops->fill_buf(stream, ptr, len, pos));
}
@@ -3094,7 +3096,7 @@ val fill_buf_adjust(val buf, val pos_in, val stream_in)
mem_t *ptr = buf_get(buf, self);
val readpos;
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
buf_set_length(buf, alloc_size, zero);
readpos = unum(ops->fill_buf(stream, ptr, len, pos));
buf_set_length(buf, readpos, zero);
@@ -3106,7 +3108,7 @@ val get_line_as_buf(val stream_in)
val self = lit("get-line-as-buf");
val stream = default_arg_strict(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
val buf = make_buf(zero, nil, num_fast(128));
unsigned char bytes[128];
size_t count = 0;
@@ -3826,7 +3828,7 @@ val format(val stream, val str, ...)
val st = if3(stream == t,
std_output,
or2(stream, make_string_output_stream()));
- class_check(self, st, stream_s);
+ class_check(self, st, stream_cls);
{
va_list vl;
@@ -3856,13 +3858,13 @@ val put_string(val string, val stream_in)
val self = lit("put-string");
val stream = default_arg_strict(stream_in, std_output);
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
if (lazy_stringp(string)) {
return lazy_str_put(string, stream_in, s);
} else {
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
cnum col = s->column;
const wchar_t *str = c_str(string, self), *p = str;
@@ -3900,9 +3902,9 @@ val put_char(val ch, val stream_in)
val self = lit("put-char");
val stream = default_arg_strict(stream_in, std_output);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
wint_t cch = c_chr(ch);
switch (cch) {
@@ -3943,7 +3945,7 @@ val put_byte(val byte, val stream_in)
val self = lit("put-byte");
val stream = default_arg_strict(stream_in, std_output);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
cnum b = c_num(byte, self);
if (b < 0 || b > 255)
@@ -3983,7 +3985,7 @@ val flush_stream(val stream_in)
val self = lit("flush-stream");
val stream = default_arg_strict(stream_in, std_output);
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
return ops->flush(stream);
}
@@ -3991,7 +3993,7 @@ val seek_stream(val stream, val offset, val whence)
{
val self = lit("seek-stream");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
enum strm_whence w;
if (whence == from_start_k)
@@ -4011,7 +4013,7 @@ val truncate_stream(val stream, val len)
{
val self = lit("truncate-stream");
struct strm_ops *ops = coerce(struct strm_ops *,
- cobj_ops(self, stream, stream_s));
+ cobj_ops(self, stream, stream_cls));
if (missingp(len))
len = ops->seek(stream, zero, strm_cur);
return ops->truncate(stream, len);
@@ -4021,7 +4023,7 @@ val get_indent_mode(val stream)
{
val self = lit("get-indent-mode");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
return num_fast(s->indent_mode);
}
@@ -4029,7 +4031,7 @@ val test_set_indent_mode(val stream, val compare, val mode)
{
val self = lit("test-set-indent-mode");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
val oldval = num_fast(s->indent_mode);
if (oldval == compare)
s->indent_mode = convert(enum indent_mode, c_num(mode, self));
@@ -4040,7 +4042,7 @@ val test_neq_set_indent_mode(val stream, val compare, val mode)
{
val self = lit("test-neq-set-indent-mode");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
val oldval = num_fast(s->indent_mode);
if (oldval != compare)
s->indent_mode = convert(enum indent_mode, c_num(mode, self));
@@ -4051,7 +4053,7 @@ val set_indent_mode(val stream, val mode)
{
val self = lit("set-indent-mode");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
val oldval = num_fast(s->indent_mode);
s->indent_mode = convert(enum indent_mode, c_num(mode, self));
return oldval;
@@ -4061,7 +4063,7 @@ val get_indent(val stream)
{
val self = lit("get-indent");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
return num(s->indent_chars);
}
@@ -4069,7 +4071,7 @@ val set_indent(val stream, val indent)
{
val self = lit("set-indent");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
val oldval = num(s->indent_chars);
s->indent_chars = c_num(indent, self);
if (s->indent_chars < 0)
@@ -4081,7 +4083,7 @@ val inc_indent(val stream, val delta)
{
val self = lit("inc-indent");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
val oldval = num(s->indent_chars);
val col = num(s->column);
s->indent_chars = c_num(plus(delta, col), self);
@@ -4094,7 +4096,7 @@ val width_check(val stream, val alt)
{
val self = lit("width-check");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
if ((s->indent_mode == indent_code &&
s->column >= s->indent_chars + s->code_width) ||
@@ -4117,7 +4119,7 @@ val force_break(val stream)
{
val self = lit("force-break");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
s->force_break = 1;
return stream;
}
@@ -4126,7 +4128,7 @@ val set_max_length(val stream, val length)
{
val self = lit("set-max-length");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
cnum old_max = s->max_length;
s->max_length = c_num(length, self);
return num(old_max);
@@ -4136,7 +4138,7 @@ val set_max_depth(val stream, val depth)
{
val self = lit("set-max-depth");
struct strm_base *s = coerce(struct strm_base *,
- cobj_handle(self, stream, stream_s));
+ cobj_handle(self, stream, stream_cls));
cnum old_max = s->max_depth;
s->max_depth = c_num(depth, self);
return num(old_max);
@@ -5296,6 +5298,9 @@ void stream_init(void)
clear_error_s = intern(lit("clear-error"), user_package);
get_fd_s = intern(lit("get-fd"), user_package);
+ stream_cls = cobj_register(stream_s);
+ stdio_stream_cls = cobj_register_super(stdio_stream_s, stream_cls);
+
reg_var(stdin_s = intern(lit("*stdin*"), user_package),
make_stdio_stream(stdin, lit("stdin")));
reg_var(stdout_s = intern(lit("*stdout*"), user_package),
diff --git a/stream.h b/stream.h
index 410913af..9f3e326f 100644
--- a/stream.h
+++ b/stream.h
@@ -152,6 +152,8 @@ extern const wchli_t *path_sep_chars;
extern val top_stderr;
+extern struct cobj_class *stream_cls, *stdio_stream_cls;
+
void strm_base_init(struct strm_base *s);
void strm_base_cleanup(struct strm_base *s);
void strm_base_mark(struct strm_base *s);
diff --git a/struct.c b/struct.c
index 529a930d..61916ddb 100644
--- a/struct.c
+++ b/struct.c
@@ -116,6 +116,9 @@ static val *special_sym[num_special_slots] = {
&iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s
};
+static struct cobj_class *struct_type_cls;
+struct cobj_class *struct_cls;
+
static val struct_type_hash;
static val slot_hash;
static val struct_type_finalize_f;
@@ -153,6 +156,9 @@ void struct_init(void)
iter_step_s = intern(lit("iter-step"), user_package);
iter_reset_s = intern(lit("iter-reset"), user_package);
+ struct_type_cls = cobj_register(struct_type_s);
+ struct_cls = cobj_register(struct_s);
+
struct_type_hash = make_hash(nil, nil, nil);
slot_hash = make_hash(nil, nil, t);
slot_type_hash = make_hash(nil, nil, nil);
@@ -260,6 +266,14 @@ static void call_stinitfun_chain(struct struct_type *st, val stype)
}
}
+static struct struct_inst *struct_handle(val obj, val ctx)
+{
+ if (cobjp(obj) && obj->co.ops == &struct_inst_ops)
+ return coerce(struct struct_inst *, obj->co.handle);
+ uw_throwf(error_s, lit("~a: ~s isn't a structure"),
+ ctx, obj, nao);
+}
+
static struct struct_type *stype_handle(val *pobj, val ctx)
{
val obj = *pobj;
@@ -272,11 +286,13 @@ static struct struct_type *stype_handle(val *pobj, val ctx)
no_such_struct(ctx, obj);
*pobj = stype;
return coerce(struct struct_type *, cobj_handle(ctx, stype,
- struct_type_s));
+ struct_type_cls));
}
case COBJ:
- if (obj->co.cls == struct_type_s)
+ if (obj->co.cls == struct_type_cls)
return coerce(struct struct_type *, obj->co.handle);
+ if (obj->co.cls == struct_cls)
+ return struct_handle(obj, ctx)->type;
/* fallthrough */
default:
uw_throwf(error_s, lit("~a: ~s isn't a struct type"),
@@ -413,6 +429,10 @@ val make_struct_type(val name, val supers,
lisplib_try_load(name);
+ if (builtin_type_p(name) || cobj_class_exists(name))
+ uw_throwf(error_s, lit("~a: ~s is a built-in type"),
+ self, name, nao);
+
if (!listp(supers))
supers = cons(supers, nil);
@@ -427,7 +447,7 @@ val make_struct_type(val name, val supers,
no_such_struct(self, super);
ptail = list_collect(ptail, supertype);
} else {
- class_check(self, super, struct_type_s);
+ class_check(self, super, struct_type_cls);
ptail = list_collect(ptail, super);
}
}
@@ -459,7 +479,7 @@ val make_struct_type(val name, val supers,
cnum stsl_upb = c_num(plus(length(static_slots),
num(count_super_stslots(nsupers, sus, self))),
self);
- val stype = cobj(coerce(mem_t *, st), struct_type_s, &struct_type_ops);
+ val stype = cobj(coerce(mem_t *, st), struct_type_cls, &struct_type_ops);
val iter;
cnum sl, stsl, i;
struct stslot null_ptr = { nil, 0, 0, nil };
@@ -575,7 +595,7 @@ val find_struct_type(val sym)
val struct_type_p(val obj)
{
- return cobjclassp(obj, struct_type_s);
+ return cobjclassp(obj, struct_type_cls);
}
val struct_get_initfun(val type)
@@ -737,7 +757,7 @@ val allocate_struct(val type)
si->lazy = 0;
si->dirty = 1;
bug_unless (type == st->self);
- return cobj(coerce(mem_t *, si), st->name, &struct_inst_ops);
+ return cobj(coerce(mem_t *, si), struct_cls, &struct_inst_ops);
}
#define alloc_seen(name, size_name) \
@@ -771,7 +791,7 @@ static val make_struct_impl(val self, val type,
si->id = st->id;
si->dirty = 1;
- sinst = cobj(coerce(mem_t *, si), st->name, &struct_inst_ops);
+ sinst = cobj(coerce(mem_t *, si), struct_cls, &struct_inst_ops);
bug_unless (type == st->self);
@@ -895,7 +915,7 @@ val make_lazy_struct(val type, val argfun)
si->lazy = 1;
si->dirty = 1;
- sinst = cobj(coerce(mem_t *, si), st->name, &struct_inst_ops);
+ sinst = cobj(coerce(mem_t *, si), struct_cls, &struct_inst_ops);
bug_unless (type == st->self);
@@ -920,14 +940,6 @@ val make_struct_lit(val type, val plist)
return strct;
}
-static struct struct_inst *struct_handle(val obj, val ctx)
-{
- if (cobjp(obj) && obj->co.ops == &struct_inst_ops)
- return coerce(struct struct_inst *, obj->co.handle);
- uw_throwf(error_s, lit("~a: ~s isn't a structure"),
- ctx, obj, nao);
-}
-
static struct struct_inst *struct_handle_for_slot(val obj, val ctx, val slot)
{
if (cobjp(obj) && obj->co.ops == &struct_inst_ops)
@@ -947,7 +959,7 @@ val copy_struct(val strct)
struct struct_inst *si_copy = coerce(struct struct_inst *, chk_malloc(size));
check_init_lazy_struct(strct, si);
memcpy(si_copy, si, size);
- copy = cobj(coerce(mem_t *, si_copy), st->name, &struct_inst_ops);
+ copy = cobj(coerce(mem_t *, si_copy), struct_cls, &struct_inst_ops);
gc_hint(strct);
return copy;
}
diff --git a/struct.h b/struct.h
index 0aa446e1..6b139653 100644
--- a/struct.h
+++ b/struct.h
@@ -32,6 +32,7 @@ extern val lambda_set_s;
extern val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s;
extern struct cobj_ops struct_inst_ops;
+extern struct cobj_class *struct_cls;
enum special_slot {
equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m,
diff --git a/strudel.c b/strudel.c
index e88f175c..e0866a98 100644
--- a/strudel.c
+++ b/strudel.c
@@ -258,7 +258,7 @@ val make_struct_delegate_stream(val target_obj)
val stream;
strm_base_init(&sb->a);
sb->obj = nil;
- stream = cobj(coerce(mem_t *, sb), stream_s, &strudel_ops.cobj_ops);
+ stream = cobj(coerce(mem_t *, sb), stream_cls, &strudel_ops.cobj_ops);
sb->obj = target_obj;
return stream;
}
diff --git a/sysif.c b/sysif.c
index f0479f1a..0c79dac4 100644
--- a/sysif.c
+++ b/sysif.c
@@ -149,6 +149,8 @@ val flock_s, type_s, whence_s, start_s, len_s, pid_s;
val dlhandle_s, dlsym_s;
#endif
+struct cobj_class *dir_cls;
+
static val at_exit_list;
static val dirent_st;
@@ -1482,7 +1484,7 @@ static val poll_wrap(val poll_list, val timeout_in)
pfd[i].fd = c_num(obj, self);
break;
case COBJ:
- if (subtypep(obj->co.cls, stream_s)) {
+ if (typep(obj, stream_s)) {
val fdval = stream_fd(obj);
if (!fdval) {
free(pfd);
@@ -2362,7 +2364,7 @@ static val opendir_wrap(val path, val prefix_p)
path, num(errno), errno_to_str(errno), nao);
} else {
struct dir *d = coerce(struct dir *, chk_malloc(sizeof *d));
- val obj = cobj(coerce(mem_t *, d), dir_s, &opendir_ops);
+ val obj = cobj(coerce(mem_t *, d), dir_cls, &opendir_ops);
d->dir = dir;
d->path = if2(default_null_arg(prefix_p), path);
return obj;
@@ -2372,7 +2374,7 @@ static val opendir_wrap(val path, val prefix_p)
static val closedir_wrap(val dirobj)
{
val self = lit("closedir");
- struct dir *d = coerce(struct dir *, cobj_handle(self, dirobj, dir_s));
+ struct dir *d = coerce(struct dir *, cobj_handle(self, dirobj, dir_cls));
if (d->dir != 0) {
closedir(d->dir);
@@ -2386,7 +2388,7 @@ static val closedir_wrap(val dirobj)
static val readdir_wrap(val dirobj, val dirent_in)
{
val self = lit("readdir");
- struct dir *d = coerce(struct dir *, cobj_handle(self, dirobj, dir_s));
+ struct dir *d = coerce(struct dir *, cobj_handle(self, dirobj, dir_cls));
struct dirent *dent = if3(d->dir != 0, readdir(d->dir), 0);
for (;;) {
@@ -2510,6 +2512,8 @@ void sysif_init(void)
pid_s = intern(lit("pid"), user_package);
#endif
+ dir_cls = cobj_register(dir_s);
+
make_struct_type(stat_s, nil, nil,
list(dev_s, ino_s, mode_s, nlink_s, uid_s, gid_s,
rdev_s, size_s, blksize_s, blocks_s,
diff --git a/syslog.c b/syslog.c
index 2ed83e9f..6da9b282 100644
--- a/syslog.c
+++ b/syslog.c
@@ -242,7 +242,7 @@ val make_syslog_stream(val prio)
strm_base_init(&s->a);
s->prio = prio;
s->strstream = nil;
- stream = cobj(coerce(mem_t *, s), stream_s, &syslog_strm_ops.cobj_ops);
+ stream = cobj(coerce(mem_t *, s), stream_cls, &syslog_strm_ops.cobj_ops);
s->strstream = strstream;
return stream;
}
diff --git a/tree.c b/tree.c
index fb70c903..a0a0faf8 100644
--- a/tree.c
+++ b/tree.c
@@ -82,6 +82,8 @@ struct tree_diter {
val tree_s, tree_iter_s, tree_fun_whitelist_s;
+struct cobj_class *tree_cls, *tree_iter_cls;
+
val tnode(val key, val left, val right)
{
val obj = make_obj();
@@ -501,7 +503,7 @@ static val tr_delete(val tree, struct tree *tr, val key)
val tree_insert_node(val tree, val node)
{
val self = lit("tree-insert-node");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
type_check(self, node, TNOD);
@@ -530,7 +532,7 @@ val tree_insert(val tree, val key)
val tree_lookup_node(val tree, val key)
{
val self = lit("tree-lookup-node");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
return tr_lookup(tr, key);
}
@@ -543,7 +545,7 @@ val tree_lookup(val tree, val key)
val tree_delete_node(val tree, val key)
{
val self = lit("tree-delete-node");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
return tr_delete(tree, tr, key);
}
@@ -556,15 +558,15 @@ val tree_delete(val tree, val key)
static val tree_root(val tree)
{
val self = lit("tree-root");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
return tr->root;
}
static val tree_equal_op(val left, val right)
{
val self = lit("equal");
- struct tree *ltr = coerce(struct tree *, cobj_handle(self, left, tree_s));
- struct tree *rtr = coerce(struct tree *, cobj_handle(self, right, tree_s));
+ struct tree *ltr = coerce(struct tree *, cobj_handle(self, left, tree_cls));
+ struct tree *rtr = coerce(struct tree *, cobj_handle(self, right, tree_cls));
if (ltr->size != rtr->size)
return nil;
@@ -683,7 +685,7 @@ val tree(val keys_in, val key_fn, val less_fn, val equal_fn)
{
struct tree *tr = coerce(struct tree *, chk_calloc(1, sizeof *tr));
val keys = default_null_arg(keys_in), key;
- val tree = cobj(coerce(mem_t *, tr), tree_s, &tree_ops);
+ val tree = cobj(coerce(mem_t *, tr), tree_cls, &tree_ops);
seq_iter_t ki;
uses_or2;
@@ -743,9 +745,9 @@ val copy_search_tree(val tree)
{
val self = lit("copy-search-tree");
struct tree *ntr = coerce(struct tree *, malloc(sizeof *ntr));
- struct tree *otr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *otr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
val nroot = deep_copy_tnode(otr->root);
- val ntree = cobj(coerce(mem_t *, ntr), tree_s, &tree_ops);
+ val ntree = cobj(coerce(mem_t *, ntr), tree_cls, &tree_ops);
*ntr = *otr;
ntr->root = nroot;
return ntree;
@@ -755,8 +757,8 @@ val make_similar_tree(val tree)
{
val self = lit("make-similar-tree");
struct tree *ntr = coerce(struct tree *, malloc(sizeof *ntr));
- struct tree *otr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
- val ntree = cobj(coerce(mem_t *, ntr), tree_s, &tree_ops);
+ struct tree *otr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
+ val ntree = cobj(coerce(mem_t *, ntr), tree_cls, &tree_ops);
*ntr = *otr;
ntr->root = nil;
ntr->size = ntr->max_size = 0;
@@ -765,7 +767,7 @@ val make_similar_tree(val tree)
val treep(val obj)
{
- return tnil(type(obj) == COBJ && obj->co.cls == tree_s);
+ return tnil(type(obj) == COBJ && obj->co.cls == tree_cls);
}
static void tree_iter_mark(val tree_iter)
@@ -790,10 +792,10 @@ static struct cobj_ops tree_iter_ops = cobj_ops_init(eq,
val tree_begin(val tree, val lowkey, val highkey)
{
val self = lit("tree-begin");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
struct tree_diter *tdi = coerce(struct tree_diter *,
chk_calloc(1, sizeof *tdi));
- val iter = cobj(coerce(mem_t *, tdi), tree_iter_s, &tree_iter_ops);
+ val iter = cobj(coerce(mem_t *, tdi), tree_iter_cls, &tree_iter_ops);
tdi->ti.self = iter;
tdi->tree = tree;
@@ -815,10 +817,10 @@ val copy_tree_iter(val iter)
{
val self = lit("copy-tree-iter");
struct tree_diter *tdis = coerce(struct tree_diter *,
- cobj_handle(self, iter, tree_iter_s));
+ cobj_handle(self, iter, tree_iter_cls));
struct tree_diter *tdid = coerce(struct tree_diter *,
chk_calloc(1, sizeof *tdid));
- val iter_copy = cobj(coerce(mem_t *, tdid), tree_iter_s, &tree_iter_ops);
+ val iter_copy = cobj(coerce(mem_t *, tdid), tree_iter_cls, &tree_iter_ops);
int depth = tdis->ti.depth;
tdid->ti.self = iter_copy;
@@ -841,9 +843,9 @@ val replace_tree_iter(val diter, val siter)
{
val self = lit("replace-tree-iter");
struct tree_diter *tdid = coerce(struct tree_diter *,
- cobj_handle(self, diter, tree_iter_s));
+ cobj_handle(self, diter, tree_iter_cls));
struct tree_diter *tdis = coerce(struct tree_diter *,
- cobj_handle(self, siter, tree_iter_s));
+ cobj_handle(self, siter, tree_iter_cls));
int depth = tdis->ti.depth;
tdid->ti.depth = depth;
@@ -866,9 +868,9 @@ val replace_tree_iter(val diter, val siter)
val tree_reset(val iter, val tree, val lowkey, val highkey)
{
val self = lit("tree-reset");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
struct tree_diter *tdi = coerce(struct tree_diter *,
- cobj_handle(self, iter, tree_iter_s));
+ cobj_handle(self, iter, tree_iter_cls));
const struct tree_iter it = tree_iter_init(0);
tdi->ti = it;
@@ -894,8 +896,8 @@ val tree_next(val iter)
{
val self = lit("tree-next");
struct tree_diter *tdi = coerce(struct tree_diter *,
- cobj_handle(self, iter, tree_iter_s));
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tdi->tree, tree_s));
+ cobj_handle(self, iter, tree_iter_cls));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tdi->tree, tree_cls));
if (tdi->lastnode) {
val node = tn_find_next(tdi->lastnode, &tdi->ti);
@@ -923,8 +925,8 @@ val tree_peek(val iter)
{
val self = lit("tree-peek");
struct tree_diter *tdi = coerce(struct tree_diter *,
- cobj_handle(self, iter, tree_iter_s));
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tdi->tree, tree_s));
+ cobj_handle(self, iter, tree_iter_cls));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tdi->tree, tree_cls));
if (tdi->lastnode) {
val node = tn_peek_next(tdi->lastnode, &tdi->ti);
@@ -948,7 +950,7 @@ val tree_peek(val iter)
val tree_clear(val tree)
{
val self = lit("tree-clear");
- struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
cnum oldsize = tr->size;
tr->root = nil;
tr->size = tr->max_size = 0;
@@ -972,6 +974,10 @@ void tree_init(void)
tree_s = intern(lit("tree"), user_package);
tree_iter_s = intern(lit("tree-iter"), user_package);
tree_fun_whitelist_s = intern(lit("*tree-fun-whitelist*"), user_package);
+
+ tree_cls = cobj_register(tree_s);
+ tree_iter_cls = cobj_register(tree_iter_s);
+
reg_fun(tnode_s, func_n3(tnode));
reg_fun(intern(lit("left"), user_package), func_n1(left));
reg_fun(intern(lit("right"), user_package), func_n1(right));
diff --git a/tree.h b/tree.h
index f883b8c7..c545e280 100644
--- a/tree.h
+++ b/tree.h
@@ -26,6 +26,7 @@
*/
extern val tree_s, tree_iter_s, tree_fun_whitelist_s;
+extern struct cobj_class *tree_cls, *tree_iter_cls;
#define tree_fun_whitelist (deref(lookup_var_l(nil, tree_fun_whitelist_s)))
diff --git a/unwind.c b/unwind.c
index 9773d228..51b5f058 100644
--- a/unwind.c
+++ b/unwind.c
@@ -72,6 +72,8 @@ static val fcall_frame_type, eval_frame_type, expand_frame_type;
static val deferred_warnings, tentative_defs;
+static struct cobj_class *sys_cont_cls;
+
#if CONFIG_EXTRA_DEBUGGING
static int uw_break_on_error;
#endif
@@ -1053,7 +1055,7 @@ static void call_copy_handlers(uw_frame_t *upto)
static val revive_cont(val dc, val arg)
{
val self = lit("revive-cont");
- struct cont *cont = coerce(struct cont *, cobj_handle(self, dc, sys_cont_s));
+ struct cont *cont = coerce(struct cont *, cobj_handle(self, dc, sys_cont_cls));
if (arg == sys_cont_free_s) {
free(cont->stack);
@@ -1161,7 +1163,7 @@ static val capture_cont(val tag, val fun, uw_frame_t *block)
blcopy->uw.up = 0;
blcopy->uw.type = UW_CAPTURED_BLOCK;
- cont_obj = cobj(coerce(mem_t *, cont), sys_cont_s, &cont_ops);
+ cont_obj = cobj(coerce(mem_t *, cont), sys_cont_cls, &cont_ops);
cont->tag = tag;
@@ -1292,6 +1294,9 @@ void uw_late_init(void)
sys_cont_poison_s = intern(lit("cont-poison"), system_package);
sys_cont_free_s = intern(lit("cont-free"), system_package);
catch_frame_s = intern(lit("catch-frame"), user_package);
+
+ sys_cont_cls = cobj_register(sys_cont_s);
+
frame_type = make_struct_type(intern(lit("frame"), user_package),
nil, nil, nil, nil, nil, nil, nil);
catch_frame_type = make_struct_type(catch_frame_s,
diff --git a/vm.c b/vm.c
index f3aada5c..83a56dca 100644
--- a/vm.c
+++ b/vm.c
@@ -99,6 +99,9 @@ struct vm_closure {
val vm_desc_s, vm_closure_s;
+struct cobj_class *vm_desc_cls;
+static struct cobj_class *vm_closure_cls;
+
static_forward(struct cobj_ops vm_desc_ops);
static_forward(struct cobj_ops vm_closure_ops);
@@ -109,7 +112,7 @@ static struct vm_desc_links vmd_list = {
static struct vm_desc *vm_desc_struct(val self, val obj)
{
- return coerce(struct vm_desc *, cobj_handle(self, obj, vm_desc_s));
+ return coerce(struct vm_desc *, cobj_handle(self, obj, vm_desc_cls));
}
val vm_make_desc(val nlevels, val nregs, val bytecode,
@@ -158,7 +161,7 @@ val vm_make_desc(val nlevels, val nregs, val bytecode,
vnull->lnk.prev = vd;
vtail->lnk.next = vd;
- desc = cobj(coerce(mem_t *, vd), vm_desc_s, &vm_desc_ops);
+ desc = cobj(coerce(mem_t *, vd), vm_desc_cls, &vm_desc_ops);
vd->bytecode = bytecode;
vd->datavec = datavec;
@@ -230,7 +233,7 @@ static void vm_desc_mark(val obj)
static struct vm_closure *vm_closure_struct(val self, val obj)
{
- return coerce(struct vm_closure *, cobj_handle(self, obj, vm_closure_s));
+ return coerce(struct vm_closure *, cobj_handle(self, obj, vm_closure_cls));
}
static val vm_make_closure(struct vm *vm, int frsz, int nreg)
@@ -253,7 +256,7 @@ static val vm_make_closure(struct vm *vm, int frsz, int nreg)
assert (vc->nlvl <= vm->nlvl);
- closure = cobj(coerce(mem_t *, vc), vm_closure_s, &vm_closure_ops);
+ closure = cobj(coerce(mem_t *, vc), vm_closure_cls, &vm_closure_ops);
for (i = 2; i < vc->nlvl; i++) {
struct vm_env *sdi = &vm->dspl[i];
@@ -302,7 +305,7 @@ val vm_copy_closure(val oclosure)
memcpy(nvc, ovc, hdr_sz + dspl_sz);
- nclosure = cobj(coerce(mem_t *, nvc), vm_closure_s, &vm_closure_ops);
+ nclosure = cobj(coerce(mem_t *, nvc), vm_closure_cls, &vm_closure_ops);
for (i = 2; i < nvc->nlvl; i++) {
struct vm_env *ndi = &nvc->dspl[i];
@@ -1317,6 +1320,8 @@ void vm_init(void)
{
vm_desc_s = intern(lit("vm-desc"), system_package);
vm_closure_s = intern(lit("vm-closure"), system_package);
+ vm_desc_cls = cobj_register(vm_desc_s);
+ vm_closure_cls = cobj_register(vm_closure_s);
reg_fun(intern(lit("vm-make-desc"), system_package), func_n5(vm_make_desc));
reg_fun(intern(lit("vm-desc-nlevels"), system_package), func_n1(vm_desc_nlevels));
reg_fun(intern(lit("vm-desc-nregs"), system_package), func_n1(vm_desc_nregs));
diff --git a/vm.h b/vm.h
index 9dd5bff2..a839d1e5 100644
--- a/vm.h
+++ b/vm.h
@@ -27,6 +27,8 @@
extern val vm_desc_s, vm_closure_s;
+extern struct cobj_class *vm_desc_cls;
+
val vm_make_desc(val nlevels, val nregs, val bytecode,
val datavec, val funvec);
val vm_execute_toplevel(val desc);
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-13 04:35:28 +0000