summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2022-01-28 07:42:10 -0800
committerKaz Kylheku <kaz@kylheku.com>2022-01-28 07:42:10 -0800
commitcc413849fc0b92fee3c33ffd16378ca6ffa1070d (patch)
tree1daeb8be5180accdf97323595f2bbb3b72674f5d
parentd18bf6605613cc0eb8038d1e42f5faac37510a1a (diff)
downloadtxr-cc413849fc0b92fee3c33ffd16378ca6ffa1070d.tar.gz
txr-cc413849fc0b92fee3c33ffd16378ca6ffa1070d.tar.bz2
txr-cc413849fc0b92fee3c33ffd16378ca6ffa1070d.zip
New function: copy-cptr.
* eval.c (eval_init): copy-cptr intrinsic registered. * lib.c (copy_cptr): New function. (copy): Use copy_cptr for CPTR objects. * lib.h (copy_cptr): Declared. * tests/017/ffi-misc.tl: New test cases. * txr.1: Documented. * stdlib/doc-syms.tl: Updated.
-rw-r--r--eval.c1
-rw-r--r--lib.c8
-rw-r--r--lib.h1
-rw-r--r--stdlib/doc-syms.tl1
-rw-r--r--tests/017/ffi-misc.tl5
-rw-r--r--txr.120
6 files changed, 35 insertions, 1 deletions
diff --git a/eval.c b/eval.c
index d7e38d88..dc0c97b3 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/lib.c b/lib.c
index 488cb0dd..03d6cead 100644
--- a/lib.c
+++ b/lib.c
@@ -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);
diff --git a/lib.h b/lib.h
index a8c2b9b9..972f97d2 100644
--- a/lib.h
+++ b/lib.h
@@ -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)
diff --git a/txr.1 b/txr.1
index d6c7f39d..81ee2846 100644
--- a/txr.1
+++ b/txr.1
@@ -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 )