svm: Fix handling of machine-constants that are larger than 32bits.

diff --git a/src/compiler/machines/svm/lapgen.scm b/src/compiler/machines/svm/lapgen.scm
index db68e654c007d55758b9e6d0a301d95410c93be1..811e68fb473d766484bfa2389fec96417ada85e8 100644 (file)
--- a/src/compiler/machines/svm/lapgen.scm
+++ b/src/compiler/machines/svm/lapgen.scm
@@ -250,14 +250,18 @@ USA.
        (let ((base (rtl:offset-base expression))
             (offset (rtl:offset-offset expression)))
         (if (rtl:register? base)
-            (or (rtl:machine-constant? offset)
+            (or (rtl:immediate-machine-constant? offset)
                 (rtl:register? offset))
             (and (rtl:offset-address? base)
-                 (rtl:machine-constant? offset)
+                 (rtl:immediate-machine-constant? offset)
                  (rtl:register? (rtl:offset-address-base base))
                  (rtl:register? (rtl:offset-address-offset base)))))
        expression))
 
+(define (rtl:immediate-machine-constant? expression)
+  (and (rtl:machine-constant? expression)
+       (immediate-integer? (rtl:machine-constant-value offset))))
+
 (define (simple-offset->ea! offset)
   (let ((base (rtl:offset-base offset))
        (offset (rtl:offset-offset offset)))
@@ -292,6 +296,7 @@ USA.
        (rule-matcher ((? scale offset-operator?)
                       (REGISTER (? base))
                       (MACHINE-CONSTANT (? offset)))
+                     (QUALIFIER (immediate-integer? offset))
                      (values scale
                              (ea:offset (word-source base) offset scale)))
        (rule-matcher ((? scale offset-operator?)
@@ -299,6 +304,7 @@ USA.
                        (REGISTER (? base))
                        (REGISTER (? index)))
                       (MACHINE-CONSTANT (? offset)))
+                     (QUALIFIER (immediate-integer? offset))
                      (values scale
                              (ea:indexed (word-source base)
                                          offset scale
@@ -308,6 +314,7 @@ USA.
                        (REGISTER (? base))
                        (MACHINE-CONSTANT (? offset)))
                       (REGISTER (? index)))
+                     (QUALIFIER (immediate-integer? offset))
                      (values scale
                              (ea:indexed (word-source base)
                                          offset scale*

diff --git a/src/compiler/machines/svm/machine.scm b/src/compiler/machines/svm/machine.scm
index 2bfea551dc5565a241c792b0ba9284e412e51d70..ae6cd502a6b573fb37259190b9e5f433ad605921 100644 (file)
--- a/src/compiler/machines/svm/machine.scm
+++ b/src/compiler/machines/svm/machine.scm
@@ -114,10 +114,13 @@ USA.
 (define-inst copy-block size size-type from to)
 
 (define (load-immediate-operand? n)
-  (or (and (exact-integer? n)
-          (<= signed-fixnum/lower-limit n) (< n signed-fixnum/upper-limit))
+  (or (immediate-integer? n)
       (flo:flonum? n)))
 
+(define (immediate-integer? n)
+  (and (exact-integer? n)
+       (<= signed-fixnum/lower-limit n) (< n signed-fixnum/upper-limit)))
+
 ;; TYPE and DATUM can be constants or registers; address is a register.
 (define-inst load-pointer target type address)
 (define-inst load-non-pointer target type datum)

diff --git a/src/compiler/machines/svm/rules.scm b/src/compiler/machines/svm/rules.scm
index a8b495de256c812927e006194391bca170d83a5c..f67f119e28c330188325d3b009cbbc4ba9824082 100644 (file)
--- a/src/compiler/machines/svm/rules.scm
+++ b/src/compiler/machines/svm/rules.scm
@@ -81,8 +81,15 @@ USA.
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (MACHINE-CONSTANT (? n)))
+  (QUALIFIER (load-immediate-operand? n))
   (inst:load-immediate (word-target target) n))
 
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (MACHINE-CONSTANT (? n)))
+  (QUALIFIER (not (load-immediate-operand? n)))
+  (load-constant (word-target target) n))
+
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (ENTRY:PROCEDURE (? label)))
@@ -539,6 +546,7 @@ USA.
                         (REGISTER (? source1))
                         (OBJECT->FLOAT (CONSTANT (? value)))
                         (? overflow?)))
+  (QUALIFIER (flo:flonum? value))
   (let ((source1 (float-source source1))
        (temp (float-temporary)))
     (LAP ,@(inst:load-immediate temp value)
@@ -1402,7 +1410,7 @@ USA.
   (CONS-POINTER (? type) (REGISTER (? datum register-known-value)))
   (QUALIFIER
    (and (rtl:object->datum? datum)
-       (rtl:constant-non-pointer? (rtl:object->datum-expression datum))))
+       (rtl:immediate-datum? (rtl:object->datum-expression datum))))
   (rtl:make-cons-non-pointer
    type
    (rtl:make-machine-constant
@@ -1415,12 +1423,14 @@ USA.
 
 (define-rule rewriting
   (OBJECT->DATUM (REGISTER (? source register-known-value)))
-  (QUALIFIER (rtl:constant-non-pointer? source))
+  (QUALIFIER (rtl:immediate-datum? source))
   (rtl:make-machine-constant (object-datum (rtl:constant-value source))))
 
-(define (rtl:constant-non-pointer? expression)
+(define (rtl:immediate-datum? expression)
   (and (rtl:constant? expression)
-       (object-non-pointer? (rtl:constant-value expression))))
+       (object-non-pointer? (rtl:constant-value expression))
+       (immediate-integer? (object-datum
+                            (rtl:constant-value expression)))))
 \f
 ;;; These rules are losers because there's no abstract way to cons a
 ;;; statement or a predicate without also getting some CFG structure.
@@ -1486,17 +1496,17 @@ USA.
 
 (define-rule rewriting
   (OBJECT->FIXNUM (REGISTER (? source register-known-value)))
-  (QUALIFIER (rtl:constant-fixnum? source))
+  (QUALIFIER (rtl:immediate-fixnum? source))
   (rtl:make-object->fixnum source))
 
 (define-rule rewriting
   (OBJECT->FIXNUM (CONSTANT (? value)))
-  (QUALIFIER (fix:fixnum? value))
+  (QUALIFIER (immediate-integer? value))
   (rtl:make-machine-constant value))
 
-(define (rtl:constant-fixnum? expression)
+(define (rtl:immediate-fixnum? expression)
   (and (rtl:constant? expression)
-       (fix:fixnum? (rtl:constant-value expression))
+       (immediate-integer? (rtl:constant-value expression))
        (rtl:constant-value expression)))
 \f
 ;;;; Flonum rewriting.