Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs1:/tmp/cvs-serv32482/src/compiler/generic
Modified Files:
vm-macs.lisp vm-tran.lisp
Log Message:
0.8.2.29:
* Fix bug in ASSQ, reported by Paul Dietz;
* FLOAT-RADIX IGNOREs its argument as was suggested by Clemens
Heitzinger;
* fix return type declaration for FFLOOR and friends (reported
by Paul Dietz);
* SB-C::DESCRIBE-COMPONENT prints blocks in IR1 component "as
is";
* introduced "good" (transparent) modular functions;
... LOGAND and LOGIOR are :GOOD;
* on X86: transform 32BIT-LOGICAL-xxx into LOGXXX; implement
LOGXOR-MOD32; change implementation of FAST-+-MOD32: inherit
without changes from FAST-+/UNSIGNED=>UNSIGNED :-).
(On X86 SB-MD5 may be implemented without 32BIT-LOGICAL-xxx
and evil TRULY-THE.)
Index: vm-macs.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-macs.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- vm-macs.lisp 13 Aug 2003 09:40:26 -0000 1.13
+++ vm-macs.lisp 15 Aug 2003 08:21:07 -0000 1.14
@@ -152,7 +152,7 @@
;;; Modular functions
-;;; hash: name -> ({(width . fun)}*)
+;;; hash: name -> { ({(width . fun)}*) | :good }
(defvar *modular-funs*
(make-hash-table :test 'eq))
@@ -166,9 +166,11 @@
(defun find-modular-version (fun-name width)
(let ((infos (gethash fun-name *modular-funs*)))
- (find-if (lambda (item-width) (>= item-width width))
- infos
- :key #'modular-fun-info-width)))
+ (if (eq infos :good)
+ :good
+ (find-if (lambda (item-width) (>= item-width width))
+ infos
+ :key #'modular-fun-info-width))))
(defun %define-modular-fun (name lambda-list prototype width)
(let* ((infos (the list (gethash prototype *modular-funs*)))
@@ -206,3 +208,11 @@
(defknown ,name ,(mapcar (constantly 'integer) lambda-list)
(unsigned-byte ,width)
(foldable flushable movable))))
+
+(defun %define-good-modular-fun (name)
+ (setf (gethash name *modular-funs*) :good)
+ name)
+
+(defmacro define-good-modular-fun (name)
+ (check-type name symbol)
+ `(%define-good-modular-fun ',name))
Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- vm-tran.lisp 13 Aug 2003 09:40:26 -0000 1.32
+++ vm-tran.lisp 15 Aug 2003 08:21:07 -0000 1.33
@@ -409,3 +409,6 @@
(setf (node-derived-type node)
(values-specifier-type '(values (unsigned-byte 32) &optional)))
'(32bit-logical-not x)))
+
+(define-good-modular-fun logand)
+(define-good-modular-fun logior)
|