0.8.21.28:

        * Constant folding of undefined function now causes full
          warning in the cross-compiler as suggested by CSR.
        * Define cross-compiler versions of all modular functions.
        * Fix a constant reference in a type specifier.

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 90f5307..d7e739f 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -546,6 +546,7 @@
   ;; x pressing problems. Someday, though, it would be nice to figure out
   ;; x what the problem is and fix it.
   #!+(or ppc sparc) :ignore-failure-p)
+ ("src/code/cross-modular"  :not-target)
  ("src/compiler/target/subprim")
 
  ("src/compiler/target/debug")

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index 440c037..342bc07 100644 (file)
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -136,18 +136,6 @@
   (assert (typep array '(simple-array * (*))))
   (values array start end 0))
 
-#!-(or alpha x86-64)
-(progn
-  (defun sb!vm::ash-left-mod32 (integer amount)
-    (ldb (byte 32 0) (ash integer amount)))
-  (defun sb!vm::logxor-mod32 (x y)
-    (ldb (byte 32 0) (logxor x y)))
-  (defun sb!vm::lognot-mod32 (x)
-    (ldb (byte 32 0) (lognot x))))
-#!+(or alpha x86-64)
-(defun sb!vm::ash-left-mod64 (integer amount)
-  (ldb (byte 64 0) (ash integer amount)))
-
 ;;; package locking nops for the cross-compiler
 
 (defmacro without-package-locks (&body body)

diff --git a/src/code/cross-modular.lisp b/src/code/cross-modular.lisp
new file mode 100644 (file)
index 0000000..b89d151
--- /dev/null
+++ b/src/code/cross-modular.lisp
@@ -0,0 +1,63 @@
+;;;; cross-compile-time-only replacements for modular functions;
+;;;; needed for constant-folding
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!C")
+
+(defun mask-signed-field (size integer)
+  (cond ((zerop size)
+         0)
+        ((logbitp (1- size) integer)
+         (dpb integer (byte size 0) -1))
+        (t
+         (ldb (byte size 0) integer))))
+
+#.
+(collect ((forms))
+  (flet ((definition (name lambda-list prototype width)
+           `(defun ,name ,lambda-list
+              (ldb (byte ,width 0) (,prototype ,@lambda-list)))))
+    (loop for infos being each hash-value of (modular-class-funs *unsigned-modular-class*) using (hash-key prototype)
+          when (listp infos)
+          do (loop for info in infos
+                   for name = (modular-fun-info-name info)
+                   and width = (modular-fun-info-width info)
+                   and lambda-list = (modular-fun-info-lambda-list info)
+                   do (forms (definition name lambda-list prototype width)))))
+  `(progn ,@(forms)))
+
+#.
+(collect ((forms))
+  (flet ((definition (name lambda-list prototype width)
+           `(defun ,name ,lambda-list
+              (mask-signed-field ,width (,prototype ,@lambda-list)))))
+    (loop for infos being each hash-value of (modular-class-funs *signed-modular-class*) using (hash-key prototype)
+          when (listp infos)
+          do (loop for info in infos
+                   for name = (modular-fun-info-name info)
+                   and width = (modular-fun-info-width info)
+                   and lambda-list = (modular-fun-info-lambda-list info)
+                   do (forms (definition name lambda-list prototype width)))))
+  `(progn ,@(forms)))
+
+#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 32) '(and) '(or))
+(defun sb!vm::ash-left-mod32 (integer amount)
+  (ldb (byte 32 0) (ash integer amount)))
+#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 64) '(and) '(or))
+(defun sb!vm::ash-left-mod64 (integer amount)
+  (ldb (byte 64 0) (ash integer amount)))
+#!+x86
+(defun sb!vm::ash-left-smod30 (integer amount)
+  (mask-signed-field 30 (ash integer amount)))
+#!+x86-64
+(defun sb!vm::ash-left-smod61 (integer amount)
+  (mask-signed-field 61 (ash integer amount)))
+

diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp
index 89a44b3..d693269 100644 (file)
--- a/src/compiler/alpha/vm.lisp
+++ b/src/compiler/alpha/vm.lisp
@@ -286,7 +286,7 @@
      (sc-number-or-lose 'zero))
     (null
      (sc-number-or-lose 'null ))
-    ((or (integer sb!xc:most-negative-fixnum sb!xc:most-positive-fixnum)
+    ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
         system-area-pointer character)
      (sc-number-or-lose 'immediate ))
     (symbol

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 6517d35..4bf7285 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -681,21 +681,7 @@
                    ;; function arguments. -- WHN 19990918
                    (not (ir1-attributep attr call))
                    (every #'constant-lvar-p args)
-                   (node-lvar node)
-                   ;; Even if the function is foldable in principle,
-                   ;; it might be one of our low-level
-                   ;; implementation-specific functions. Such
-                   ;; functions don't necessarily exist at runtime on
-                   ;; a plain vanilla ANSI Common Lisp
-                   ;; cross-compilation host, in which case the
-                   ;; cross-compiler can't fold it because the
-                   ;; cross-compiler doesn't know how to evaluate it.
-                   #+sb-xc-host
-                   (or (fboundp (combination-fun-source-name node))
-                        (progn (format t ";;; !!! Unbound fun: (~S~{ ~S~})~%"
-                                       (combination-fun-source-name node)
-                                       (mapcar #'lvar-value args))
-                               nil)))
+                   (node-lvar node))
           (constant-fold-call node)
           (return-from ir1-optimize-combination)))
 

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index 9eaa71f..a721dee 100644 (file)
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -824,7 +824,7 @@
   (when (and (cast-type-check cast)
              (not (node-lvar cast)))
     ;; FIXME
-    (bug "IR2 type checking of unused values in not implemented.")
+    (bug "IR2 type checking of unused values is not implemented.")
     )
   (values))
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 1fddd51..5eecfb7 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.21.27"
+"0.8.21.28"