0.8.21.28:

[sbcl.git] / src / compiler / aliencomp.lisp

diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp
index 56ff0f3..89771f2 100644 (file)
--- a/src/compiler/aliencomp.lisp
+++ b/src/compiler/aliencomp.lisp
@@ -346,11 +346,11 @@
     (/noshow (local-alien-info-force-to-memory-p info))
     (/noshow alien-type (unparse-alien-type alien-type) (alien-type-bits alien-type))
     (if (local-alien-info-force-to-memory-p info)
-      #!+x86 `(truly-the system-area-pointer
+      #!+(or x86 x86-64) `(truly-the system-area-pointer
                         (%primitive alloc-alien-stack-space
                                     ,(ceiling (alien-type-bits alien-type)
                                               sb!vm:n-byte-bits)))
-      #!-x86 `(truly-the system-area-pointer
+      #!-(or x86 x86-64) `(truly-the system-area-pointer
                         (%primitive alloc-number-stack-space
                                     ,(ceiling (alien-type-bits alien-type)
                                               sb!vm:n-byte-bits)))
@@ -434,10 +434,10 @@
   (let* ((info (lvar-value info))
         (alien-type (local-alien-info-type info)))
     (if (local-alien-info-force-to-memory-p info)
-      #!+x86 `(%primitive dealloc-alien-stack-space
+      #!+(or x86 x86-64) `(%primitive dealloc-alien-stack-space
                          ,(ceiling (alien-type-bits alien-type)
                                    sb!vm:n-byte-bits))
-      #!-x86 `(%primitive dealloc-number-stack-space
+      #!-(or x86 x86-64) `(%primitive dealloc-number-stack-space
                          ,(ceiling (alien-type-bits alien-type)
                                    sb!vm:n-byte-bits))
       nil)))
@@ -521,7 +521,7 @@
         (count-low-order-zeros (lvar-uses thing))))
     (combination
      (case (let ((name (lvar-fun-name (combination-fun thing))))
-             (or (modular-version-info name) name))
+             (or (modular-version-info name :unsigned) name))
        ((+ -)
        (let ((min most-positive-fixnum)
              (itype (specifier-type 'integer)))
@@ -565,7 +565,7 @@
     (give-up-ir1-transform))
   (let* ((denominator (lvar-value denominator))
         (bits (1- (integer-length denominator))))
-    (unless (= (ash 1 bits) denominator)
+    (unless (and (> denominator 0) (= (ash 1 bits) denominator))
       (give-up-ir1-transform))
     (let ((alignment (count-low-order-zeros numerator)))
       (unless (>= alignment bits)
@@ -578,7 +578,7 @@
       (give-up-ir1-transform))
     (let ((inside-fun-name (lvar-fun-name (combination-fun value-node))))
       (multiple-value-bind (prototype width)
-          (modular-version-info inside-fun-name)
+          (modular-version-info inside-fun-name :unsigned)
         (unless (eq (or prototype inside-fun-name) 'ash)
           (give-up-ir1-transform))
         (when (and width (not (constant-lvar-p amount)))
@@ -678,19 +678,19 @@
        (let* ((arg (pop args))
               (sc (tn-sc tn))
               (scn (sc-number sc))
-              #!-x86 (temp-tn (make-representation-tn (tn-primitive-type tn)
+              #!-(or x86 x86-64) (temp-tn (make-representation-tn (tn-primitive-type tn)
                                                       scn))
               (move-arg-vops (svref (sc-move-arg-vops sc) scn)))
          (aver arg)
          (unless (= (length move-arg-vops) 1)
            (error "no unique move-arg-vop for moves in SC ~S" (sc-name sc)))
-         #!+x86 (emit-move-arg-template call
+         #!+(or x86 x86-64) (emit-move-arg-template call
                                         block
                                         (first move-arg-vops)
                                         (lvar-tn call block arg)
                                         nsp
                                         tn)
-         #!-x86 (progn
+         #!-(or x86 x86-64) (progn
                   (emit-move call
                              block
                              (lvar-tn call block arg)