From: Alexey D. <ade...@us...> - 2003-08-16 01:27:42
|
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) |