From 1476586427d13b59571fa2c2a0d3836496b4c803 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sat, 16 Aug 2003 06:48:38 +0000 Subject: [PATCH] 0.8.2.32: * Provide cross-compiler versions of several internal functions; * BIGNUM-LOGNOT VOP is the same as LOGNOT-MOD32. --- src/code/cross-misc.lisp | 16 +++++++++ src/compiler/ir1opt.lisp | 6 +++- src/compiler/srctran.lisp | 16 +++++---- src/compiler/x86/arith.lisp | 82 +++++++++++++++++++------------------------ version.lisp-expr | 2 +- 5 files changed, 68 insertions(+), 54 deletions(-) diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index eb57e41..a0fe12d 100644 --- 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 --- 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 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2442,18 +2442,20 @@ ;;; 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 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1037,6 +1037,41 @@ (move ecx amount) (inst shl r :cl))) +;;;; 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)) + ;;;; 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))) - -;;;; 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 --- 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" -- 1.7.10.4