VM: bignum_to_fixnum_strict and an accompanying vm error in case the conversion fails

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 84ad2d2dcef049c93ab59a628d1f466dc827fef3..1076d34acaa63eb4d57ae56775062fe4526834e7 100755 (executable)
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -101,6 +101,9 @@ HOOK: signal-error. os ( obj -- )
     "Invalid array size: " write dup third .
     "Maximum: " write fourth 1 - . ;
 
+: fixnum-range-error. ( obj -- )
+    "Cannot convert to fixnum: " write third . ;
+
 : c-string-error. ( obj -- )
     "Cannot convert to C string: " write third . ;
 
@@ -156,6 +159,7 @@ PREDICATE: vm-error < array
         [ divide-by-zero-error.   ]
         [ signal-error.           ]
         [ array-size-error.       ]
+        [ fixnum-range-error.     ]
         [ c-string-error.         ]
         [ ffi-error.              ]
         [ undefined-symbol-error. ]

diff --git a/core/arrays/arrays-tests.factor b/core/arrays/arrays-tests.factor
index 415a2f37f9709cb76d1321ddbaa2b00c040a4d28..37596a116a3dc41d92d388089f0ce47a82a2c7d8 100644 (file)
--- a/core/arrays/arrays-tests.factor
+++ b/core/arrays/arrays-tests.factor
@@ -19,3 +19,5 @@ IN: arrays.tests
 
 [ -1 f <array> ] must-fail
 [ cell-bits cell log2 - 2^ f <array> ] must-fail
+! To big for a fixnum #1045
+[ 67 2^ 3 <array> ] must-fail

diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 22800c8324f43d8b07a4ae5e67f117f187abd4d7..b2b1109183de38e20270e6268669f512f74cad69 100644 (file)
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -383,6 +383,17 @@ BIGNUM_TO_FOO(fixnum, fixnum, fixnum, cell)
 BIGNUM_TO_FOO(long_long, int64_t, int64_t, uint64_t)
 BIGNUM_TO_FOO(ulong_long, uint64_t, int64_t, uint64_t)
 
+/* does allocate memory */
+fixnum factor_vm::bignum_to_fixnum_strict(bignum* bignum_in) {
+  fixnum fix = bignum_to_fixnum(bignum_in);
+  bignum* bignum_out = fixnum_to_bignum(fix);
+  GC_BIGNUM(bignum_out);
+  if (bignum_compare(bignum_in, bignum_out) != bignum_comparison_equal) {
+    general_error(ERROR_OUT_OF_FIXNUM_RANGE, tag<bignum>(bignum_in), false_object);
+  }
+  return fix;
+}
+
 #define DTB_WRITE_DIGIT(factor)                \
   {                                            \
     significand *= (factor);                   \

diff --git a/vm/errors.hpp b/vm/errors.hpp
index b30a188980290dd1d150cf4040f47b0cf19f0394..8d01571ee05584ef56baffa75256bd79ebca4195 100644 (file)
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@@ -1,6 +1,7 @@
 namespace factor {
 
 // Runtime errors must be kept in sync with:
+//   basis/debugger/debugger.factor
 //   core/kernel/kernel.factor
 enum vm_error_type {
   ERROR_EXPIRED = 0,
@@ -10,6 +11,7 @@ enum vm_error_type {
   ERROR_DIVIDE_BY_ZERO,
   ERROR_SIGNAL,
   ERROR_ARRAY_SIZE,
+  ERROR_OUT_OF_FIXNUM_RANGE,
   ERROR_C_STRING,
   ERROR_FFI,
   ERROR_UNDEFINED_SYMBOL,

diff --git a/vm/math.cpp b/vm/math.cpp
index 8b99895e39fee401908758fb33b344621b16cf8a..71ba13b803bd95cd09699c1e917146fda0b54fb3 100644 (file)
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -277,13 +277,13 @@ void factor_vm::primitive_bits_double() {
   ctx->push(allot_float(bits_double(to_unsigned_8(ctx->pop()))));
 }
 
-/* Cannot allocate */
+/* Allocates memory */
 fixnum factor_vm::to_fixnum(cell tagged) {
   switch (TAG(tagged)) {
     case FIXNUM_TYPE:
       return untag_fixnum(tagged);
     case BIGNUM_TYPE:
-      return bignum_to_fixnum(untag<bignum>(tagged));
+      return bignum_to_fixnum_strict(untag<bignum>(tagged));
     default:
       type_error(FIXNUM_TYPE, tagged);
       return 0; /* can't happen */

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 73241a2c94468e7ad1dd64b576543478e1c1e685..dfc014f282f736d8b8807cc92c41d78ac40d9e62 100644 (file)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -239,6 +239,7 @@ struct factor_vm {
   bignum* bignum_quotient(bignum* numerator, bignum* denominator);
   bignum* bignum_remainder(bignum* numerator, bignum* denominator);
   cell bignum_to_cell(bignum* bignum);
+  fixnum bignum_to_fixnum_strict(bignum* bignum);
   fixnum bignum_to_fixnum(bignum* bignum);
   int64_t bignum_to_long_long(bignum* bignum);
   uint64_t bignum_to_ulong_long(bignum* bignum);
@@ -505,7 +506,6 @@ struct factor_vm {
   void primitive_bignum_bitp();
   void primitive_bignum_log2();
   inline cell unbox_array_size();
-  cell unbox_array_size_slow();
   void primitive_fixnum_to_float();
   void primitive_format_float();
   void primitive_float_eq();