From: Alexey Dejneka Date: Sat, 9 Apr 2005 06:37:02 +0000 (+0000) Subject: 0.8.21.28: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5ecef987f3847ed5de8c03f66ef9d8ab468af993;p=sbcl.git 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 --- 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 --- 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 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 --- 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 --- 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 --- 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 --- 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"