diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 8 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/017/ffi-misc.tl | 5 | ||||
| -rw-r--r-- | txr.1 | 20 |
6 files changed, 35 insertions, 1 deletions
@@ -7454,6 +7454,7 @@ void eval_init(void) 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("cptr-cast"), user_package), func_n2(cptr_cast)); + reg_fun(intern(lit("copy-cptr"), user_package), func_n1(copy_cptr)); reg_fun(intern(lit("int-cptr"), user_package), func_n1(int_cptr)); reg_fun(intern(lit("cptrp"), user_package), func_n1(cptrp)); reg_fun(intern(lit("cptr-type"), user_package), func_n1(cptr_type)); @@ -9779,6 +9779,12 @@ val cptr_cast(val to_type, val cptr) return cptr_typed(ptr, to_type, 0); } +val copy_cptr(val cptr) +{ + mem_t *ptr = cptr_handle(cptr, nil, lit("cptr-copy")); + return cptr_typed(ptr, cptr->cp.cls, 0); +} + val int_cptr(val cptr) { return num(coerce(cnum, cptr_handle(cptr, nil, lit("int-cptr")))); @@ -12185,6 +12191,8 @@ val copy(val seq) return copy_fun(seq); case TNOD: return copy_tnode(seq); + case CPTR: + return copy_cptr(seq); case COBJ: if (seq->co.cls == hash_cls) return copy_hash(seq); @@ -1136,6 +1136,7 @@ val cptr_buf(val buf, val type_sym); val cptr_zap(val cptr); val cptr_free(val cptr); val cptr_cast(val to_type, val cptr); +val copy_cptr(val cptr); val int_cptr(val cptr); mem_t *cptr_get(val cptr); mem_t *cptr_handle(val cobj, val type_sym, val self); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index dc8424a5..723ea9c2 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -400,6 +400,7 @@ ("copy-buf" "N-00BE75E1") ("copy-carray" "N-006593D0") ("copy-cons" "N-037EBB77") + ("copy-cptr" "N-018EBB92") ("copy-file" "N-019D6582") ("copy-files" "N-019D6582") ("copy-fun" "N-003E7671") diff --git a/tests/017/ffi-misc.tl b/tests/017/ffi-misc.tl index 377d7572..7053f78e 100644 --- a/tests/017/ffi-misc.tl +++ b/tests/017/ffi-misc.tl @@ -83,3 +83,8 @@ (each-match ((a b c) (rperm '(fals true) 3)) (let ((s (new abc a a b b c c))) (test (ffi-get (ffi-put s (ffi abc)) (ffi-abc)) s))) + +(mstest + (copy-cptr (cptr-int 3)) "#<cptr: 3>" + (copy (cptr-int 3)) "#<cptr: 3>" + (copy-cptr 3) :error) @@ -20742,6 +20742,10 @@ the type of the argument, as follows: .mono .meti (copy-tree-iter << object ) .onom +.coIP cptr +.mono +.meti (copy-cptr << object ) +.onom .RE .IP @@ -55051,7 +55055,7 @@ The .code copy-tnode function creates a new .code tnode -objects, whose +object, whose .codn key , .code left and @@ -62382,6 +62386,20 @@ circumvents the safety mechanism which .code cptr type tagging provides. +.coNP Function @ copy-cptr +.synb +.mets (cptr-copy << cptr ) +.syne +.desc +The +.code copy-cptr +function creates a new +.code cptr +object similar to +.codn cptr , +which has the same address and type symbol as +.codn cptr . + .coNP Function @ cptr-zap .synb .mets (cptr-zap << cptr ) |