** 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)
--- /dev/null
+# 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 . )
--- /dev/null
+This module provides an implementation of ROTATE-BYTE, described at
+<http://www.cliki.net/ROTATE-BYTE">. 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.
--- /dev/null
+(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))
--- /dev/null
+(defpackage "SB-ROTATE-BYTE"
+ (:use "CL" "SB-C" "SB-VM" "SB-INT" "SB-KERNEL" "SB-ASSEM")
+ (:export "ROTATE-BYTE"))
--- /dev/null
+(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))
--- /dev/null
+(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
--- /dev/null
+;;; -*- 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"))))
--- /dev/null
+(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))
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
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
"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"
;;; 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"
projects / sbcl.git / commitdiff