0.8.2.32:

        * Provide cross-compiler versions of several internal
          functions;
        * BIGNUM-LOGNOT VOP is the same as LOGNOT-MOD32.

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index eb57e41..a0fe12d 100644 (file)
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -119,3 +119,19 @@
 (defun symbol-hash (symbol)
   (declare (type symbol symbol))
   (sxhash symbol))
+
+;;; These functions are needed for constant-folding.
+(defun sb!kernel:simple-array-nil-p (object)
+  (typep object '(simple-array nil)))
+
+(defun sb!kernel:%negate (number)
+  (- number))
+
+(defun sb!kernel:%single-float (number)
+  (coerce number 'single-float))
+
+(defun sb!kernel:%double-float (number)
+  (coerce number 'double-float))
+
+(defun sb!kernel:%ldb (size posn integer)
+  (ldb (byte size posn) integer))

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 221743f..6e868c2 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -753,7 +753,11 @@
                    ;; cross-compiler can't fold it because the
                    ;; cross-compiler doesn't know how to evaluate it.
                    #+sb-xc-host
-                   (fboundp (combination-fun-source-name node)))
+                   (or (fboundp (combination-fun-source-name node))
+                        (progn (format t ";;; !!! Unbound fun: (~S~{ ~S~})~%"
+                                       (combination-fun-source-name node)
+                                       (mapcar #'continuation-value args))
+                               nil)))
           (constant-fold-call node)
           (return-from ir1-optimize-combination)))
 

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 355ef96..bda707f 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2442,18 +2442,20 @@
 \f
 ;;; Modular functions
 
-;;; (ldb (byte s 0) (foo x y ...)) =
+;;; (ldb (byte s 0) (foo                 x  y ...)) =
 ;;; (ldb (byte s 0) (foo (ldb (byte s 0) x) y ...))
 ;;;
-;;; and similar for other arguments. If
-;;;
-;;; (ldb (byte s 0) (foo x y ...)) =
-;;; (foo (ldb (byte s 0) x) (ldb (byte s 0) y) ...)
-;;;
-;;; the function FOO is :GOOD.
+;;; and similar for other arguments.
 
 ;;; Try to recursively cut all uses of the continuation CONT to WIDTH
 ;;; bits.
+;;;
+;;; For good functions, we just recursively cut arguments; their
+;;; "goodness" means that the result will not increase (in the
+;;; (unsigned-byte +infinity) sense). An ordinary modular function is
+;;; replaced with the version, cutting its result to WIDTH or more
+;;; bits. If we have changed anything, we need to flush old derived
+;;; types, because they have nothing in common with the new code.
 (defun cut-to-width (cont width)
   (declare (type continuation cont) (type (integer 0) width))
   (labels ((reoptimize-node (node name)

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index dc00bd5..bb52d48 100644 (file)
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -1037,6 +1037,41 @@
     (move ecx amount)
     (inst shl r :cl)))
 \f
+;;;; Modular functions
+
+(define-modular-fun +-mod32 (x y) + 32)
+(define-vop (fast-+-mod32/unsigned=>unsigned fast-+/unsigned=>unsigned)
+  (:translate +-mod32))
+(define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
+  (:translate +-mod32))
+
+;;; logical operations
+(define-modular-fun lognot-mod32 (x) lognot 32)
+(define-vop (lognot-mod32/unsigned=>unsigned)
+  (:translate lognot-mod32)
+  (:args (x :scs (unsigned-reg unsigned-stack) :target r
+           :load-if (not (and (sc-is x unsigned-stack)
+                              (sc-is r unsigned-stack)
+                              (location= x r)))))
+  (:arg-types unsigned-num)
+  (:results (r :scs (unsigned-reg)
+              :load-if (not (and (sc-is x unsigned-stack)
+                                 (sc-is r unsigned-stack)
+                                 (location= x r)))))
+  (:result-types unsigned-num)
+  (:policy :fast-safe)
+  (:generator 1
+    (move r x)
+    (inst not r)))
+
+(define-modular-fun logxor-mod32 (x y) logxor 32)
+(define-vop (fast-logxor-mod32/unsigned=>unsigned
+             fast-logxor/unsigned=>unsigned)
+  (:translate logxor-mod32))
+(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
+             fast-logxor-c/unsigned=>unsigned)
+  (:translate logxor-mod32))
+\f
 ;;;; bignum stuff
 
 (define-vop (bignum-length get-header-data)
@@ -1176,17 +1211,8 @@
     (move hi edx)
     (move lo eax)))
 
-(define-vop (bignum-lognot)
-  (:translate sb!bignum::%lognot)
-  (:policy :fast-safe)
-  (:args (x :scs (unsigned-reg unsigned-stack) :target r))
-  (:arg-types unsigned-num)
-  (:results (r :scs (unsigned-reg)
-              :load-if (not (location= x r))))
-  (:result-types unsigned-num)
-  (:generator 1
-    (move r x)
-    (inst not r)))
+(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
+  (:translate sb!bignum::%lognot))
 
 (define-vop (fixnum-to-digit)
   (:translate sb!bignum::%fixnum-to-digit)
@@ -1347,37 +1373,3 @@
     (inst mov tmp y)
     (inst shr tmp 18)
     (inst xor y tmp)))
-\f
-;;;; Modular functions
-(define-modular-fun +-mod32 (x y) + 32)
-(define-vop (fast-+-mod32/unsigned=>unsigned fast-+/unsigned=>unsigned)
-  (:translate +-mod32))
-(define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
-  (:translate +-mod32))
-
-;;; logical operations
-(define-modular-fun lognot-mod32 (x) lognot 32)
-(define-vop (lognot-mod32/unsigned=>unsigned)
-  (:translate lognot-mod32)
-  (:args (x :scs (unsigned-reg) :target r
-           :load-if (not (and (sc-is x unsigned-stack)
-                              (sc-is r unsigned-stack)
-                              (location= x r)))))
-  (:arg-types unsigned-num)
-  (:results (r :scs (unsigned-reg)
-              :load-if (not (and (sc-is x unsigned-stack)
-                                 (sc-is r unsigned-stack)
-                                 (location= x r)))))
-  (:result-types unsigned-num)
-  (:policy :fast-safe)
-  (:generator 1
-    (move r x)
-    (inst not r)))
-
-(define-modular-fun logxor-mod32 (x y) logxor 32)
-(define-vop (fast-logxor-mod32/unsigned=>unsigned
-             fast-logxor/unsigned=>unsigned)
-  (:translate logxor-mod32))
-(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
-             fast-logxor-c/unsigned=>unsigned)
-  (:translate logxor-mod32))

diff --git a/version.lisp-expr b/version.lisp-expr
index 7fc2fd3..55e30a9 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.31"
+"0.8.2.32"