From 858ed27eefd395fdb6f529329bf10511f4aadcaa Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 9 May 2017 06:57:46 -0700
Subject: cptr: new functions.

* eval.c (eval_init): Register cptr-int, ctpr-obj, cptr-zap
and cptr-free functions and cptr-null variable.

* lib.c (cptr_int, cptr_obj, cptr_zap, cptr_free): New
functions.

* lib.c (cptr_int, cptr_obj, cptr_zap, cptr_free): Declared.
---
 eval.c |  6 ++++++
 lib.c  | 25 +++++++++++++++++++++++++
 lib.h  |  4 ++++
 3 files changed, 35 insertions(+)

diff --git a/eval.c b/eval.c
index 60766b4b..97004bd5 100644
--- a/eval.c
+++ b/eval.c
@@ -6157,6 +6157,12 @@ void eval_init(void)
   reg_fun(intern(lit("rlcp"), user_package), func_n2(rlcp));
   reg_fun(intern(lit("rlcp-tree"), user_package), func_n2(rlcp_tree));
 
+  reg_fun(intern(lit("cptr-int"), user_package), func_n1(cptr_int));
+  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_varl(intern(lit("cptr-null"), user_package), cptr(0));
+
   eval_error_s = intern(lit("eval-error"), user_package);
   uw_register_subtype(eval_error_s, error_s);
 
diff --git a/lib.c b/lib.c
index 4de39f4e..829a9b99 100644
--- a/lib.c
+++ b/lib.c
@@ -7402,6 +7402,31 @@ val cptr(mem_t *ptr)
   return cobj(ptr, cptr_s, &cptr_ops);
 }
 
+val cptr_int(val n)
+{
+  return if3(missingp(n), cptr(0), cptr(coerce(mem_t *, c_num(n))));
+}
+
+val cptr_obj(val obj)
+{
+  return cptr(coerce(mem_t *, obj));
+}
+
+val cptr_zap(val cptr)
+{
+  (void) cobj_handle(cptr, cptr_s);
+  cptr->co.handle = 0;
+  return cptr;
+}
+
+val cptr_free(val cptr)
+{
+  (void) cobj_handle(cptr, cptr_s);
+  free(cptr->co.handle);
+  cptr->co.handle = 0;
+  return cptr;
+}
+
 mem_t *cptr_get(val cptr)
 {
   return cobj_handle(cptr, cptr_s);
diff --git a/lib.h b/lib.h
index 814b0621..b5593475 100644
--- a/lib.h
+++ b/lib.h
@@ -938,6 +938,10 @@ 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_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);
 val assoc(val key, val list);
-- 
cgit v1.2.3