diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-07-08 19:17:39 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-07-08 19:17:39 -0700 |
| commit | fc22de3079459193253522efccdd7519879e34b7 (patch) | |
| tree | 6c665cc9b800b81827a2a5214ed1125cb0dd49f3 | |
| parent | c0a9036d15d9f0a910aab82905e6b5e7d6ce71da (diff) | |
| download | txr-fc22de3079459193253522efccdd7519879e34b7.tar.gz txr-fc22de3079459193253522efccdd7519879e34b7.tar.bz2 txr-fc22de3079459193253522efccdd7519879e34b7.zip | |
type: disallow structs using built-in type names.
This is a big commit motivated by the need to clean up the
situation with built-in type symbols, COBJ objects and
structs.
The struct type system allows struct types to be defined
for symbols like regex or str, which are used by built-in
or cobj types. This is a bad thing.
What is worse, structure instances are COBJ types which
identify their type using the COBJ class symbol mechanism.
There are places in the C implementation which assume
that when a COBJ has a certain class symbol, it is of
a certain expected type, which is totally different from
and incompatible form a struct instance. User code can
define a structure object which will fool that code.
There are multiple things going on in this patch.
The major theme is that the COBJ representation is changing.
Instead of a class symbol, COBJ instances now carry a
"struct cobj_class *" pointer. This pointer is obtained
by registration via the cobj_register function. All modules
must register their class symbols to obtain these class
handles, which are then used in cobj() calls for
instantiation.
The CPTR type was identical to COBJ until now, except for the
type tag. This is changing; CPTR objects will keep the old
representation with the class symbol.
commit 20fdfc6008297001491308849c17498c006fe7b4
Author: Kaz Kylheku <kaz@kylheku.com>
Date: Thu Jul 8 19:17:39 2021 -0700
* ffi.h (carray_cls): Declared.
* hash.h (hash_cls): Declared.
(hash_early_init): Declared.
* lib.h (struct cobj_class): New struct.
(struct cobj): cls member changing to struct cobj_class *.
(struct cptr): New struct, same as previous struct cobj.
(union obj): New member cp of type struct cptr, for CPTR.
(builtin_type): Declared.
(class_check): Declaration moved closer to COBJ-related
functions and updated.
(cobj_register, cobj_register_super, cobj_class_exists): New
functions declared.
(cobjclassp, cobj_handle, cobj_ops): Declarations updated.
* parser.h (parser_cls): Declared.
* rand.h (random_state_cls): Declared.
* regex.h (regex_cls): Declared.
* stream.h (stream_cls, stdio_stream_cls): Declared.
* struct.h (struct_cls): Declared.
* tree.h (tree_cls, tree_iter_cls): Declared.
* vm.h (vm_desc_cls): Declared.
* buf.c (buf_strm, make_buf_stream): Pass stream_cls
functions instead of stream_s class symbol.
* chksum.c (sha256_ctx_cls, md5_ctx_cls): New static class
handles.
(sha256_begin, sha256_hash, sha256_end, md5_begin, md5_hash,
md5_end): Pass class handles to instead of class symbols.
(chksum_init): Initialize class handle variables.
* ffi.c (ffi_type_cls, ffi_call_desc_cls, ffi_closure_cls,
union_cls): New static class handles.
(carray_cls): New global variable.
(ffi_type_struct_checked, ffi_type_print_op,
ffi_closure_struct_checked, ffi_closure_print_op,
make_ffi_type_builtin, make_ffi_type_pointer,
make_ffi_type_struct, make_ffi_type_union,
make_ffi_type_array, make_ffi_type_enum,
ffi_call_desc_checked, ffi_call_desc_print_op,
ffi_make_call_desc, ffi_make_closure, carray_struct_checked,
carray_print_op, make_carray, cptr_getobj, cptr_out,
uni_struct_checked, make_union_common): Pass class handles
instead of class symbols.
(ffi_init): Initialize class handle variables.
* filter.c (regex_from_trie): Use hash_cls class handle
instead of hash_s.
* gc.c (mark_obj): Split COBJ and CPTR cases since the
representation is different.
* hash.c (hash_cls, hash_iter_cls): New class handles.
(make_similar_hash, copy_hash, gethash_c, gethash_e, remhash,
clearhash, hash_count, get_hash_userdata, set_hash_userdata,
hashp, hash_iter_init, hash_begin, hash_next, hash_peek,
hash_reset, hash_reset, hash_uni, hash_diff, hash_symdiff,
hash_isec): Pass class handles instead of class symbols.
(hash_early_init): New function.
(hash_init): Set the class symbols in the class handles that
were created in hash_early_init at a time when these symbols
did not exist.
* lib.c (nelem): New macro.
(cobj_class): New static array.
(cobj_ptr): New static pointer.
(cobj_hash): New static hash.
(seq_iter_cls): New static class handle.
(builtin_type_p): New function.
(typeof): Struct instances now all carry the same symbol,
struct, as their COBJ class symbol. To get their type, we must
call struct_type_name.
(subtypep): Rearrangement of two cases: let's make the
reflexive case first. Adjust code for different location
of COBJ class symbol.
(seq_iter_init_with_info, seq_begin, seq_next, seq_reset,
iter_begin, iter_more, iter_item, iter_step, iter_reset,
make_like, list_collect, do_generic_funcall): Use class
handles instead of class symbols.
(class_check, cobj, cobjclassp, cobj_handle, cobj_ops): Take
class handle argument instead of class symbol.
(cobj_register, cobj_register_super, cobj_class_exists): New
functions.
(cobj_populate_hash): New static function.
(cobj_print_op): Adjust for different location of class
(cptr_print_op, cptr_typed, cptr_type, cptr_handle,
cptr_get): cptr functions now refer to obj->cp rather than
obj->co.
(copy, length, sub, ref, refset, replace, dwim_set, dwim_del,
obj_print): Use class handles for various COBJ types rather
than class symbols.
(obj_init): gc-protect cobj_hash. Initialize seq_iter_cls
class symbol and cobj_hash. Populate cobj_hash as the last
initialization step.
(init): Call hash_early_init immediately after gc_init.
diff --git a/lib.c b/lib.c
* match.c (do_match_line): Refer to regex_cls class handle
instead of regex_s..
* parser.c (parser_cls): New global class handle.
(parse, parser_get_impl, lisp_parse_impl, txr_parse,
parser_errors): Use class handles instead of class symbols.
(parse_init): Initialize parser_cls.
* rand.c (random_state_cls): New global class handle.
(make_state, random_state_p, make_random_state,
random_state_get_vec, random_fixnum, random_float, random):
Use class handles instead of class symbols.
(rand_init): Initialize random_state_cls.
* regex.c (regex_cls): New global class handle.
(chset_cls): New static class handle.
(reg_compile_csets, reg_derivative, regex_compile, regexp,
regex_source, regex_print, regex_run, regex_machine_init): Use
class handles instead of class symbols.
(regex_init): Initialize regex_cls and chset_cls.
* socket.c (make_dgram_sock_stream): Use stream_cls class
symbol instead of stream_s.
* stream.c (stream_cls, stdio_stream_cls): New class handles.
(make_null_stream, stdio_get_fd, make_stdio_stream_common,
stream_fd, sock_family, sock_type, sock_peer, sock_set_peer,
make_dir_stream, make_string_input_stream,
make_string_byte_input_stream, make_strlist_input_stream,
make_string_output_stream, make_strlist_output_stream,
get_list_from_stream, make_catenated_stream,
make_delegate_stream, make_delegate_stream, stream_set_prop,
stream_get_prop, close_stream, get_error, get_error_str,
clear_error, get_line, get_char, get_byte, get_bytes,
unget_char, unget_byte, put_buf, fill_buf, fill_buf_adjust,
get_line_as_buf, format, put_string, put_char, put_byte,
flush_stream, seek_stream, truncate_stream, get_indent_mode,
test_set_indent_mode, test_neq_set_indent_mode,
set_indent_mode, get_indent, set_indent, inc_indent,
width_check, force_break, set_max_length, set_max_depth): Use
class handle instead of symbol.
(stream_init): Initialize stream_cls and stdio_stream_cls.
* struct.c (struct_type_cls, struct_cls): New class handles.
(struct_init): Initialize struct_type_cls and struct_cls.
(struct_handle): Static function moved to avoid forward
declaration.
(stype_handle): Refer to struct_type_cls class handle instead
of struct_type_s symbol. Handle instance objects in addition
to types.
(make_struct_type): Throw error if a built-in type is being
defined as a struct type. Refer to class handle instead of
class symbol.
(find_struct_type, allocate_struct, make_struct_impl,
make_lazy_struct, copy_struct): Refer to class handle instead of
class symbol.
* strudel.c (make_struct_delegate_stream): Refer to stream_cls
class handle instead of stream_s symbol.
* sysif.c (dir_cls): New class handle.
(poll_wrap): Use typep instead of subtypep, eliminating access
to class symbol.
(opendir_wrap, closedir_wrap, readdir_wrap): Use class handles
instead of class symbols.
(sysif_init): Initialize dir_cls.
* syslog.c (make_syslog_stream): Refer to stream_cls class
handle instead of stream_s symbol.
* tree.c (tree_cls, tree_iter_cls): New class handles.
(tree_insert_node, tree_lookup_node, tree_delete_node,
tree_root, tree_equal_op, tree, copy_search_tree,
make_similar_tree, treep, tree_begin, copy_tree_iter,
replace_tree_iter, tree_reset, tree_next, tree_peek,
tree_clear): Use class handle instead of class symbol.
(tree_init): Initialize tree_cls and tree_iter_cls.
* unwind.c (sys_cont_cls): New static class handle.
(revive_cont, capture_cont): Use class handle instead of class
symbol.
(uw_late_init): Initialize sys_cont_cls.
* vm.c (vm_desc_cls): New global class handle.
(vm_closure_cls): New static class handle.
(vm_desc_struct, vm_make_desc, vm_closure_struct,
vm_make_closure, vm_copy_closure): Use class handle instead of
class symbol.
(vm_init): Initialize vm_desc_cls and vm_closure_cls.
| -rw-r--r-- | buf.c | 4 | ||||
| -rw-r--r-- | chksum.c | 15 | ||||
| -rw-r--r-- | ffi.c | 54 | ||||
| -rw-r--r-- | ffi.h | 2 | ||||
| -rw-r--r-- | filter.c | 4 | ||||
| -rw-r--r-- | gc.c | 4 | ||||
| -rw-r--r-- | hash.c | 62 | ||||
| -rw-r--r-- | hash.h | 3 | ||||
| -rw-r--r-- | lib.c | 197 | ||||
| -rw-r--r-- | lib.h | 27 | ||||
| -rw-r--r-- | match.c | 2 | ||||
| -rw-r--r-- | parser.c | 21 | ||||
| -rw-r--r-- | parser.h | 3 | ||||
| -rw-r--r-- | rand.c | 20 | ||||
| -rw-r--r-- | rand.h | 1 | ||||
| -rw-r--r-- | regex.c | 36 | ||||
| -rw-r--r-- | regex.h | 2 | ||||
| -rw-r--r-- | socket.c | 2 | ||||
| -rw-r--r-- | stream.c | 115 | ||||
| -rw-r--r-- | stream.h | 2 | ||||
| -rw-r--r-- | struct.c | 46 | ||||
| -rw-r--r-- | struct.h | 1 | ||||
| -rw-r--r-- | strudel.c | 2 | ||||
| -rw-r--r-- | sysif.c | 12 | ||||
| -rw-r--r-- | syslog.c | 2 | ||||
| -rw-r--r-- | tree.c | 56 | ||||
| -rw-r--r-- | tree.h | 1 | ||||
| -rw-r--r-- | unwind.c | 9 | ||||
| -rw-r--r-- | vm.c | 15 | ||||
| -rw-r--r-- | vm.h | 2 |
30 files changed, 451 insertions, 271 deletions
@@ -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; @@ -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)); @@ -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)); @@ -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); @@ -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 { @@ -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); @@ -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)); @@ -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); @@ -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 @@ -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); @@ -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"); @@ -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); @@ -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); @@ -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)); @@ -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); @@ -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, ®ex_obj_ops); + ret = cobj(coerce(mem_t *, regex), regex_cls, ®ex_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, ®ex_obj_ops); + ret = cobj(coerce(mem_t *, regex), regex_cls, ®ex_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)); @@ -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); @@ -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; @@ -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), @@ -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); @@ -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; } @@ -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, @@ -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; } @@ -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, @@ -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; } @@ -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)); @@ -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))) @@ -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, @@ -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)); @@ -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); |