From 428eb38cf4c0b2c1677a88aed6f7fc2d78903538 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 19 Apr 2019 19:03:01 -0700
Subject: New function: allocate-struct.

* struct.c (struct_init): allocate-struct intrinsic
registered.
(allocate_struct): New static function.

* txr.1: Documented.
---
 struct.c | 17 +++++++++++++++++
 txr.1    | 24 ++++++++++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/struct.c b/struct.c
index 494ae025..5ea77869 100644
--- a/struct.c
+++ b/struct.c
@@ -114,6 +114,7 @@ static val make_struct_type_compat(val name, val super, val slots,
                                    val initfun, val boactor);
 static val call_super_method(val inst, val sym, struct args *);
 static val call_super_fun(val type, val sym, struct args *);
+static val allocate_struct(val type);
 
 void struct_init(void)
 {
@@ -157,6 +158,7 @@ void struct_init(void)
   reg_fun(intern(lit("make-lazy-struct"), user_package),
           func_n2(make_lazy_struct));
   reg_fun(make_struct_lit_s, func_n2(make_struct_lit));
+  reg_fun(intern(lit("allocate-struct"), user_package), func_n1(allocate_struct));
   reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
   reg_fun(intern(lit("replace-struct"), user_package), func_n2(replace_struct));
   reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1));
@@ -514,6 +516,21 @@ static void call_postinitfun_chain(struct struct_type *st, val strct)
   }
 }
 
+static val allocate_struct(val type)
+{
+  val self = lit("allocate-struct");
+  struct struct_type *st = stype_handle(&type, self);
+  cnum nslots = st->nslots;
+  size_t size = offsetof(struct struct_inst, slot) + sizeof (val) * nslots;
+  struct struct_inst *si = coerce(struct struct_inst *, chk_calloc(1, size));
+  si->type = st;
+  si->id = st->id;
+  si->lazy = 0;
+  si->dirty = 1;
+  bug_unless (type == st->self);
+  return cobj(coerce(mem_t *, si), st->name, &struct_inst_ops);
+}
+
 static val make_struct_impl(val self, val type,
                             struct args *plist, struct args *args)
 {
diff --git a/txr.1 b/txr.1
index 031837c2..d42ff4ea 100644
--- a/txr.1
+++ b/txr.1
@@ -25126,6 +25126,30 @@ The following equivalences hold:
   <-->  (make-struct a nil v0 v1 v2 ...)
 .brev
 
+.coNP Function @ allocate-struct
+.synb
+.mets (allocate-struct << type )
+.syne
+.desc
+The
+.code allocate-struct
+provides a low-level allocator for structure objects.
+
+The
+.meta type
+argument must either be a
+.code struct-type
+object, or else a symbol which is the name of a structure.
+
+The
+.code allocate-struct
+creates and returns a new instance of
+.meta type
+all of whose instance slots take on the value
+.codn nil .
+No initializations are performed. The struct type's
+registered initialization functions are not invoked.
+
 .coNP Function @ copy-struct
 .synb
 .mets (copy-struct << struct-obj )
-- 
cgit v1.2.3