From fb2cd92262854e829b42c8a394287f7b2c839eed Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 3 Oct 2007 17:11:52 -0400
Subject: [PATCH] datastack capture after underflow should be an ordinary error
 not a critical error

---
 core/kernel/kernel-tests.factor |  2 ++
 vm/run.c                        | 22 ++++++++++++++--------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index a160feed24..a2bb8307de 100644
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -74,3 +74,5 @@ IN: temporary
 [ 6 2 ] [ 1 2 [ 5 + ] dip ] unit-test
 
 [ ] [ callstack set-callstack ] unit-test
+
+[ 3drop datastack ] unit-test-fails
diff --git a/vm/run.c b/vm/run.c
index b6573c455c..e4201ddee5 100644
--- a/vm/run.c
+++ b/vm/run.c
@@ -218,25 +218,31 @@ DEFINE_PRIMITIVE(from_r)
 	dpush(rpop());
 }
 
-void stack_to_array(CELL bottom, CELL top)
+bool stack_to_array(CELL bottom, CELL top)
 {
 	F_FIXNUM depth = (F_FIXNUM)(top - bottom + CELLS);
 
-	if(depth < 0) critical_error("depth < 0",0);
-
-	F_ARRAY *a = allot_array_internal(ARRAY_TYPE,depth / CELLS);
-	memcpy(a + 1,(void*)bottom,depth);
-	dpush(tag_object(a));
+	if(depth < 0)
+		return false;
+	else
+	{
+		F_ARRAY *a = allot_array_internal(ARRAY_TYPE,depth / CELLS);
+		memcpy(a + 1,(void*)bottom,depth);
+		dpush(tag_object(a));
+		return true;
+	}
 }
 
 DEFINE_PRIMITIVE(datastack)
 {
-	stack_to_array(ds_bot,ds);
+	if(!stack_to_array(ds_bot,ds))
+		general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
 }
 
 DEFINE_PRIMITIVE(retainstack)
 {
-	stack_to_array(rs_bot,rs);
+	if(!stack_to_array(rs_bot,rs))
+		general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
 }
 
 /* returns pointer to top of stack */