From d19d3af151798c90e967276bd4f03d7db5536056 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 20 Dec 2011 11:13:17 -0800
Subject: * eval.c (eval_init): New functions registered as intrinsics.

* lib.c (copy_vec, sub_vec): New functions.

* lib.h (copy_vec, sub_vec): Declared.

* txr.1: Stub sections created.
---
 ChangeLog | 10 ++++++++++
 eval.c    |  2 ++
 lib.c     | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 lib.h     |  2 ++
 txr.1     |  4 ++++
 5 files changed, 68 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 18fad555..11edcfce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2011-12-20  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): New functions registered as intrinsics.
+
+	* lib.c (copy_vec, sub_vec): New functions.
+
+	* lib.h (copy_vec, sub_vec): Declared.
+
+	* txr.1: Stub sections created.
+
 2011-12-19  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 049
diff --git a/eval.c b/eval.c
index 3052f2db..f67b21af 100644
--- a/eval.c
+++ b/eval.c
@@ -1388,6 +1388,8 @@ void eval_init(void)
   reg_fun(intern(lit("size-vec"), user_package), func_n1(size_vec));
   reg_fun(intern(lit("vector-list"), user_package), func_n1(vector_list));
   reg_fun(intern(lit("list-vector"), user_package), func_n1(list_vector));
+  reg_fun(intern(lit("copy-vec"), user_package), func_n1(copy_vec));
+  reg_fun(intern(lit("sub-vec"), user_package), func_n3(sub_vec));
 
   reg_fun(intern(lit("assoc"), user_package), func_n2(assoc));
   reg_fun(intern(lit("assq"), user_package), func_n2(assq));
diff --git a/lib.c b/lib.c
index 61c7bb49..476e9353 100644
--- a/lib.c
+++ b/lib.c
@@ -2403,6 +2403,56 @@ val list_vector(val vec)
   return list;
 }
 
+val copy_vec(val vec_in)
+{
+  val length = length_vec(vec_in);
+  cnum alloc_plus = c_num(length) + 2;
+  val vec = make_obj();
+  val *v = (val *) chk_malloc(alloc_plus * sizeof *v);
+#ifdef HAVE_VALGRIND
+  vec->v.vec_true_start = v;
+#endif
+  v += 2;
+  vec->v.type = VEC;
+  vec->v.vec = v;
+  v[vec_alloc] = length;
+  v[vec_length] = length;
+  memcpy(vec->v.vec, vec_in->v.vec, (alloc_plus - 2) * sizeof *vec->v.vec);
+  return vec;
+}
+
+val sub_vec(val vec_in, val from, val to)
+{
+  val len = length_vec(vec_in);
+
+  if (from == nil || lt(from, zero))
+    from = zero;
+  if (to == nil)
+    to = length_vec(vec_in);
+  else if (lt(to, zero))
+    to = zero;
+  from = min2(from, len);
+  to = min2(to, len);
+
+  if (ge(from, to)) {
+    return vector(zero);
+  } else {
+    cnum cfrom = c_num(from);
+    size_t nelem = c_num(to) - cfrom;
+    val vec = make_obj();
+    val *v = (val *) chk_malloc((nelem + 2) * sizeof *v);
+#ifdef HAVE_VALGRIND
+    vec->v.vec_true_start = v;
+#endif
+    v += 2;
+    vec->v.type = VEC;
+    vec->v.vec = v;
+    v[vec_length] = v[vec_alloc] = num(nelem);
+    memcpy(vec->v.vec, vec_in->v.vec + cfrom, nelem * sizeof *vec->v.vec);
+    return vec;
+  }
+}
+
 static val lazy_stream_func(val env, val lcons)
 {
   val stream = car(env);
diff --git a/lib.h b/lib.h
index 3c9781b0..9224d17b 100644
--- a/lib.h
+++ b/lib.h
@@ -503,6 +503,8 @@ val length_vec(val vec);
 val size_vec(val vec);
 val vector_list(val list);
 val list_vector(val vector);
+val copy_vec(val vec);
+val sub_vec(val vec_in, val from, val to);
 val lazy_stream_cons(val stream);
 val lazy_str(val list, val term, val limit);
 val lazy_str_force_upto(val lstr, val index);
diff --git a/txr.1 b/txr.1
index 1c20a54b..456a665e 100644
--- a/txr.1
+++ b/txr.1
@@ -5664,6 +5664,10 @@ yields (1 2 3 4 5). In TXR Lisp, this usage can be simulated using
 
 .SS Function list-vector
 
+.SS Function copy-vec
+
+.SS Function sub-vec
+
 .SS Function assoc
 
 .SS Function assq
-- 
cgit v1.2.3