datastack capture after underflow should be an ordinary error not a critical error

release
Slava Pestov 2007-10-03 17:11:52 -04:00
parent fab1453bfc
commit fb2cd92262
2 changed files with 16 additions and 8 deletions

View File

@ -74,3 +74,5 @@ IN: temporary
[ 6 2 ] [ 1 2 [ 5 + ] dip ] unit-test
[ ] [ callstack set-callstack ] unit-test
[ 3drop datastack ] unit-test-fails

View File

@ -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);
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 */