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

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. ]

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

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);                   \

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,

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 */

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();