From cec71f1e4e1ead387f2ea642f760e553b6053f2b Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 11 Feb 2003 15:42:34 +0000 Subject: [PATCH] 0.7.12.36: More install.sh patching ... $gnumake everywhere ... ${GNUMAKE} not $(GNUMAKE} Export FUN-INFO-DERIVE-TYPE and friends ... now DEFOPTIMIZER can work in any package that uses SB-C Install new contrib: SB-ROTATE-BYTE ... implements ... has compiler logic to do so efficiently for (byte 32 0) on x86: see the README. --- NEWS | 2 + contrib/sb-rotate-byte/Makefile | 23 ++++++++ contrib/sb-rotate-byte/README | 16 +++++ contrib/sb-rotate-byte/compiler.lisp | 56 ++++++++++++++++++ contrib/sb-rotate-byte/package.lisp | 3 + contrib/sb-rotate-byte/rotate-byte-tests.lisp | 53 +++++++++++++++++ contrib/sb-rotate-byte/rotate-byte.lisp | 22 +++++++ contrib/sb-rotate-byte/sb-rotate-byte.asd | 17 ++++++ contrib/sb-rotate-byte/x86-vm.lisp | 78 +++++++++++++++++++++++++ install.sh | 6 +- make-target-contrib.sh | 2 +- package-data-list.lisp-expr | 2 + version.lisp-expr | 2 +- 13 files changed, 277 insertions(+), 5 deletions(-) create mode 100644 contrib/sb-rotate-byte/Makefile create mode 100644 contrib/sb-rotate-byte/README create mode 100644 contrib/sb-rotate-byte/compiler.lisp create mode 100644 contrib/sb-rotate-byte/package.lisp create mode 100644 contrib/sb-rotate-byte/rotate-byte-tests.lisp create mode 100644 contrib/sb-rotate-byte/rotate-byte.lisp create mode 100644 contrib/sb-rotate-byte/sb-rotate-byte.asd create mode 100644 contrib/sb-rotate-byte/x86-vm.lisp diff --git a/NEWS b/NEWS index ac16198..e107e6a 100644 --- a/NEWS +++ b/NEWS @@ -1513,6 +1513,8 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12: ** an interface to the BSD Sockets API; ** an ACL-like convenience interface to the repl; (thanks to Kevin Rosenberg) + ** an implementation of ROTATE-BYTE, with efficient implementation + on x86 hardware; * fixed a bug in LOG, so that LOG of a rational argument near 1 now gives a closer approximation to the right answer than previously. (thanks to Raymond Toy) diff --git a/contrib/sb-rotate-byte/Makefile b/contrib/sb-rotate-byte/Makefile new file mode 100644 index 0000000..8ad532a --- /dev/null +++ b/contrib/sb-rotate-byte/Makefile @@ -0,0 +1,23 @@ +# FIXME I: This is more-or-less an exact copy of sb-bsd-sockets's +# Makefile. Maybe we should have a vanilla-asdf-module.mk? +# +# FIXME II: The thing that is preventing this is the use of RT as a +# regression tester... since we ask that modules do regression tests, +# maybe we should provide a regression test framework (in SB-RT, perhaps)? + +SYSTEM=sb-rotate-byte + +all: + $(MAKE) -C ../asdf + echo "(asdf:operate 'asdf:load-op :$(SYSTEM))" | \ + $(SBCL) --eval '(load "../asdf/asdf")' + +test: all + echo "(asdf:operate 'asdf:load-op :$(SYSTEM)) \ + (load (compile-file \"rotate-byte-tests.lisp\"))" | \ + $(SBCL) --eval '(load "../asdf/asdf")' + + +install: test + tar cf - . | ( cd $(INSTALL_DIR) && tar xpvf - ) + ( cd $(SBCL_HOME)/systems && ln -fs ../$(SYSTEM)/$(SYSTEM).asd . ) diff --git a/contrib/sb-rotate-byte/README b/contrib/sb-rotate-byte/README new file mode 100644 index 0000000..ec2a30f --- /dev/null +++ b/contrib/sb-rotate-byte/README @@ -0,0 +1,16 @@ +This module provides an implementation of ROTATE-BYTE, described at +. Its inclusion is hoped to +achieve two aims: + +(1) to provide the necessary functionality for implementations of + cryptographic and hashing algorithms (e.g. MD5); + +(2) to provide an example of the things that can be achieved by using + the external but unsupported interfaces to the compiler. + +Included in the module as of 2003-02-11 is an efficient implementation +of unsigned 32-bit rotation for the x86; when the compiler can prove +that the rotation in question is of an (UNSIGNED-BYTE 32) over the +byte specifier (BYTE 32 0), it will compile directly to machine +rotation instructions. Patches for similar functionality on other +platforms are welcome. diff --git a/contrib/sb-rotate-byte/compiler.lisp b/contrib/sb-rotate-byte/compiler.lisp new file mode 100644 index 0000000..95dcf65 --- /dev/null +++ b/contrib/sb-rotate-byte/compiler.lisp @@ -0,0 +1,56 @@ +(in-package "SB-ROTATE-BYTE") + +(defknown rotate-byte (integer byte-specifier integer) integer + (foldable flushable)) +(defknown %rotate-byte (integer bit-index bit-index integer) integer + (foldable flushable)) +(defknown %unsigned-32-rotate-byte ((integer -31 31) (unsigned-byte 32)) + (unsigned-byte 32) + (foldable flushable)) + +(macrolet (;; see src/compiler/srctran.lisp + (with-byte-specifier ((size-var pos-var spec) &body body) + (once-only ((spec `(macroexpand ,spec)) + (temp '(gensym))) + `(if (and (consp ,spec) + (eq (car ,spec) 'byte) + (= (length ,spec) 3)) + (let ((,size-var (second ,spec)) + (,pos-var (third ,spec))) + ,@body) + (let ((,size-var `(byte-size ,,temp)) + (,pos-var `(byte-position ,,temp))) + `(let ((,,temp ,,spec)) + ,,@body)))))) + (define-source-transform rotate-byte (count spec num) + (with-byte-specifier (size pos spec) + `(%rotate-byte ,count ,size ,pos ,num)))) + +(defoptimizer (%rotate-byte derive-type) ((count size posn num)) + ;; FIXME: this looks fairly unwieldy. I'm sure it can be made + ;; simpler, and also be made to deal with negative integers too. + (let ((size (sb-c::continuation-type size))) + (if (numeric-type-p size) + (let ((size-high (numeric-type-high size)) + (num-type (sb-c::continuation-type num))) + (if (and size-high + num-type + (<= size-high sb-vm:n-word-bits) + (csubtypep num-type + (specifier-type `(unsigned-byte ,size-high)))) + (specifier-type `(unsigned-byte ,size-high)) + *universal-type*)) + *universal-type*))) + +(deftransform %rotate-byte ((count size pos integer) + ((constant-arg (member 0)) * * *) *) + "fold identity operation" + 'integer) + +(deftransform %rotate-byte ((count size pos integer) + ((or (integer -31 -1) (integer 1 31)) + (constant-arg (member 32)) + (constant-arg (member 0)) + (unsigned-byte 32)) *) + "inline 32-bit rotation" + '(%unsigned-32-rotate-byte count integer)) diff --git a/contrib/sb-rotate-byte/package.lisp b/contrib/sb-rotate-byte/package.lisp new file mode 100644 index 0000000..f65678b --- /dev/null +++ b/contrib/sb-rotate-byte/package.lisp @@ -0,0 +1,3 @@ +(defpackage "SB-ROTATE-BYTE" + (:use "CL" "SB-C" "SB-VM" "SB-INT" "SB-KERNEL" "SB-ASSEM") + (:export "ROTATE-BYTE")) diff --git a/contrib/sb-rotate-byte/rotate-byte-tests.lisp b/contrib/sb-rotate-byte/rotate-byte-tests.lisp new file mode 100644 index 0000000..bf463ad --- /dev/null +++ b/contrib/sb-rotate-byte/rotate-byte-tests.lisp @@ -0,0 +1,53 @@ +(in-package "SB-ROTATE-BYTE") + +(assert (= (rotate-byte 3 (byte 32 0) 3) 24)) +(assert (= (rotate-byte 3 (byte 16 0) 3) 24)) +(assert (= (rotate-byte 3 (byte 2 0) 3) 3)) +(assert (= (rotate-byte 3 (byte 5 5) 3) 3)) +(assert (= (rotate-byte 6 (byte 8 0) -3) -129)) + +(flet ((opaque-identity (x) x)) + (declare (notinline opaque-identity)) + (assert (= (rotate-byte 3 (opaque-identity (byte 32 0)) 3) 24)) + (assert (= (rotate-byte 3 (opaque-identity (byte 16 0)) 3) 24)) + (assert (= (rotate-byte 3 (opaque-identity (byte 2 0)) 3) 3)) + (assert (= (rotate-byte 3 (opaque-identity (byte 5 5)) 3) 3)) + (assert (= (rotate-byte 6 (opaque-identity (byte 8 0)) -3) -129))) + +(defun pfixnum/c (integer) + (declare (type (unsigned-byte 29) integer)) + (rotate-byte 5 (byte 32 0) integer)) + +(assert (= (pfixnum/c 5) 160)) +(assert (= (pfixnum/c 1) 32)) +(assert (= (pfixnum/c (ash 1 26)) (ash 1 31))) +(assert (= (pfixnum/c (ash 1 27)) 1)) + +(defun pfixnum (count integer) + (declare (type (unsigned-byte 29) integer) + (type (integer -31 31) count)) + (rotate-byte count (byte 32 0) integer)) + +(assert (= (pfixnum 5 5) 160)) +(assert (= (pfixnum 5 1) 32)) +(assert (= (pfixnum 5 (ash 1 26)) (ash 1 31))) +(assert (= (pfixnum 5 (ash 1 27)) 1)) + +(defun ub32/c (integer) + (declare (type (unsigned-byte 32) integer)) + (rotate-byte 5 (byte 32 0) integer)) + +(assert (= (ub32/c 5) 160)) +(assert (= (ub32/c 1) 32)) +(assert (= (ub32/c (ash 1 26)) (ash 1 31))) +(assert (= (ub32/c (ash 1 27)) 1)) + +(defun ub32 (count integer) + (declare (type (unsigned-byte 32) integer) + (type (integer -31 31) count)) + (rotate-byte count (byte 32 0) integer)) + +(assert (= (ub32 5 5) 160)) +(assert (= (ub32 5 1) 32)) +(assert (= (ub32 5 (ash 1 26)) (ash 1 31))) +(assert (= (ub32 5 (ash 1 27)) 1)) diff --git a/contrib/sb-rotate-byte/rotate-byte.lisp b/contrib/sb-rotate-byte/rotate-byte.lisp new file mode 100644 index 0000000..02342f8 --- /dev/null +++ b/contrib/sb-rotate-byte/rotate-byte.lisp @@ -0,0 +1,22 @@ +(in-package "SB-ROTATE-BYTE") + +(defun rotate-byte (count byte integer) + #+sb-doc "FIXME: Write a docstring" + (rotate-byte count byte integer)) + +(defun %rotate-byte (count size pos integer) + (let ((count (nth-value 1 (round count size))) + (mask (1- (ash 1 size)))) + (logior (logand integer (lognot (ash mask pos))) + (let ((field (logand (ash mask pos) integer))) + (logand (ash mask pos) + (if (> count 0) + (logior (ash field count) + (ash field (- count size))) + (logior (ash field count) + (ash field (+ count size))))))))) + +(defun %unsigned-32-rotate-byte (count integer) + ;; inhibit transforms + (declare (notinline %rotate-byte)) + (%rotate-byte count 32 0 integer)) \ No newline at end of file diff --git a/contrib/sb-rotate-byte/sb-rotate-byte.asd b/contrib/sb-rotate-byte/sb-rotate-byte.asd new file mode 100644 index 0000000..3adf23b --- /dev/null +++ b/contrib/sb-rotate-byte/sb-rotate-byte.asd @@ -0,0 +1,17 @@ +;;; -*- Lisp -*- + +(cl:defpackage #:sb-rotate-byte-system + (:use #:asdf #:cl)) +(cl:in-package #:sb-rotate-byte-system) + +(defsystem sb-rotate-byte + :version "0.1" + :components ((:file "package") + (:file "compiler" :depends-on ("package")) + (:module "vm" + :depends-on ("compiler") + :components ((:file "x86-vm" + :in-order-to ((compile-op (feature :x86))))) + :pathname #.(make-pathname :directory '(:relative)) + :if-component-dep-fails :ignore) + (:file "rotate-byte" :depends-on ("compiler")))) diff --git a/contrib/sb-rotate-byte/x86-vm.lisp b/contrib/sb-rotate-byte/x86-vm.lisp new file mode 100644 index 0000000..de13b6b --- /dev/null +++ b/contrib/sb-rotate-byte/x86-vm.lisp @@ -0,0 +1,78 @@ +(in-package "SB-ROTATE-BYTE") + +(define-vop (%32bit-rotate-byte/c) + (:policy :fast-safe) + (:translate %unsigned-32-rotate-byte) + (:note "inline 32-bit constant rotation") + (:info count) + (:args (integer :scs (sb-vm::unsigned-reg) :target res)) + (:arg-types (:constant (integer -31 31)) sb-vm::unsigned-byte-32) + (:results (res :scs (sb-vm::unsigned-reg))) + (:result-types sb-vm::unsigned-byte-32) + (:generator 5 + ;; the 0 case is an identity operation and should be + ;; DEFTRANSFORMed away. + (aver (not (= count 0))) + (move res integer) + (if (> count 0) + (inst rol res count) + (inst ror res (- count))))) + +(define-vop (%32bit-rotate-byte-fixnum/c) + (:policy :fast-safe) + (:translate %unsigned-32-rotate-byte) + (:note "inline 32-bit constant rotation") + (:info count) + (:args (integer :scs (sb-vm::any-reg) :target res)) + (:arg-types (:constant (integer -31 31)) sb-vm::positive-fixnum) + (:results (res :scs (sb-vm::unsigned-reg))) + (:result-types sb-vm::unsigned-byte-32) + (:generator 5 + (aver (not (= count 0))) + (inst mov res integer) + (cond + ;; FIXME: all these 2s should be n-fixnum-tag-bits. + ((= count 2)) + ((> count 2) (inst rol res (- count 2))) + (t (inst ror res (- 2 count)))))) + +(macrolet ((def (name arg-type) + `(define-vop (,name) + (:policy :fast-safe) + (:translate %unsigned-32-rotate-byte) + (:note "inline 32-bit rotation") + (:args (count :scs (sb-vm::signed-reg) :target ecx) + (integer :scs (sb-vm::unsigned-reg) :target res)) + (:arg-types sb-vm::tagged-num ,arg-type) + (:temporary (:sc sb-vm::signed-reg :offset sb-vm::ecx-offset) + ecx) + (:results (res :scs (sb-vm::unsigned-reg))) + (:result-types sb-vm::unsigned-byte-32) + (:generator 10 + (let ((label (gen-label)) + (end (gen-label))) + (move res integer) + (move ecx count) + (inst cmp ecx 0) + (inst jmp :ge label) + (inst neg ecx) + (inst ror res :cl) + (inst jmp end) + (emit-label label) + (inst rol res :cl) + (emit-label end)))))) + (def %32bit-rotate-byte sb-vm::unsigned-byte-32) + ;; FIXME: it's not entirely clear to me why we need this second + ;; definition -- or rather, why the compiler isn't smart enough to + ;; MOVE a POSITIVE-FIXNUM argument to an UNSIGNED-BYTE-32 argument, + ;; and then go from there. Still, not having it leads to scary + ;; compilation messages of the form: + ;; + ;; unable to do inline 32-bit constant rotation (cost 5) because: + ;; This shouldn't happen! Bug? + ;; argument types invalid + ;; argument primitive types: + ;; (SB-VM::POSITIVE-FIXNUM SB-VM::POSITIVE-FIXNUM) + ;; + ;; so better leave it in. + (def %32bit-rotate-byte-fixnum sb-vm::positive-fixnum)) diff --git a/install.sh b/install.sh index 9a02a51..d14ddc1 100644 --- a/install.sh +++ b/install.sh @@ -39,9 +39,9 @@ SBCL="`pwd`/src/runtime/sbcl --noinform --core `pwd`/output/sbcl.core --userinit SBCL_BUILDING_CONTRIB=1 export SBCL SBCL_BUILDING_CONTRIB -gnumake=$(GNUMAKE:-gmake} +gnumake=${GNUMAKE:-gmake} for i in contrib/*; do - test -d $i || continue; + test -d $i && test -e $i/Makefile || continue; export INSTALL_DIR=$SBCL_HOME/`basename $i ` - $gnumake -C $i test && ensure_dirs $INSTALL_DIR && make -C $i install + $gnumake -C $i test && ensure_dirs $INSTALL_DIR && $gnumake -C $i install done diff --git a/make-target-contrib.sh b/make-target-contrib.sh index b8e53ef..ace42e8 100644 --- a/make-target-contrib.sh +++ b/make-target-contrib.sh @@ -27,7 +27,7 @@ export SBCL SBCL_BUILDING_CONTRIB gnumake=${GNUMAKE:-gmake} for i in contrib/*; do - test -d $i || continue; + test -d $i && test -e $i/Makefile || continue; # export INSTALL_DIR=$SBCL_HOME/`basename $i ` $gnumake -C $i test done diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 62f29db..6fa209e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -232,6 +232,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "PHYSENV-DEBUG-LIVE-TN" "PHYSENV-LIVE-TN" "FAST-SYMBOL-VALUE" "FOLDABLE" "FORCE-TN-TO-STACK" + "FUN-INFO-DERIVE-TYPE" "FUN-INFO-IR2-CONVERT" + "FUN-INFO-LTN-ANNOTATE" "FUN-INFO-OPTIMIZER" "GET-VECTOR-SUBTYPE" "HALT" "IF-EQ" "INLINE-SYNTACTIC-CLOSURE-LAMBDA" diff --git a/version.lisp-expr b/version.lisp-expr index e5af7a6..dbe7413 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.12.35" +"0.7.12.36" -- 1.7.10.4