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 &optional stack)
138 (when stack (setf stack (list stack)))
140 `(define-vop (,name move-if)
141 (:args (then :scs (immediate ,reg ,@stack) :to :eval
143 :load-if (not (or (sc-is then immediate)
144 (and (sc-is then ,@stack)
145 (not (location= else res))))))
146 (else :scs (immediate ,reg ,@stack) :target res
147 :load-if (not (sc-is else immediate ,@stack))))
148 (:arg-types ,type ,type)
149 (:results (res :scs (,reg)
150 :from (:argument 1)))
151 (:result-types ,type))))
152 (def-move-if move-if/t
153 t descriptor-reg control-stack)
154 (def-move-if move-if/fx
155 tagged-num any-reg control-stack)
156 (def-move-if move-if/unsigned
157 unsigned-num unsigned-reg unsigned-stack)
158 (def-move-if move-if/signed
159 signed-num signed-reg signed-stack)
160 (def-move-if move-if/char
161 character character-reg character-stack)
162 (def-move-if move-if/sap
163 system-area-pointer sap-reg sap-stack))
166 ;;;; conditional VOPs
168 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
169 ;;; not immediate data.
171 (:args (x :scs (any-reg descriptor-reg control-stack constant)
172 :load-if (not (and (sc-is x immediate)
173 (sc-is y any-reg descriptor-reg
174 control-stack constant))))
175 (y :scs (any-reg descriptor-reg immediate)
176 :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
177 (sc-is y control-stack constant)))))
183 (let ((x-val (encode-value-if-immediate x))
184 (y-val (encode-value-if-immediate y)))
186 ;; Shorter instruction sequences for these two cases.
187 ((and (eql 0 y-val) (sc-is x any-reg descriptor-reg)) (inst test x x))
188 ((and (eql 0 x-val) (sc-is y any-reg descriptor-reg)) (inst test y y))
190 ;; An encoded value (literal integer) has to be the second argument.
191 ((sc-is x immediate) (inst cmp y x-val))
193 (t (inst cmp x y-val))))))