4 files changed, 46 insertions, 2 deletions
diff --git a/eval.c b/eval.c
index b85e73d0..eda2c857 100644
--- a/eval.c
+++ b/eval.c
@@ -6888,6 +6888,7 @@ void eval_init(void)
 
   reg_fun(intern(lit("cptr-int"), user_package), func_n2o(cptr_int, 1));
   reg_fun(intern(lit("cptr-obj"), user_package), func_n2o(cptr_obj, 1));
+  reg_fun(intern(lit("cptr-buf"), user_package), func_n2o(cptr_buf, 1));
   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));
diff --git a/lib.c b/lib.c
index d07a03ca..374b038a 100644
--- a/lib.c
+++ b/lib.c
@@ -7832,6 +7832,13 @@ val cptr_obj(val obj, val type_sym_in)
   return cptr_typed(coerce(mem_t *, obj), type_sym, 0);
 }
 
+val cptr_buf(val buf, val type_sym_in)
+{
+  val type_sym = default_null_arg(type_sym_in);
+  mem_t *ptr = buf_get(buf, lit("cptr-buf"));
+  return cptr_typed(ptr, type_sym, 0);
+}
+
 val cptr_zap(val cptr)
 {
   (void) cptr_handle(cptr, nil, lit("cptr-zap"));
diff --git a/lib.h b/lib.h
index 34b10123..a3e0fe82 100644
--- a/lib.h
+++ b/lib.h
@@ -1030,6 +1030,7 @@ val cptr_type(val cptr);
 val cptr_size_hint(val cptr, val size);
 val cptr_int(val n, val type_sym);
 val cptr_obj(val obj, val type_sym);
+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);
diff --git a/txr.1 b/txr.1
index 0f025e9a..8c5805e8 100644
--- a/txr.1
+++ b/txr.1
@@ -49650,13 +49650,13 @@ This symbol becomes the
 object's type tag.
 
 The lifetime of the returned
-.cptr
+.code cptr
 object is independent from that of
 .metn object .
 If the lifetime of
 .meta object
 reaches its end before that of the
-.code cptr ,
+.codn cptr ,
 the pointer stored inside the
 .code cptr
 becomes invalid.
@@ -49683,6 +49683,41 @@ type, then the expression
 reproduces
 .metn n .
 
+.coNP Function @ cptr-buf
+.synb
+.mets (cptr-obj < buf <> [ type-symbol ])
+.syne
+.desc
+The
+.code cptr-buf
+returns a
+.code cptr
+object which holds a pointer to a buffer object's storage
+area. The
+.meta buf
+argument must be of type
+.codn buf .
+
+The
+.meta type-symbol
+argument should be a symbol. If omitted, it defaults to
+.codn nil .
+This symbol becomes the
+.code cptr
+object's type tag.
+
+The lifetime of the returned
+.code cptr
+object is independent from that of
+.metn buf .
+If the lifetime of
+.meta buf
+reaches its end before that of the
+.codn cptr ,
+the pointer stored inside the
+.code cptr
+becomes invalid.
+
 .coNP Function @ cptr-cast
 .synb
 .mets (cptr-cast < type-symbol << cptr )