~ chicken-core (chicken-5) 0ee85097ce2471651c6aca04c470ee728040a9d0

commit 0ee85097ce2471651c6aca04c470ee728040a9d0
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun May 21 18:54:38 2017 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu May 25 09:35:10 2017 +1200

    In the scrutinizer, do not assume big fixnums will fit into 32 bits
    
    When the scrutinizer applies a specialization for a fixnum, it should
    make sure it really is a fixnum. If compiling on a 64-bit platform, a
    fixnum literal might no longer be a fixnum when the program is running
    on a 32-bit platform.
    
    Thus, we check whether the literal is a big-fixnum? first.
    
    Similarly, small bignums are rewritten to 'integer for the reverse
    situation: when compiling on 32-bit, a bignum might become a fixnum when
    running on 64-bit.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 492546af..aa626c73 100644
--- a/NEWS
+++ b/NEWS
@@ -105,6 +105,10 @@
 - Build system
   - Fixed broken compilation on NetBSD, due to missing _NETBSD_SOURCE.
 
+- Compiler
+  - The scrutinizer no longer uses 'fixnum as the type for fixnums
+    that might not fit into a fixnum on 32-bit architectures.
+
 
 4.12.0
 
diff --git a/lfa2.scm b/lfa2.scm
index 0fd46123..e53ffe37 100644
--- a/lfa2.scm
+++ b/lfa2.scm
@@ -173,17 +173,13 @@
       ;; a simplified variant of the one in scrutinizer.scm
       (cond ((string? lit) 'string)
 	    ((symbol? lit) 'symbol)
+	    ;; Do not assume fixnum width matches target platforms!
+	    ((or (big-fixnum? lit) (small-bignum? lit)) 'integer)
 	    ((fixnum? lit) 'fixnum)
 	    ((bignum? lit) 'bignum)
 	    ((flonum? lit) 'float)
 	    ((ratnum? lit) 'ratnum)
 	    ((cplxnum? lit) 'cplxnum)
-	    ((exact-integer? lit) 'integer)
-	    ((number? lit) 
-	     (case number-type 
-	       ((fixnum) 'fixnum)
-	       ((flonum) 'flonum)
-	       (else 'number)))
 	    ((boolean? lit) 'boolean)
 	    ((null? lit) 'null)
 	    ((list? lit) 'list)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index cf7c6ad4..ee50a535 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -196,16 +196,13 @@
     (define (constant-result lit)
       (cond ((string? lit) 'string)
 	    ((symbol? lit) 'symbol)
+	    ;; Do not assume fixnum width matches target platforms!
+	    ((or (big-fixnum? lit) (small-bignum? lit)) 'integer)
 	    ((fixnum? lit) 'fixnum)
-	    ((flonum? lit) 'float)	; Why not "flonum", for consistency?
 	    ((bignum? lit) 'bignum)
+	    ((flonum? lit) 'float)	; Why not "flonum", for consistency?
 	    ((ratnum? lit) 'ratnum)
 	    ((cplxnum? lit) 'cplxnum)
-	    ((number? lit) 
-	     (case number-type 
-	       ((fixnum) 'fixnum)
-	       ((flonum) 'flonum)
-	       (else 'number)))		; in case...
 	    ((boolean? lit)
 	     (if lit 'true 'false))
 	    ((null? lit) 'null)
diff --git a/support.scm b/support.scm
index 0048836d..731c484c 100644
--- a/support.scm
+++ b/support.scm
@@ -64,7 +64,7 @@
      clear-real-name-table! get-real-name set-real-name!
      real-name real-name2 display-real-name-table
      source-info->string source-info->line call-info constant-form-eval
-     dump-nodes read-info-hook read/source-info big-fixnum?
+     dump-nodes read-info-hook read/source-info big-fixnum? small-bignum?
      hide-variable export-variable variable-hidden? variable-visible?
      mark-variable variable-mark intrinsic? predicate? foldable?
      load-identifier-database
@@ -1596,6 +1596,11 @@
        (or (fx> x 1073741823)
 	   (fx< x -1073741824) ) ) )
 
+(define (small-bignum? x) ;; XXX: This should probably be in c-platform
+  (and (bignum? x)
+       (not (feature? #:64bit))
+       (fx<= (integer-length x) 62) ) )
+
 
 ;;; symbol visibility and other global variable properties
 
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 26d36d83..b97edaf8 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -219,6 +219,7 @@
 (mx (forall (a) (procedure (#!rest a) a)) +)
 (mx (list fixnum) '(1))
 
+
 (mx port (open-input-string "foo"))
 (mx input-port (open-input-string "bar"))
 (mx port (open-output-string))
@@ -374,3 +375,22 @@
  (compiler-typecase 1
    (number #t)
    (fixnum #f)))
+
+;; Always a fixnum
+(assert
+ (compiler-typecase #x3fffffff
+   (bignum #f)
+   (fixnum #t)))
+
+;; Is a fixnum on 64-bit, bignum on 32-bit, thus type must be 'integer
+(assert
+ (compiler-typecase #x4fffffff
+   (fixnum #f)
+   (bignum #f)
+   (integer #t)))
+
+;; Always a bignum
+(assert
+ (compiler-typecase #x7fffffffffffffff
+   (fixnum #f)
+   (bignum #t)))