From 3056d26a9dc9af6a6c9ba2d2ba59746ba3d18f7e Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sat, 1 Dec 2007 05:38:09 -0500
Subject: [PATCH] Moved implementation of safe make-vector to foreign-call.

---
 scheme/last-revision               |  2 +-
 scheme/pass-specify-rep-primops.ss |  8 ++++++++
 src/ikarus-runtime.c               | 30 ++++++++++++++++++++++++++++++
 3 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/scheme/last-revision b/scheme/last-revision
index 1b66bc1..d94081a 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1159
+1160
diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss
index 83b6542..ec02df4 100644
--- a/scheme/pass-specify-rep-primops.ss
+++ b/scheme/pass-specify-rep-primops.ss
@@ -358,6 +358,14 @@
   [(P len) (K #t)]
   [(E len) (nop)])
 
+(define-primop make-vector safe
+  [(V len) 
+   (with-tmp ([x (make-forcall "ikrt_make_vector1" (list (T len)))]) 
+      (interrupt-when (prm '= x (K 0)))
+      x)])
+
+
+
 (define-primop $vector-ref unsafe
   [(V x i)
    (or 
diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c
index 2c64da5..472f5a9 100644
--- a/src/ikarus-runtime.c
+++ b/src/ikarus-runtime.c
@@ -1055,6 +1055,36 @@ ikrt_getenv(ikp bv, ikpcb* pcb){
   }
 }
 
+ikp 
+ikrt_make_vector1(ikp len, ikpcb* pcb){
+  if(is_fixnum(len) && (((int)len) >= 0)){
+    ikp s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data));
+    ref(s, 0) = len;
+    memset(s+disp_vector_data, 0, (int)len);
+    return s+vector_tag;
+  } else {
+    return 0;
+  }
+}
+
+#if 0
+ikp 
+ikrt_make_vector2(ikp len, ikp obj, ikpcb* pcb){
+  if(is_fixnum(len) && ((len >> 31)!=0)){
+    pcb->root0 = &obj;
+    ikp s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data));
+    pcb->root0 = 0;
+    ref(s, 0) = len;
+
+    memset(s+disp_vector_data, 0, (int)len);
+    return s+vector_tag;
+  } else {
+    return false_object;
+  }
+}
+#endif
+
+
 ikp 
 ikrt_setenv(ikp key, ikp val, ikp overwrite){
   fprintf(stderr, "setenv busted!\n");