From 89a170c26c916c05712ab7ab1d3b92ebe41a440a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 22 Mar 2020 18:44:12 -0700
Subject: New type args with DARG type code.

An object of args type captures into the heap the "struct
args" argument list that normally appears only on the stack.
Such an object also has space for a car and cdr field,
which can come in handy.

* args.c (dyn_args): New function: hoist a struct args *
into an args heap object.

* args.h (dyn_args): Declared.

* gc.c (finalize, mark_obj): Handle DARGS type code.

* hash.c (equal_hash): Handle DARG via eq equivalence.

* lib.c (args_s): New symbol variable.
(code2type): Map DARG to args symbol.
(equal): Handle DARG type, using eq equivalence for now.
(obj_init): Initialize args_s with interned symbol.

* lib.h (enum type, type_t): New type code, DARG.
(struct dyn_args): New struct.
(union obj): New member, a of type struct dyn_args.

* txr.1: Documented args type under typeof.
---
 args.c | 15 +++++++++++++++
 args.h |  1 +
 gc.c   | 19 +++++++++++++++++++
 hash.c |  1 +
 lib.c  |  6 +++++-
 lib.h  | 10 +++++++++-
 txr.1  |  3 +++
 7 files changed, 53 insertions(+), 2 deletions(-)

diff --git a/args.c b/args.c
index 3a1319f3..22c9fadd 100644
--- a/args.c
+++ b/args.c
@@ -198,3 +198,18 @@ void args_keys_extract(struct args *args, struct args_bool_key *akv, int n)
     args_for_each(args, args_key_check_store, coerce(mem_t *, &acx));
   }
 }
+
+val dyn_args(struct args *args, val car, val cdr)
+{
+  size_t size = offsetof(struct args, arg) + sizeof (val) * args->argc;
+  struct args *copy = coerce(struct args *, chk_copy_obj(coerce(mem_t *, args),
+                                                         size));
+  val obj = make_obj();
+
+  obj->a.type = DARG;
+  obj->a.car = car;
+  obj->a.cdr = cdr;
+  obj->a.args = copy;
+
+  return obj;
+}
diff --git a/args.h b/args.h
index e721629c..13296ac8 100644
--- a/args.h
+++ b/args.h
@@ -189,3 +189,4 @@ void args_for_each(struct args *args,
                    int (*fn)(val arg, int ix, mem_t *ctx),
                    mem_t *ctx);
 void args_keys_extract(struct args *args, struct args_bool_key *, int n);
+val dyn_args(struct args *args, val car, val cdr);
diff --git a/gc.c b/gc.c
index df9de0fb..a945f7fd 100644
--- a/gc.c
+++ b/gc.c
@@ -44,6 +44,7 @@
 #include "gc.h"
 #include "signal.h"
 #include "unwind.h"
+#include "args.h"
 
 #define PROT_STACK_SIZE         1024
 
@@ -304,6 +305,10 @@ static void finalize(val obj)
       obj->b.data = 0;
     }
     return;
+  case DARG:
+    free(obj->a.args);
+    obj->a.args = 0;
+    return;
   }
 
   assert (0 && "corrupt type field");
@@ -428,6 +433,20 @@ tail_call:
     mark_obj(obj->tn.left);
     mark_obj(obj->tn.right);
     mark_obj_tail(obj->tn.key);
+  case DARG:
+    {
+      struct args *args = obj->a.args;
+      cnum i, n = args->fill;
+      val *arg = args->arg;
+
+      mark_obj(obj->a.car);
+      mark_obj(obj->a.cdr);
+
+      for (i = 0; i < n; i++)
+        mark_obj(arg[i]);
+
+      mark_obj_tail(args->list);
+    }
   }
 
   assert (0 && "corrupt type field");
diff --git a/hash.c b/hash.c
index 69b98c1a..9f4df00b 100644
--- a/hash.c
+++ b/hash.c
@@ -218,6 +218,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
   case SYM:
   case PKG:
   case ENV:
+  case DARG:
     switch (CHAR_BIT * sizeof (mem_t *)) {
     case 32:
       return coerce(ucnum, obj) >> 4;
diff --git a/lib.c b/lib.c
index 8d0fc67c..3dce3750 100644
--- a/lib.c
+++ b/lib.c
@@ -95,7 +95,7 @@ val package_s, system_package_s, keyword_package_s, user_package_s;
 val null_s, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
 val lit_s, stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
 val atom_s, integer_s, number_s, sequence_s, string_s;
-val env_s, bignum_s, float_s, range_s, rcons_s, buf_s, tnode_s;
+val env_s, bignum_s, float_s, range_s, rcons_s, buf_s, tnode_s, args_s;
 val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 val nongreedy_s;
 val quote_s, qquote_s, unquote_s, splice_s;
@@ -196,6 +196,7 @@ static val code2type(int code)
   case RNG: return range_s;
   case BUF: return buf_s;
   case TNOD: return tnode_s;
+  case DARG: return args_s;
   }
   return nil;
 }
@@ -2884,6 +2885,8 @@ val equal(val left, val right)
   case CPTR:
     if (type(right) == CPTR && left->co.ops == right->co.ops)
       return left->co.ops->equal(left, right);
+  case DARG:
+    break;
   }
 
   if (type(right) != COBJ)
@@ -11216,6 +11219,7 @@ static void obj_init(void)
   rcons_s = intern(lit("rcons"), user_package);
   buf_s = intern(lit("buf"), user_package);
   tnode_s = intern(lit("tnode"), user_package);
+  args_s = intern(lit("args"), user_package);
   var_s = intern(lit("var"), system_package);
   expr_s = intern(lit("expr"), system_package);
   regex_s = intern(lit("regex"), user_package);
diff --git a/lib.h b/lib.h
index dfc73e98..6c5b17ef 100644
--- a/lib.h
+++ b/lib.h
@@ -67,7 +67,7 @@ typedef double_uintptr_t dbl_ucnum;
 typedef enum type {
   NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
   STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
-  BGNUM, FLNUM, RNG, BUF, TNOD, MAXTYPE = TNOD
+  BGNUM, FLNUM, RNG, BUF, TNOD, DARG, MAXTYPE = TNOD
   /* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */
 } type_t;
 
@@ -243,6 +243,13 @@ struct cobj {
   val cls;
 };
 
+struct dyn_args {
+  obj_common;
+  val car;
+  val cdr;
+  struct args *args;
+};
+
 struct strm_ctx;
 
 struct cobj_ops {
@@ -327,6 +334,7 @@ union obj {
   struct range rn;
   struct buf b;
   struct tnod tn;
+  struct dyn_args a;
 };
 
 #if CONFIG_GEN_GC
diff --git a/txr.1 b/txr.1
index 16360203..75b63b98 100644
--- a/txr.1
+++ b/txr.1
@@ -17709,6 +17709,9 @@ Regular expression object.
 .coIP struct-type
 A structure type: the type of any one of the values which represents
 a structure type.
+
+.coIP args
+Function argument list represented as an object.
 .PP
 
 There are more kinds of objects, such as user-defined structures.
-- 
cgit v1.2.3