From 66e69f2c295be4a2c46c68d7f79e9f77f400d3b5 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sun, 31 May 2015 22:58:05 -0400
Subject: [PATCH] WIP - make-vector

Working on this, code does not compile yet due to issues with the C macro. There are still lower-level changes required to support vectors, though. Especially changes to the GC.
---
 cgen.scm  |  4 +++-
 runtime.c |  5 +++++
 runtime.h | 12 ++++++++++++
 trans.scm |  1 +
 4 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/cgen.scm b/cgen.scm
index a0712d21..c75fdc01 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -434,6 +434,7 @@
      ((eq? p 'string->number)"Cyc_string2number")
      ((eq? p 'list->string)  "Cyc_list2string")
      ((eq? p 'string->list)  "string2list")
+     ((eq? p 'make-vector)   "make_vector")
      ((eq? p 'string-append) "Cyc_string_append")
      ((eq? p 'string-cmp)    "Cyc_string_cmp")
      ((eq? p 'string->symbol) "Cyc_string2symbol")
@@ -501,6 +502,7 @@
              current-input-port open-input-file
              char->integer system string->number 
              string-append string-cmp list->string string->list
+             make-vector
              symbol->string number->string
              + - * / apply cons length cell))))
 
@@ -512,7 +514,7 @@
 ;; Does primitive allocate an object?
 (define (prim:allocates-object? exp)
     (and  (prim? exp)
-          (member exp '(string->list))))
+          (member exp '(string->list make-vector))))
 
 ;; c-compile-prim : prim-exp -> string -> string
 (define (c-compile-prim p cont)
diff --git a/runtime.c b/runtime.c
index ce446d19..c3f5ec9d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1100,6 +1100,9 @@ void _string_91append(object cont, object args) {
 void _string_91_125list(object cont, object args) {  
     string2list(lst, car(args));
     return_funcall1(cont, &lst);}
+void _make_91_125vector(object cont, object args) {
+    make_vector(v, car(args), cadr(args));
+    return_funcall1(cont, &v);}
 void _list_91_125string(object cont, object args) {  
     string_type s = Cyc_list2string(car(args));
     return_funcall1(cont, &s);}
@@ -1761,6 +1764,7 @@ static primitive_type list_91_125string_primitive = {primitive_tag, "list->strin
 static primitive_type string_91_125symbol_primitive = {primitive_tag, "string->symbol", &_string_91_125symbol};
 static primitive_type symbol_91_125string_primitive = {primitive_tag, "symbol->string", &_symbol_91_125string};
 static primitive_type number_91_125string_primitive = {primitive_tag, "number->string", &_number_91_125string};
+static primitive_type make_91_125vector_primitive = {primitive_tag, "make-vector", &_make_91_125vector};
 static primitive_type boolean_127_primitive = {primitive_tag, "boolean?", &_boolean_127};
 static primitive_type char_127_primitive = {primitive_tag, "char?", &_char_127};
 static primitive_type eof_91object_127_primitive = {primitive_tag, "eof-object?", &_eof_91object_127};
@@ -1858,6 +1862,7 @@ const object primitive_list_91_125string = &list_91_125string_primitive;
 const object primitive_string_91_125symbol = &string_91_125symbol_primitive;
 const object primitive_symbol_91_125string = &symbol_91_125string_primitive;
 const object primitive_number_91_125string = &number_91_125string_primitive;
+const object primitive_make_91_125vector = &make_91_125vector_primitive;
 const object primitive_boolean_127 = &boolean_127_primitive;
 const object primitive_char_127 = &char_127_primitive;
 const object primitive_eof_91object_127 = &eof_91object_127_primitive;
diff --git a/runtime.h b/runtime.h
index c205acbf..18a9ffd5 100644
--- a/runtime.h
+++ b/runtime.h
@@ -161,6 +161,17 @@ void do_dispatch(int argc, function_type func, object clo, object *buffer);
   } \
 }
 
+#define make_vector(v, len, fill) object v = nil; { \
+ int i; \
+ v = (object)alloca(sizeof(vector_type)); \
+ v->tag = vector_tag; \
+ v->num_elt = ((integer_type *)len)->value; \
+ v->elts = (v->num_elt > 0) ? (object *)alloca(sizeof(object) * v->num_elt): NULL; \
+ for (i = 0; i < v->num_elt; i++) { \
+   v->elts[i] = fill; \
+ } \
+}
+
 /* Global variables. */
 extern clock_t start;   /* Starting time. */
 extern char *stack_begin;   /* Initialized by main. */
@@ -264,6 +275,7 @@ extern const object primitive_list_91_125string;
 extern const object primitive_string_91_125symbol;
 extern const object primitive_symbol_91_125string;
 extern const object primitive_number_91_125string;
+extern const object primitive_make_91_125vector;
 extern const object primitive_system;
 extern const object primitive_boolean_127;
 extern const object primitive_char_127;
diff --git a/trans.scm b/trans.scm
index 0ca18ab3..0230dbfc 100644
--- a/trans.scm
+++ b/trans.scm
@@ -516,6 +516,7 @@
      string->symbol
      symbol->string
      number->string
+     make-vector
      boolean?
      char?
      eof-object?