#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(deffrob ceiling))
-(define-source-transform logtest (x y) `(not (zerop (logand ,x ,y))))
+;;; This used to be a source transform (hence the lack of restrictions
+;;; on the argument types), but we make it a regular transform so that
+;;; the VM has a chance to see the bare LOGTEST and potentiall choose
+;;; to implement it differently. --njf, 06-02-2006
+(deftransform logtest ((x y) * *)
+ `(not (zerop (logand x y))))
(deftransform logbitp
((index integer) (unsigned-byte (or (signed-byte #.sb!vm:n-word-bits)
;;; -- If both args are characters, convert to CHAR=. This is better than
;;; just converting to EQ, since CHAR= may have special compilation
;;; strategies for non-standard representations, etc.
-;;; -- If either arg is definitely a fixnum we punt and let the backend
-;;; deal with it.
+;;; -- If either arg is definitely a fixnum, we check to see if X is
+;;; constant and if so, put X second. Doing this results in better
+;;; code from the backend, since the backend assumes that any constant
+;;; argument comes second.
;;; -- If either arg is definitely not a number or a fixnum, then we
;;; can compare with EQ.
;;; -- Otherwise, we try to put the arg we know more about second. If X
;;; is constant then we put it second. If X is a subtype of Y, we put
;;; it second. These rules make it easier for the back end to match
;;; these interesting cases.
-(deftransform eql ((x y) * *)
+(deftransform eql ((x y) * * :node node)
"convert to simpler equality predicate"
(let ((x-type (lvar-type x))
(y-type (lvar-type y))
(csubtypep y-type char-type))
'(char= x y))
((or (fixnum-type-p x-type) (fixnum-type-p y-type))
- (give-up-ir1-transform))
+ (commutative-arg-swap node))
((or (simple-type-p x-type) (simple-type-p y-type))
'(eq x y))
((and (not (constant-lvar-p y))
(give-up-ir1-transform "not a real transform"))
(defun /report-lvar (x message)
(declare (ignore x message))))
+
+\f
+;;;; Transforms for internal compiler utilities
+
+;;; If QUALITY-NAME is constant and a valid name, don't bother
+;;; checking that it's still valid at run-time.
+(deftransform policy-quality ((policy quality-name)
+ (t symbol))
+ (unless (and (constant-lvar-p quality-name)
+ (policy-quality-name-p (lvar-value quality-name)))
+ (give-up-ir1-transform))
+ `(let* ((acons (assoc quality-name policy))
+ (result (or (cdr acons) 1)))
+ result))