diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | ffi.c | 6 | ||||
| -rw-r--r-- | gc.c | 2 | ||||
| -rw-r--r-- | hash.c | 1 | ||||
| -rw-r--r-- | lib.c | 61 | ||||
| -rw-r--r-- | lib.h | 9 | ||||
| -rw-r--r-- | sysif.c | 38 |
7 files changed, 94 insertions, 25 deletions
@@ -6161,6 +6161,8 @@ void eval_init(void) reg_fun(intern(lit("cptr-obj"), user_package), func_n1(cptr_obj)); reg_fun(intern(lit("cptr-zap"), user_package), func_n1(cptr_zap)); reg_fun(intern(lit("cptr-free"), user_package), func_n1(cptr_free)); + reg_fun(intern(lit("cptrp"), user_package), func_n1(cptrp)); + reg_fun(intern(lit("cptr-type"), user_package), func_n1(cptr_type)); reg_varl(intern(lit("cptr-null"), user_package), cptr(0)); eval_error_s = intern(lit("eval-error"), user_package); @@ -566,19 +566,19 @@ static val ffi_wchar_get(struct txr_ffi_type *tft, mem_t *src, val self) static void ffi_cptr_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self) { - mem_t *p = cptr_get(n); + mem_t *p = cptr_handle(n, tft->mtypes, self); *coerce(mem_t **, dst) = p; } static val ffi_cptr_get(struct txr_ffi_type *tft, mem_t *src, val self) { mem_t *p = *coerce(mem_t **, src); - return cptr(p); + return cptr_typed(p, tft->mtypes, 0); } static mem_t *ffi_cptr_alloc(struct txr_ffi_type *tft, val ptr, val self) { - return coerce(mem_t *, cptr_addr_of(ptr)); + return coerce(mem_t *, cptr_addr_of(ptr, tft->mtypes, self)); } static val ffi_str_in(struct txr_ffi_type *tft, int copy, @@ -274,6 +274,7 @@ static void finalize(val obj) obj->v.vec = 0; return; case COBJ: + case CPTR: obj->co.ops->destroy(obj); obj->co.handle = 0; return; @@ -392,6 +393,7 @@ tail_call: mark_obj(obj->ls.props->term); mark_obj_tail(obj->ls.list); case COBJ: + case CPTR: obj->co.ops->mark(obj); mark_obj_tail(obj->co.cls); case ENV: @@ -220,6 +220,7 @@ cnum equal_hash(val obj, int *count) case FLNUM: return hash_double(obj->fl.n); case COBJ: + case CPTR: if (obj->co.ops->equalsub) { val sub = obj->co.ops->equalsub(obj); if (sub) @@ -173,6 +173,7 @@ static val code2type(int code) case LCONS: return lcons_s; case LSTR: return lstr_s; case COBJ: return cobj_s; + case CPTR: return cptr_s; case ENV: return env_s; case BGNUM: return bignum_s; case FLNUM: return float_s; @@ -2520,6 +2521,9 @@ val equal(val left, val right) return left->co.ops->equal(left, right); return nil; + case CPTR: + if (type(right) == CPTR && left->co.ops == right->co.ops) + return left->co.ops->equal(left, right); } if (type(right) != COBJ) @@ -7379,6 +7383,17 @@ void cobj_print_op(val obj, val out, val pretty, struct strm_ctx *ctx) format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao); } +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); + } + format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao); +} + + val cobj_equal_handle_op(val left, val right) { return (left->co.handle == right->co.handle) ? t : nil; @@ -7392,15 +7407,36 @@ cnum cobj_handle_hash_op(val obj, int *count) static struct cobj_ops cptr_ops = { cobj_equal_handle_op, - cobj_print_op, + cptr_print_op, cobj_destroy_stub_op, cobj_mark_op, cobj_handle_hash_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; + return obj; +} + val cptr(mem_t *ptr) { - return cobj(ptr, cptr_s, &cptr_ops); + return cptr_typed(ptr, nil, &cptr_ops); +} + +val cptrp(val obj) +{ + return type(obj) == CPTR ? t : nil; +} + +val cptr_type(val cptr) +{ + (void) cptr_handle(cptr, nil, lit("cptr-type")); + return cptr->co.cls; } val cptr_int(val n) @@ -7415,27 +7451,37 @@ val cptr_obj(val obj) val cptr_zap(val cptr) { - (void) cobj_handle(cptr, cptr_s); + (void) cptr_handle(cptr, nil, lit("cptr-zap")); cptr->co.handle = 0; return cptr; } val cptr_free(val cptr) { - (void) cobj_handle(cptr, cptr_s); + (void) cptr_handle(cptr, nil, lit("cptr-free")); free(cptr->co.handle); cptr->co.handle = 0; return cptr; } +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); + if (type_sym && cptr->co.cls != type_sym) + uw_throwf(error_s, lit("~a: cptr ~s isn't of type ~s"), self, cptr, + type_sym, nao); + return cptr->co.handle; +} + mem_t *cptr_get(val cptr) { - return cobj_handle(cptr, cptr_s); + return cptr_handle(cptr, nil, lit("cptr-get")); } -mem_t **cptr_addr_of(val cptr) +mem_t **cptr_addr_of(val cptr, val type_sym, val self) { - (void) cobj_handle(cptr, cptr_s); + (void) cptr_handle(cptr, type_sym, self); return &cptr->co.handle; } @@ -10335,6 +10381,7 @@ dot: } break; case COBJ: + case CPTR: obj->co.ops->print(obj, out, pretty, ctx); break; case ENV: @@ -59,7 +59,7 @@ typedef uint_ptr_t ucnum; typedef enum type { NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS, - STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV, + STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV, BGNUM, FLNUM, RNG, BUF, MAXTYPE = BUF /* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */ } type_t; @@ -253,6 +253,7 @@ struct cobj_ops { */ void cobj_print_op(val, val, val, struct strm_ctx *); +void cptr_print_op(val, val, val, struct strm_ctx *); val cobj_equal_handle_op(val left, val right); void cobj_destroy_stub_op(val); void cobj_destroy_free_op(val); @@ -939,12 +940,16 @@ val cobjp(val obj); mem_t *cobj_handle(val cobj, val cls_sym); struct cobj_ops *cobj_ops(val cobj, val cls_sym); val cptr(mem_t *ptr); +val cptr_typed(mem_t *handle, val type_sym, struct cobj_ops *ops); +val cptrp(val obj); +val cptr_type(val cptr); val cptr_int(val n); val cptr_obj(val obj); val cptr_zap(val cptr); val cptr_free(val cptr); mem_t *cptr_get(val cptr); -mem_t **cptr_addr_of(val cptr); +mem_t *cptr_handle(val cobj, val type_sym, val self); +mem_t **cptr_addr_of(val cptr, val type_sym, val self); val assoc(val key, val list); val assql(val key, val list); val rassoc(val key, val list); @@ -110,6 +110,10 @@ val utsname_s, sysname_s, nodename_s, release_s, version_s, machine_s; val domainname_s; #endif +#if HAVE_DLOPEN +val dlhandle_s, dlsym_s; +#endif + static val at_exit_list; static val errno_wrap(val newval) @@ -1467,7 +1471,7 @@ static void cptr_dl_destroy_op(val obj) static struct cobj_ops cptr_dl_ops = { cobj_equal_handle_op, - cobj_print_op, + cptr_print_op, cptr_dl_destroy_op, cobj_mark_op, cobj_handle_hash_op @@ -1488,15 +1492,16 @@ static val dlopen_wrap(val name, val flags) else uw_throwf(error_s, lit("dlopen failed on ~a"), name, nao); } - return cobj(ptr, cptr_s, &cptr_dl_ops); + return cptr_typed(ptr, dlhandle_s, &cptr_dl_ops); } static val dlclose_wrap(val cptr) { - mem_t *ptr = cptr_get(cptr); + val self = lit("dlclose"); + mem_t *ptr = cptr_handle(cptr, dlhandle_s, self); if (cptr->co.ops != &cptr_dl_ops) - uw_throwf(error_s, lit("dlclose: object ~s isn't a handle from dlopen"), - cptr, nao); + uw_throwf(error_s, lit("~s: object ~s isn't a handle from dlopen"), + self, cptr, nao); if (ptr != 0) { int res = dlclose(ptr); cptr->co.handle = 0; @@ -1507,12 +1512,13 @@ static val dlclose_wrap(val cptr) static val dlsym_wrap(val dlptr, val name) { + val self = lit("dlsym"); const wchar_t *name_ws = c_str(name); char *name_u8 = utf8_dup_to(name_ws); - mem_t *dl = cptr_get(dlptr); + mem_t *dl = cptr_handle(dlptr, dlhandle_s, self); mem_t *sym = coerce(mem_t *, dlsym(dl, name_u8)); free(name_u8); - return cptr(sym); + return cptr_typed(sym, dlsym_s, 0); } static void dlsym_error(val dlptr, val name, val self) @@ -1527,15 +1533,18 @@ static void dlsym_error(val dlptr, val name, val self) static val dlsym_checked(val dlptr, val name) { + val self = lit("dlsym-checked"); val ptr = (dlerror(), dlsym_wrap(dlptr, name)); - if (cptr_get(ptr) == 0) - dlsym_error(dlptr, name, lit("dlsym-checked")); + if (cptr_handle(ptr, dlsym_s, self) == 0) + dlsym_error(dlptr, name, self); return ptr; } #if HAVE_DLVSYM static val dlvsym_wrap(val dlptr, val name, val ver) { + val self = lit("dlvsym"); + if (null_or_missing_p(ver)) { return dlsym_wrap(dlptr, name); } else { @@ -1543,7 +1552,7 @@ static val dlvsym_wrap(val dlptr, val name, val ver) const wchar_t *ver_ws = c_str(ver); char *name_u8 = utf8_dup_to(name_ws); char *ver_u8 = utf8_dup_to(ver_ws); - mem_t *dl = cptr_get(dlptr); + mem_t *dl = cptr_handle(dlptr, dlhandle_s, self); mem_t *sym = coerce(mem_t *, dlvsym(dl, name_u8, ver_u8)); free(name_u8); free(ver_u8); @@ -1553,9 +1562,10 @@ static val dlvsym_wrap(val dlptr, val name, val ver) static val dlvsym_checked(val dlptr, val name, val ver) { + val self = lit("dlvsym-checked"); val ptr = (dlerror(), dlvsym_wrap(dlptr, name, ver)); - if (cptr_get(ptr) == 0) - dlsym_error(dlptr, name, lit("dlvsym-checked")); + if (cptr_handle(ptr, dlsym_s, self) == 0) + dlsym_error(dlptr, name, self); return ptr; } #endif @@ -1905,9 +1915,11 @@ void sysif_init(void) #endif #if HAVE_DLOPEN + dlhandle_s = intern(lit("dlhandle"), user_package); + dlsym_s = intern(lit("dlsym"), user_package); reg_fun(intern(lit("dlopen"), user_package), func_n2o(dlopen_wrap, 0)); reg_fun(intern(lit("dlclose"), user_package), func_n1(dlclose_wrap)); - reg_fun(intern(lit("dlsym"), user_package), func_n2(dlsym_wrap)); + reg_fun(dlsym_s, func_n2(dlsym_wrap)); reg_fun(intern(lit("dlsym-checked"), user_package), func_n2(dlsym_checked)); #if HAVE_DLVSYM reg_fun(intern(lit("dlvsym"), user_package), func_n3o(dlvsym_wrap, 2)); |