1 ;;;; predicate VOPs for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
16 ;;; The unconditional branch, emitted when we can't drop through to the desired
17 ;;; destination. Dest is the continuation we transfer control to.
24 ;;;; Generic conditional VOPs
26 ;;; The generic conditional branch, emitted immediately after test
27 ;;; VOPs that only set flags.
29 ;;; FLAGS is a list of condition descriptors. If the first descriptor
30 ;;; is CL:NOT, the test was true if all the remaining conditions are
31 ;;; false. Otherwise, the test was true if any of the conditions is.
33 ;;; NOT-P flips the meaning of the test, as with regular :CONDITIONAL
34 ;;; VOP. If NOT-P is true, the code must branch to dest if the test was
35 ;;; false. Otherwise, the code must branch to dest if the test was true.
37 (define-vop (branch-if)
38 (:info dest flags not-p)
40 (flet ((negate-condition (name)
41 (let ((code (logxor 1 (conditional-opcode name))))
42 (aref *condition-name-vec* code))))
43 (aver (null (rest flags)))
46 (negate-condition (first flags))
50 (defvar *cmov-ptype-representation-vop*
51 (mapcan (lambda (entry)
52 (destructuring-bind (ptypes &optional sc vop)
54 (unless (listp ptypes)
55 (setf ptypes (list ptypes)))
56 (mapcar (if (and vop sc)
61 '((t descriptor-reg move-if/t)
63 ((fixnum positive-fixnum)
65 ((unsigned-byte-32 unsigned-byte-31)
66 unsigned-reg move-if/unsigned)
67 (signed-byte-32 signed-reg move-if/signed)
68 (character character-reg move-if/char)
70 ((single-float complex-single-float
71 double-float complex-double-float))
73 (system-area-pointer sap-reg move-if/sap)))
74 "Alist of primitive type -> (storage-class-name VOP-name)
75 if values of such a type should be cmoved, and NIL otherwise.
77 storage-class-name is the name of the storage class to use for
78 the values, and VOP-name the name of the VOP that will be used
79 to execute the conditional move.")
81 (!def-vm-support-routine
82 convert-conditional-move-p (node dst-tn x-tn y-tn)
83 (declare (ignore node))
84 (let* ((ptype (sb!c::tn-primitive-type dst-tn))
85 (name (sb!c::primitive-type-name ptype))
86 (param (and (memq :cmov *backend-subfeatures*)
87 (cdr (or (assoc name *cmov-ptype-representation-vop*)
88 '(t descriptor-reg move-if/t))))))
90 (destructuring-bind (representation vop) param
91 (let ((scn (sc-number-or-lose representation)))
93 (make-representation-tn ptype scn))
95 (if (immediate-tn-p tn)
99 (frob-tn x-tn) (frob-tn y-tn)
103 (define-vop (move-if)
104 (:args (then) (else))
105 (:temporary (:sc unsigned-reg :from :eval) temp)
109 (flet ((load-immediate (dst constant-tn
110 &optional (sc (sc-name (tn-sc dst))))
111 (let ((val (tn-value constant-tn)))
114 (if (memq sc '(any-reg descriptor-reg))
115 (inst mov dst (fixnumize val))
118 (aver (eq sc 'descriptor-reg))
119 (load-symbol dst val))
121 (cond ((memq sc '(any-reg descriptor-reg))
123 (logior (ash (char-code val) n-widetag-bits)
126 (aver (eq sc 'character-reg))
127 (inst mov dst (char-code val)))))))))
128 (aver (null (rest flags)))
129 (if (sc-is else immediate)
130 (load-immediate res else)
132 (when (sc-is then immediate)
133 (load-immediate temp then (sc-name (tn-sc res)))
135 (inst cmov (first flags) res then))))
137 (macrolet ((def-move-if (name type reg stack)
138 `(define-vop (,name move-if)
139 (:args (then :scs (immediate ,reg ,stack) :to :eval
141 :load-if (not (or (sc-is then immediate)
142 (and (sc-is then ,stack)
143 (not (location= else res))))))
144 (else :scs (immediate ,reg ,stack) :target res
145 :load-if (not (sc-is else immediate ,stack))))
146 (:arg-types ,type ,type)
147 (:results (res :scs (,reg)
148 :from (:argument 1)))
149 (:result-types ,type))))
150 (def-move-if move-if/t t descriptor-reg control-stack)
151 (def-move-if move-if/fx tagged-num any-reg control-stack)
152 (def-move-if move-if/unsigned unsigned-num unsigned-reg unsigned-stack)
153 (def-move-if move-if/signed signed-num signed-reg signed-stack)
154 (def-move-if move-if/char character character-reg character-stack)
155 (def-move-if move-if/sap system-area-pointer sap-reg sap-stack))
158 ;;;; conditional VOPs
160 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
161 ;;; not immediate data.
163 (:args (x :scs (any-reg descriptor-reg control-stack constant)
164 :load-if (not (and (sc-is x immediate)
165 (sc-is y any-reg descriptor-reg
166 control-stack constant))))
167 (y :scs (any-reg descriptor-reg immediate)
168 :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
169 (sc-is y control-stack constant)))))
175 (let ((x-val (encode-value-if-immediate x))
176 (y-val (encode-value-if-immediate y)))
178 ;; Shorter instruction sequences for these two cases.
179 ((and (eql 0 y-val) (sc-is x any-reg descriptor-reg)) (inst test x x))
180 ((and (eql 0 x-val) (sc-is y any-reg descriptor-reg)) (inst test y y))
182 ;; An encoded value (literal integer) has to be the second argument.
183 ((sc-is x immediate) (inst cmp y x-val))
185 (t (inst cmp x y-val))))))