From a9a52d917462be87eb5c454fe1bda9881bed0dc9 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Tue, 3 Jun 2014 18:52:38 +0200
Subject: [PATCH] VM: bignum_to_fixnum_strict and an accompanying vm error in
 case the conversion fails

---
 basis/debugger/debugger.factor  |  4 ++++
 core/arrays/arrays-tests.factor |  2 ++
 vm/bignum.cpp                   | 11 +++++++++++
 vm/errors.hpp                   |  2 ++
 vm/math.cpp                     |  4 ++--
 vm/vm.hpp                       |  2 +-
 6 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 84ad2d2dce..1076d34aca 100755
--- 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 415a2f37f9..37596a116a 100644
--- 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 22800c8324..b2b1109183 100644
--- 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 b30a188980..8d01571ee0 100644
--- 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 8b99895e39..71ba13b803 100644
--- 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 73241a2c94..dfc014f282 100644
--- 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();
-- 
2.34.1