4bbf5f492aff14e92abcf56c357ef571a52e4700
[sbcl.git] / src / compiler / ppc / insts.lisp
1 ;;;; the instruction set definition for the PPC
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13
14 ;;; needs a little more work in the assembler, to realise that the
15 ;;; delays requested here are not mandatory, so that the assembler
16 ;;; shouldn't fill gaps with NOPs but with real instructions.  -- CSR,
17 ;;; 2003-09-08
18 #+nil
19 (eval-when (:compile-toplevel :load-toplevel :execute)
20   (setf sb!assem:*assem-scheduler-p* t)
21   (setf sb!assem:*assem-max-locations* 70))
22 \f
23 ;;;; Constants, types, conversion functions, some disassembler stuff.
24
25 (defun reg-tn-encoding (tn)
26   (declare (type tn tn))
27   (sc-case tn
28     (zero zero-offset)
29     (null null-offset)
30     (t
31      (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
32          (tn-offset tn)
33          (error "~S isn't a register." tn)))))
34
35 (defun fp-reg-tn-encoding (tn)
36   (declare (type tn tn))
37   (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
38     (error "~S isn't a floating-point register." tn))
39   (tn-offset tn))
40
41 ;(sb!disassem:set-disassem-params :instruction-alignment 32)
42
43 (defvar *disassem-use-lisp-reg-names* t)
44
45 (!def-vm-support-routine location-number (loc)
46   (etypecase loc
47     (null)
48     (number)
49     (label)
50     (fixup)
51     (tn
52      (ecase (sb-name (sc-sb (tn-sc loc)))
53        (immediate-constant
54         ;; Can happen if $ZERO or $NULL are passed in.
55         nil)
56        (registers
57         (unless (zerop (tn-offset loc))
58           (tn-offset loc)))
59        (float-registers
60         (+ (tn-offset loc) 32))))
61     (symbol
62      (ecase loc
63        (:memory 0)
64        (:ccr 64)
65        (:xer 65)
66        (:lr 66)
67        (:ctr 67)
68        (:fpscr 68)))))
69
70 (defparameter reg-symbols
71   (map 'vector
72        #'(lambda (name)
73            (cond ((null name) nil)
74                  (t (make-symbol (concatenate 'string "$" name)))))
75        *register-names*))
76
77 (defun maybe-add-notes (regno dstate)
78   (let* ((inst (sb!disassem::sap-ref-int
79                 (sb!disassem::dstate-segment-sap dstate)
80                 (sb!disassem::dstate-cur-offs dstate)
81                 n-word-bytes
82                 (sb!disassem::dstate-byte-order dstate)))
83          (op (ldb (byte 6 26) inst)))
84     (case op
85       ;; lwz
86       (32
87        (when (= regno (ldb (byte 5 16) inst)) ; only for the second
88          (case (ldb (byte 5 16) inst)
89            ;; reg_CODE
90            (19
91             (sb!disassem:note-code-constant (ldb (byte 16 0) inst) dstate)))))
92       ;; addi
93       (14
94        (when (= regno null-offset)
95          (sb!disassem:maybe-note-nil-indexed-object
96           (ldb (byte 16 0) inst) dstate))))))
97
98 (sb!disassem:define-arg-type reg
99   :printer
100   (lambda (value stream dstate)
101     (declare (type stream stream) (fixnum value))
102     (let ((regname (aref reg-symbols value)))
103       (princ regname stream)
104       (sb!disassem:maybe-note-associated-storage-ref
105        value 'registers regname dstate)
106       (maybe-add-notes value dstate))))
107
108 (defparameter float-reg-symbols
109   #.(coerce
110      (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n)))
111      'vector))
112
113 (sb!disassem:define-arg-type fp-reg
114   :printer #'(lambda (value stream dstate)
115                (declare (type stream stream) (fixnum value))
116                (let ((regname (aref float-reg-symbols value)))
117                  (princ regname stream)
118                  (sb!disassem:maybe-note-associated-storage-ref
119                   value
120                   'float-registers
121                   regname
122                   dstate))))
123
124 (eval-when (:compile-toplevel :load-toplevel :execute)
125   (defparameter bo-kind-names
126     #(:bo-dnzf :bo-dnzfp :bo-dzf :bo-dzfp :bo-f :bo-fp nil nil
127       :bo-dnzt :bo-dnztp :bo-dzt :bo-dztp :bo-t :bo-tp nil nil
128       :bo-dnz :bo-dnzp :bo-dz :bo-dzp :bo-u nil nil nil
129       nil nil nil nil nil nil nil nil)))
130
131 (sb!disassem:define-arg-type bo-field
132   :printer #'(lambda (value stream dstate)
133                (declare (ignore dstate)
134                         (type stream stream)
135                         (type fixnum value))
136                (princ (svref bo-kind-names value) stream)))
137
138 (eval-when (:compile-toplevel :load-toplevel :execute)
139 (defun valid-bo-encoding (enc)
140   (or (if (integerp enc)
141         (and (= enc (logand #x1f enc))
142              (not (null (svref bo-kind-names enc)))
143              enc)
144         (and enc (position enc bo-kind-names)))
145       (error "Invalid BO field spec: ~s" enc)))
146 )
147
148
149 (defparameter cr-bit-names #(:lt :gt :eq :so))
150 (defparameter cr-bit-inverse-names #(:ge :le :ne :ns))
151
152 (defparameter cr-field-names #(:cr0 :cr1 :cr2 :cr3 :cr4 :cr5 :cr6 :cr7))
153
154 (defun valid-cr-bit-encoding (enc &optional error-p)
155   (or (if (integerp enc)
156         (and (= enc (logand 3 enc))
157              enc))
158       (position enc cr-bit-names)
159       (if error-p (error "Invalid condition bit specifier : ~s" enc))))
160
161 (defun valid-cr-field-encoding (enc)
162   (let* ((field (if (integerp enc)
163                   (and (= enc (logand #x7 enc)))
164                   (position enc cr-field-names))))
165     (if field
166       (ash field 2)
167       (error "Invalid condition register field specifier : ~s" enc))))
168
169 (defun valid-bi-encoding (enc)
170   (or
171    (if (atom enc)
172      (if (integerp enc)
173        (and (= enc (logand 31 enc)) enc)
174        (position enc cr-bit-names))
175      (+ (valid-cr-field-encoding (car enc))
176         (valid-cr-bit-encoding (cadr enc))))
177    (error "Invalid BI field spec : ~s" enc)))
178
179 (sb!disassem:define-arg-type bi-field
180   :printer #'(lambda (value stream dstate)
181                (declare (ignore dstate)
182                         (type stream stream)
183                         (type (unsigned-byte 5) value))
184                (let* ((bitname (svref cr-bit-names (logand 3 value)))
185                       (crfield (ash value -2)))
186                  (declare (type (unsigned-byte 3) crfield))
187                  (if (= crfield 0)
188                    (princ bitname stream)
189                    (princ (list (svref cr-field-names crfield) bitname) stream)))))
190
191 (sb!disassem:define-arg-type crf
192   :printer #'(lambda (value stream dstate)
193                (declare (ignore dstate)
194                         (type stream stream)
195                         (type (unsigned-byte 3) value))
196                (princ (svref cr-field-names value) stream)))
197
198 (sb!disassem:define-arg-type relative-label
199   :sign-extend t
200   :use-label #'(lambda (value dstate)
201                  (declare (type (signed-byte 14) value)
202                           (type sb!disassem:disassem-state dstate))
203                  (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate))))
204
205 (eval-when (:compile-toplevel :load-toplevel :execute)
206   (defparameter trap-values-alist '((:t . 31) (:lt . 16) (:le . 20) (:eq . 4) (:lng . 6)
207                                    (:ge .12) (:ne . 24) (:ng . 20) (:llt . 2) (:f . 0)
208                                    (:lle . 6) (:lge . 5) (:lgt . 1) (:lnl . 5))))
209
210
211 (defun valid-tcond-encoding (enc)
212   (or (and (if (integerp enc) (= (logand 31 enc) enc)) enc)
213       (cdr (assoc enc trap-values-alist))
214       (error "Unknown trap condition: ~s" enc)))
215
216 (sb!disassem:define-arg-type to-field
217   :sign-extend nil
218   :printer #'(lambda (value stream dstate)
219                (declare (ignore dstate)
220                         (type stream stream)
221                         (type fixnum value))
222                (princ (or (car (rassoc value trap-values-alist))
223                           value)
224                       stream)))
225
226 (defun snarf-error-junk (sap offset &optional length-only)
227   (let* ((length (sb!sys:sap-ref-8 sap offset))
228          (vector (make-array length :element-type '(unsigned-byte 8))))
229     (declare (type sb!sys:system-area-pointer sap)
230              (type (unsigned-byte 8) length)
231              (type (simple-array (unsigned-byte 8) (*)) vector))
232     (cond (length-only
233            (values 0 (1+ length) nil nil))
234           (t
235            (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
236                                                 vector 0 length)
237            (collect ((sc-offsets)
238                      (lengths))
239              (lengths 1)                ; the length byte
240              (let* ((index 0)
241                     (error-number (sb!c:read-var-integer vector index)))
242                (lengths index)
243                (loop
244                  (when (>= index length)
245                    (return))
246                  (let ((old-index index))
247                    (sc-offsets (sb!c:read-var-integer vector index))
248                    (lengths (- index old-index))))
249                (values error-number
250                        (1+ length)
251                        (sc-offsets)
252                        (lengths))))))))
253
254 (defun emit-conditional-branch (segment bo bi target &optional aa-p lk-p)
255   (declare (type boolean aa-p lk-p))
256   (let* ((bo (valid-bo-encoding bo))
257          (bi (valid-bi-encoding bi))
258          (aa-bit (if aa-p 1 0))
259          (lk-bit (if lk-p 1 0)))
260     (if aa-p                            ; Not bloody likely, bwth.
261       (emit-b-form-inst segment 16 bo bi target aa-bit lk-bit)
262       ;; the target may be >32k away, in which case we have to invert the
263       ;; test and do an absolute branch
264       (emit-chooser
265        ;; We emit either 4 or 8 bytes, so I think we declare this as
266        ;; preserving 4 byte alignment.  If this gives us no joy, we can
267        ;; stick a nop in the long branch and then we will be
268        ;; preserving 8 byte alignment
269        segment 8 2 ; 2^2 is 4 byte alignment.  I think
270        #'(lambda (segment posn magic-value)
271            (let ((delta (ash (- (label-position target posn magic-value) posn)
272                              -2)))
273              (when (typep delta '(signed-byte 14))
274                (emit-back-patch segment 4
275                                 #'(lambda (segment posn)
276                                     (emit-b-form-inst
277                                      segment 16 bo bi
278                                      (ash (- (label-position target) posn) -2)
279                                      aa-bit lk-bit)))
280                t)))
281        #'(lambda (segment posn)
282            (declare (ignore posn))
283            (let ((bo (logxor 8 bo))) ;; invert the test
284              (emit-b-form-inst segment 16 bo bi
285                                2 ; skip over next instruction
286                                0 0)
287              (emit-back-patch segment 4
288                               #'(lambda (segment posn)
289                                   (declare (ignore posn))
290                                   (emit-i-form-branch segment target lk-p)))))
291        ))))
292
293
294
295 ; non-absolute I-form: B, BL.
296 (defun emit-i-form-branch (segment target &optional lk-p)
297   (let* ((lk-bit (if lk-p 1 0)))
298     (etypecase target
299       (fixup
300        (note-fixup segment :b target)
301        (emit-i-form-inst segment 18 0 0 lk-bit))
302       (label
303        (emit-back-patch segment 4
304                         #'(lambda (segment posn)
305                             (emit-i-form-inst
306                              segment
307                              18
308                              (ash (- (label-position target) posn) -2)
309                              0
310                              lk-bit)))))))
311
312 (eval-when (:compile-toplevel :execute :load-toplevel)
313 (defparameter *spr-numbers-alist* '((:xer 1) (:lr 8) (:ctr 9))))
314
315 (sb!disassem:define-arg-type spr
316   :printer #'(lambda (value stream dstate)
317                (declare (ignore dstate)
318                         (type (unsigned-byte 10) value))
319                (let* ((name (car (rassoc value *spr-numbers-alist*))))
320                    (if name
321                      (princ name stream)
322                      (princ value stream)))))
323
324 (eval-when (:compile-toplevel :load-toplevel :execute)
325   (defparameter jump-printer
326     #'(lambda (value stream dstate)
327         (let ((addr (ash value 2)))
328           (sb!disassem:maybe-note-assembler-routine addr t dstate)
329           (write addr :base 16 :radix t :stream stream)))))
330
331
332 \f
333 ;;;; dissassem:define-instruction-formats
334
335 (eval-when (:compile-toplevel :execute)
336   (defmacro ppc-byte (startbit &optional (endbit startbit))
337     (unless (and (typep startbit '(unsigned-byte 32))
338                  (typep endbit '(unsigned-byte 32))
339                  (>= endbit startbit))
340       (error "Bad bits."))
341     ``(byte ,(1+ ,(- endbit startbit)) ,(- 31 ,endbit)))
342
343   (defparameter *ppc-field-specs-alist*
344     `((aa :field ,(ppc-byte 30))
345       (ba :field ,(ppc-byte 11 15) :type 'bi-field)
346       (bb :field ,(ppc-byte 16 20) :type 'bi-field)
347       (bd :field ,(ppc-byte 16 29) :type 'relative-label)
348       (bf :field ,(ppc-byte 6 8) :type 'crf)
349       (bfa :field ,(ppc-byte 11 13) :type 'crf)
350       (bi :field ,(ppc-byte 11 15) :type 'bi-field)
351       (bo :field ,(ppc-byte 6 10) :type 'bo-field)
352       (bt :field ,(ppc-byte 6 10) :type 'bi-field)
353       (d :field ,(ppc-byte 16 31) :sign-extend t)
354       (flm :field ,(ppc-byte 7 14) :sign-extend nil)
355       (fra :field ,(ppc-byte 11 15) :type 'fp-reg)
356       (frb :field ,(ppc-byte 16 20) :type 'fp-reg)
357       (frc :field ,(ppc-byte 21 25) :type 'fp-reg)
358       (frs :field ,(ppc-byte 6 10) :type 'fp-reg)
359       (frt :field ,(ppc-byte 6 10) :type 'fp-reg)
360       (fxm :field ,(ppc-byte 12 19) :sign-extend nil)
361       (l :field ,(ppc-byte 10) :sign-extend nil)
362       (li :field ,(ppc-byte 6 29) :sign-extend t :type 'relative-label)
363       (li-abs :field ,(ppc-byte 6 29) :sign-extend t :printer jump-printer)
364       (lk :field ,(ppc-byte 31))
365       (mb :field ,(ppc-byte 21 25) :sign-extend nil)
366       (me :field ,(ppc-byte 26 30) :sign-extend nil)
367       (nb :field ,(ppc-byte 16 20) :sign-extend nil)
368       (oe :field ,(ppc-byte 21))
369       (ra :field ,(ppc-byte 11 15) :type 'reg)
370       (rb :field ,(ppc-byte 16 20) :type 'reg)
371       (rc :field ,(ppc-byte 31))
372       (rs :field ,(ppc-byte 6 10) :type 'reg)
373       (rt :field ,(ppc-byte 6 10) :type 'reg)
374       (sh :field ,(ppc-byte 16 20) :sign-extend nil)
375       (si :field ,(ppc-byte 16 31) :sign-extend t)
376       (spr :field ,(ppc-byte 11 20) :type 'spr)
377       (to :field ,(ppc-byte 6 10) :type 'to-field)
378       (u :field ,(ppc-byte 16 19) :sign-extend nil)
379       (ui :field ,(ppc-byte 16 31) :sign-extend nil)
380       (xo21-30 :field ,(ppc-byte 21 30) :sign-extend nil)
381       (xo22-30 :field ,(ppc-byte 22 30) :sign-extend nil)
382       (xo26-30 :field ,(ppc-byte 26 30) :sign-extend nil)))
383
384
385
386 (sb!disassem:define-instruction-format (instr 32)
387   (op :field (byte 6 26))
388   (other :field (byte 26 0)))
389
390 (sb!disassem:define-instruction-format (xinstr 32 :default-printer '(:name :tab data))
391   (op-to-a :field (byte 16 16))
392   (data :field (byte 16 0)))
393
394 (sb!disassem:define-instruction-format (sc 32 :default-printer '(:name :tab rest))
395   (op :field (byte 6 26))
396   (rest :field (byte 26 0) :value 2))
397
398
399
400 (macrolet ((def-ppc-iformat ((name &optional default-printer) &rest specs)
401                (flet ((specname-field (specname)
402                         (or (assoc specname *ppc-field-specs-alist*)
403                             (error "Unknown ppc instruction field spec ~s" specname))))
404                  (labels ((spec-field (spec)
405                             (if (atom spec)
406                                 (specname-field spec)
407                                 (cons (car spec)
408                                       (cdr (specname-field (cadr spec)))))))
409                    (collect ((field (list '(op :field (byte 6 26)))))
410                             (dolist (spec specs)
411                               (field (spec-field spec)))
412                             `(sb!disassem:define-instruction-format (,name 32 ,@(if default-printer `(:default-printer ,default-printer)))
413                               ,@(field)))))))
414
415 (def-ppc-iformat (i '(:name :tab li))
416   li aa lk)
417
418 (def-ppc-iformat (i-abs '(:name :tab li-abs))
419   li-abs aa lk)
420
421 (def-ppc-iformat (b '(:name :tab bo "," bi "," bd))
422   bo bi bd aa lk)
423
424 (def-ppc-iformat (d '(:name :tab rt "," d "(" ra ")"))
425   rt ra d)
426
427 (def-ppc-iformat (d-si '(:name :tab rt "," ra "," si ))
428   rt ra si)
429
430 (def-ppc-iformat (d-rs '(:name :tab rs "," d "(" ra ")"))
431   rs ra d)
432
433 (def-ppc-iformat (d-rs-ui '(:name :tab ra "," rs "," ui))
434   rs ra ui)
435
436 (def-ppc-iformat (d-crf-si)
437   bf l ra si)
438
439 (def-ppc-iformat (d-crf-ui)
440   bf l ra ui)
441
442 (def-ppc-iformat (d-to '(:name :tab to "," ra "," si))
443   to ra rb si)
444
445 (def-ppc-iformat (d-frt '(:name :tab frt "," d "(" ra ")"))
446   frt ra d)
447
448 (def-ppc-iformat (d-frs '(:name :tab frs "," d "(" ra ")"))
449   frs ra d)
450
451
452 \f
453 ;;; There are around ... oh, 28 or so ... variants on the "X" format.
454 ;;;  Some of them are only used by one instruction; some are used by dozens.
455 ;;;  Some aren't used by instructions that we generate ...
456
457 (def-ppc-iformat (x '(:name :tab rt "," ra "," rb))
458   rt ra rb (xo xo21-30))
459
460 (def-ppc-iformat (x-1 '(:name :tab rt "," ra "," nb))
461   rt ra nb (xo xo21-30))
462
463 (def-ppc-iformat (x-4 '(:name :tab rt))
464   rt (xo xo21-30))
465
466 (def-ppc-iformat (x-5 '(:name :tab ra "," rs "," rb))
467   rs ra rb (xo xo21-30) rc)
468
469 (def-ppc-iformat (x-7 '(:name :tab ra "," rs "," rb))
470   rs ra rb (xo xo21-30))
471
472 (def-ppc-iformat (x-8 '(:name :tab ra "," rs "," nb))
473   rs ra nb (xo xo21-30))
474
475 (def-ppc-iformat (x-9 '(:name :tab ra "," rs "," sh))
476   rs ra sh (xo xo21-30) rc)
477
478 (def-ppc-iformat (x-10 '(:name :tab ra "," rs))
479   rs ra (xo xo21-30) rc)
480
481 (def-ppc-iformat (x-14 '(:name :tab bf "," l "," ra "," rb))
482   bf l ra rb (xo xo21-30))
483
484 (def-ppc-iformat (x-15 '(:name :tab bf "," l "," fra "," frb))
485   bf l fra frb (xo xo21-30))
486
487 (def-ppc-iformat (x-18 '(:name :tab bf))
488   bf (xo xo21-30))
489
490 (def-ppc-iformat (x-19 '(:name :tab to "," ra "," rb))
491   to ra rb (xo xo21-30))
492
493 (def-ppc-iformat (x-20 '(:name :tab frt "," ra "," rb))
494   frt ra rb (xo xo21-30))
495
496 (def-ppc-iformat (x-21 '(:name :tab frt "," rb))
497   frt rb (xo xo21-30) rc)
498
499 (def-ppc-iformat (x-22 '(:name :tab frt))
500   frt (xo xo21-30) rc)
501
502 (def-ppc-iformat (x-23 '(:name :tab ra "," frs "," rb))
503   frs ra rb (xo xo21-30))
504
505 (def-ppc-iformat (x-24 '(:name :tab bt))
506   bt (xo xo21-30) rc)
507
508 (def-ppc-iformat (x-25 '(:name :tab ra "," rb))
509   ra rb (xo xo21-30))
510
511 (def-ppc-iformat (x-26 '(:name :tab rb))
512   rb (xo xo21-30))
513
514 (def-ppc-iformat (x-27 '(:name))
515   (xo xo21-30))
516
517 \f
518 ;;;;
519
520 (def-ppc-iformat (xl '(:name :tab bt "," ba "," bb))
521   bt ba bb (xo xo21-30))
522
523 (def-ppc-iformat (xl-bo-bi '(:name :tab bo "," bi))
524   bo bi (xo xo21-30) lk)
525
526 (def-ppc-iformat (xl-cr '(:name :tab bf "," bfa))
527   bf bfa (xo xo21-30))
528
529 (def-ppc-iformat (xl-xo '(:name))
530   (xo xo21-30))
531
532 \f
533 ;;;;
534
535 (def-ppc-iformat (xfx)
536   rt spr (xo xo21-30))
537
538 (def-ppc-iformat (xfx-fxm '(:name :tab fxm "," rs))
539   rs fxm (xo xo21-30))
540
541 (def-ppc-iformat (xfl '(:name :tab flm "," frb))
542   flm frb (xo xo21-30) rc)
543
544 \f
545 ;;;
546
547 (def-ppc-iformat (xo '(:name :tab rt "," ra "," rb))
548   rt ra rb oe (xo xo22-30) rc)
549
550 (def-ppc-iformat (xo-oe '(:name :tab rt "," ra "," rb))
551   rt ra rb (xo xo22-30) rc)
552
553 (def-ppc-iformat (xo-a '(:name :tab rt "," ra))
554   rt ra oe (xo xo22-30) rc)
555
556 \f
557 ;;;
558
559 (def-ppc-iformat (a '(:name :tab frt "," fra "," frb "," frc))
560   frt fra frb frc (xo xo26-30) rc)
561
562 (def-ppc-iformat (a-tab '(:name :tab frt "," fra "," frb))
563   frt fra frb (xo xo26-30) rc)
564
565 (def-ppc-iformat (a-tac '(:name :tab frt "," fra "," frc))
566   frt fra frc (xo xo26-30) rc)
567
568 (def-ppc-iformat (a-tbc '(:name :tab frt "," frb "," frc))
569   frt frb frc (xo xo26-30) rc)
570 \f
571
572 (def-ppc-iformat (m '(:name :tab ra "," rs "," rb "," mb "," me))
573   rs ra rb mb me rc)
574
575 (def-ppc-iformat (m-sh '(:name :tab ra "," rs "," sh "," mb "," me))
576   rs ra sh mb me rc)))
577
578
579
580 \f
581 ;;;; Primitive emitters.
582
583
584 (define-bitfield-emitter emit-word 32
585   (byte 32 0))
586
587 (define-bitfield-emitter emit-short 16
588   (byte 16 0))
589
590 (define-bitfield-emitter emit-i-form-inst 32
591   (byte 6 26) (byte 24 2) (byte 1 1) (byte 1 0))
592
593 (define-bitfield-emitter emit-b-form-inst 32
594   (byte 6 26) (byte 5 21) (byte 5 16) (byte 14 2) (byte 1 1) (byte 1 0))
595
596 (define-bitfield-emitter emit-sc-form-inst 32
597   (byte 6 26) (byte 26 0))
598
599 (define-bitfield-emitter emit-d-form-inst 32
600   (byte 6 26) (byte 5 21) (byte 5 16) (byte 16 0))
601
602 ; Also used for XL-form.  What's the difference ?
603 (define-bitfield-emitter emit-x-form-inst 32
604   (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 10 1) (byte 1 0))
605
606 (define-bitfield-emitter emit-xfx-form-inst 32
607   (byte 6 26) (byte 5 21) (byte 10 11) (byte 10 1) (byte 1 0))
608
609 (define-bitfield-emitter emit-xfl-form-inst 32
610   (byte 6 26) (byte 10  16) (byte 5 11) (byte 10 1) (byte 1 0))
611
612 ; XS is 64-bit only
613 (define-bitfield-emitter emit-xo-form-inst 32
614   (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 1 10) (byte 9 1) (byte 1 0))
615
616 (define-bitfield-emitter emit-a-form-inst 32
617   (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 5 6) (byte 5 1) (byte 1 0))
618
619
620 \f
621
622 (defun unimp-control (chunk inst stream dstate)
623   (declare (ignore inst))
624   (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
625     (case (xinstr-data chunk dstate)
626       (#.error-trap
627        (nt "Error trap")
628        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
629       (#.cerror-trap
630        (nt "Cerror trap")
631        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
632       (#.object-not-list-trap
633        (nt "Object not list trap"))
634       (#.breakpoint-trap
635        (nt "Breakpoint trap"))
636       (#.pending-interrupt-trap
637        (nt "Pending interrupt trap"))
638       (#.halt-trap
639        (nt "Halt trap"))
640       (#.fun-end-breakpoint-trap
641        (nt "Function end breakpoint trap"))
642       (#.object-not-instance-trap
643        (nt "Object not instance trap"))
644     )))
645
646 (eval-when (:compile-toplevel :execute)
647
648 (defun classify-dependencies (deplist)
649   (collect ((reads) (writes))
650     (dolist (dep deplist)
651       (ecase (car dep)
652         (reads (reads dep))
653         (writes (writes dep))))
654     (values (reads) (writes)))))
655
656 (macrolet ((define-xo-instruction
657                (name op xo oe-p rc-p always-reads-xer always-writes-xer cost)
658                `(define-instruction ,name (segment rt ra rb)
659                  (:printer xo ((op ,op ) (xo ,xo) (oe ,(if oe-p 1 0)) (rc ,(if rc-p 1 0))))
660                  (:dependencies (reads ra) (reads rb) ,@(if always-reads-xer '((reads :xer)))
661                   (writes rt) ,@(if rc-p '((writes :ccr))) ,@(if (or oe-p always-writes-xer) '((writes :xer))) )
662                  (:cost ,cost)
663                  (:delay ,cost)
664                  (:emitter
665                   (emit-xo-form-inst segment ,op
666                    (reg-tn-encoding rt)
667                    (reg-tn-encoding ra)
668                    (reg-tn-encoding rb)
669                    ,(if oe-p 1 0)
670                    ,xo
671                    ,(if rc-p 1 0)))))
672            (define-xo-oe-instruction
673                (name op xo rc-p always-reads-xer always-writes-xer cost)
674                `(define-instruction ,name (segment rt ra rb)
675                  (:printer xo-oe ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
676                  (:dependencies (reads ra) (reads rb) ,@(if always-reads-xer '((reads :xer)))
677                   (writes rt) ,@(if rc-p '((writes :ccr))) ,@(if always-writes-xer '((writes :xer))))
678                  (:cost ,cost)
679                  (:delay ,cost)
680                  (:emitter
681                   (emit-xo-form-inst segment ,op
682                    (reg-tn-encoding rt)
683                    (reg-tn-encoding ra)
684                    (reg-tn-encoding rb)
685                    0
686                    ,xo
687                    (if ,rc-p 1 0)))))
688            (define-4-xo-instructions
689                (base op xo &key always-reads-xer always-writes-xer (cost 1))
690                `(progn
691                  (define-xo-instruction ,base ,op ,xo nil nil ,always-reads-xer ,always-writes-xer ,cost)
692                  (define-xo-instruction ,(symbolicate base ".") ,op ,xo nil t ,always-reads-xer ,always-writes-xer ,cost)
693                  (define-xo-instruction ,(symbolicate base "O") ,op ,xo t nil ,always-reads-xer ,always-writes-xer ,cost)
694                  (define-xo-instruction ,(symbolicate base "O.") ,op ,xo t t ,always-reads-xer ,always-writes-xer ,cost)))
695
696            (define-2-xo-oe-instructions (base op xo &key always-reads-xer always-writes-xer (cost 1))
697                `(progn
698                  (define-xo-oe-instruction ,base ,op ,xo nil ,always-reads-xer ,always-writes-xer ,cost)
699                  (define-xo-oe-instruction ,(symbolicate base ".") ,op ,xo t ,always-reads-xer ,always-writes-xer ,cost)))
700
701            (define-xo-a-instruction (name op xo oe-p rc-p always-reads-xer always-writes-xer cost)
702                `(define-instruction ,name (segment rt ra)
703                  (:printer xo-a ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0)) (oe ,(if oe-p 1 0))))
704                  (:dependencies (reads ra) ,@(if always-reads-xer '((reads :xer)))
705                   (writes rt) ,@(if rc-p '((writes :ccr))) ,@(if always-writes-xer '((writes :xer))) )
706                  (:cost ,cost)
707                  (:delay ,cost)
708                  (:emitter
709                   (emit-xo-form-inst segment ,op
710                    (reg-tn-encoding rt)
711                    (reg-tn-encoding ra)
712                    0
713                    (if ,oe-p 1 0)
714                    ,xo
715                    (if ,rc-p 1 0)))))
716
717            (define-4-xo-a-instructions (base op xo &key always-reads-xer always-writes-xer (cost 1))
718                `(progn
719                  (define-xo-a-instruction ,base ,op ,xo nil nil ,always-reads-xer ,always-writes-xer ,cost)
720                  (define-xo-a-instruction ,(symbolicate base ".") ,op ,xo nil t ,always-reads-xer ,always-writes-xer ,cost)
721                  (define-xo-a-instruction ,(symbolicate base "O")  ,op ,xo t nil ,always-reads-xer ,always-writes-xer ,cost)
722                  (define-xo-a-instruction ,(symbolicate base "O.") ,op ,xo t t ,always-reads-xer ,always-writes-xer ,cost)))
723
724            (define-x-instruction (name op xo &key (cost 2) other-dependencies)
725                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
726                  `(define-instruction ,name (segment rt ra rb)
727                    (:printer x ((op ,op) (xo ,xo)))
728                    (:delay ,cost)
729                    (:cost ,cost)
730                    (:dependencies (reads ra) (reads rb) (reads :memory) ,@other-reads
731                     (writes rt) ,@other-writes)
732                    (:emitter
733                     (emit-x-form-inst segment ,op
734                      (reg-tn-encoding rt)
735                      (reg-tn-encoding ra)
736                      (reg-tn-encoding rb)
737                      ,xo
738                      0)))))
739
740            (define-x-20-instruction (name op xo &key (cost 2) other-dependencies)
741                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
742                  `(define-instruction ,name (segment frt ra rb)
743                    (:printer x-20 ((op ,op) (xo ,xo)))
744                    (:delay ,cost)
745                    (:cost ,cost)
746                    (:dependencies (reads ra) (reads rb) ,@other-reads
747                     (writes frt) ,@other-writes)
748                    (:emitter
749                     (emit-x-form-inst segment ,op
750                      (fp-reg-tn-encoding frt)
751                      (reg-tn-encoding ra)
752                      (reg-tn-encoding rb)
753                      ,xo
754                      0)))))
755
756            (define-x-5-instruction (name op xo rc-p &key (cost 1) other-dependencies)
757                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
758                  `(define-instruction ,name (segment ra rs rb)
759                    (:printer x-5 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
760                    (:delay ,cost)
761                    (:cost ,cost)
762                    (:dependencies (reads rb) (reads rs) ,@other-reads
763                     (writes ra) ,@other-writes)
764                    (:emitter
765                     (emit-x-form-inst segment ,op
766                      (reg-tn-encoding rs)
767                      (reg-tn-encoding ra)
768                      (reg-tn-encoding rb)
769                      ,xo
770                      ,(if rc-p 1 0))))))
771
772
773            (define-x-5-st-instruction (name op xo rc-p &key (cost 1) other-dependencies)
774                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
775                  `(define-instruction ,name (segment rs ra rb)
776                    (:printer x-5 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
777                    (:delay ,cost)
778                    (:cost ,cost)
779                    (:dependencies (reads ra) (reads rb) (reads rs) ,@other-reads
780                     (writes :memory :partially t) ,@other-writes)
781                    (:emitter
782                     (emit-x-form-inst segment ,op
783                      (reg-tn-encoding rs)
784                      (reg-tn-encoding ra)
785                      (reg-tn-encoding rb)
786                      ,xo
787                      ,(if rc-p 1 0))))))
788
789            (define-x-23-st-instruction (name op xo &key (cost 1) other-dependencies)
790                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
791                  `(define-instruction ,name (segment frs ra rb)
792                    (:printer x-23 ((op ,op) (xo ,xo)))
793                    (:delay ,cost)
794                    (:cost ,cost)
795                    (:dependencies (reads ra) (reads rb) (reads frs) ,@other-reads
796                     (writes :memory :partially t) ,@other-writes)
797                    (:emitter
798                     (emit-x-form-inst segment ,op
799                      (fp-reg-tn-encoding frs)
800                      (reg-tn-encoding ra)
801                      (reg-tn-encoding rb)
802                      ,xo
803                      0)))))
804
805            (define-x-10-instruction (name op xo rc-p &key (cost 1) other-dependencies)
806                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
807                  `(define-instruction ,name (segment ra rs)
808                    (:printer x-10 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
809                    (:delay ,cost)
810                    (:cost ,cost)
811                    (:dependencies (reads rs) ,@other-reads
812                     (writes ra) ,@other-writes)
813                    (:emitter
814                     (emit-x-form-inst segment ,op
815                      (reg-tn-encoding rs)
816                      (reg-tn-encoding ra)
817                      0
818                      ,xo
819                      ,(if rc-p 1 0))))))
820
821            (define-2-x-5-instructions (name op xo &key (cost 1) other-dependencies)
822                `(progn
823                  (define-x-5-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
824                  (define-x-5-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
825                                          :other-dependencies ,other-dependencies)))
826
827            (define-2-x-10-instructions (name op xo &key (cost 1) other-dependencies)
828                `(progn
829                  (define-x-10-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
830                  (define-x-10-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
831                                           :other-dependencies ,other-dependencies)))
832
833
834            (define-x-21-instruction (name op xo rc-p &key (cost 4) other-dependencies)
835                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
836                  `(define-instruction ,name (segment frt frb)
837                    (:printer x-21 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
838                    (:cost ,cost)
839                    (:delay ,cost)
840                    (:dependencies (reads frb) ,@other-reads
841                     (writes frt) ,@other-writes)
842                    (:emitter
843                     (emit-x-form-inst segment ,op
844                      (fp-reg-tn-encoding frt)
845                      0
846                      (fp-reg-tn-encoding frb)
847                      ,xo
848                      ,(if rc-p 1 0))))))
849
850            (define-2-x-21-instructions (name op xo &key (cost 4) other-dependencies)
851                `(progn
852                  (define-x-21-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
853                  (define-x-21-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
854                                           :other-dependencies ,other-dependencies)))
855
856
857            (define-d-si-instruction (name op &key (fixup nil) (cost 1) other-dependencies)
858                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
859                  `(define-instruction ,name (segment rt ra si)
860                    (:declare (type (or ,@(when fixup '(fixup))
861                                        (unsigned-byte 16) (signed-byte 16))
862                                    si))
863                    (:printer d-si ((op ,op)))
864                    (:delay ,cost)
865                    (:cost ,cost)
866                    (:dependencies (reads ra) ,@other-reads
867                     (writes rt) ,@other-writes)
868                    (:emitter
869                     (when (typep si 'fixup)
870                       (ecase ,fixup
871                         ((:ha :l) (note-fixup segment ,fixup si)))
872                       (setq si 0))
873                     (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
874
875            (define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
876                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
877                  `(define-instruction ,name (segment ra rs ui)
878                    (:declare (type (unsigned-byte 16) ui))
879                    (:printer d-rs-ui ((op ,op)))
880                    (:cost ,cost)
881                    (:delay ,cost)
882                    (:dependencies (reads rs) ,@other-reads
883                     (writes ra) ,@other-writes)
884                    (:emitter
885                     (emit-d-form-inst segment ,op (reg-tn-encoding rs) (reg-tn-encoding ra) ui)))))
886
887            (define-d-instruction (name op &key (cost 2) other-dependencies pinned)
888                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
889                  `(define-instruction ,name (segment rt ra si)
890                    (:declare (type (signed-byte 16) si))
891                    (:printer d ((op ,op)))
892                    (:delay ,cost)
893                    (:cost ,cost)
894                    ,@(when pinned '(:pinned))
895                    (:dependencies (reads ra) (reads :memory) ,@other-reads
896                     (writes rt) ,@other-writes)
897                    (:emitter
898                     (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
899
900            (define-d-frt-instruction (name op &key (cost 3) other-dependencies)
901                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
902                  `(define-instruction ,name (segment frt ra si)
903                    (:declare (type (signed-byte 16) si))
904                    (:printer d-frt ((op ,op)))
905                    (:delay ,cost)
906                    (:cost ,cost)
907                    (:dependencies (reads ra) (reads :memory) ,@other-reads
908                     (writes frt) ,@other-writes)
909                    (:emitter
910                     (emit-d-form-inst segment ,op (fp-reg-tn-encoding frt) (reg-tn-encoding ra) si)))))
911
912            (define-d-rs-instruction (name op &key (cost 1) other-dependencies pinned)
913                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
914                  `(define-instruction ,name (segment rs ra si)
915                    (:declare (type (signed-byte 16) si))
916                    (:printer d-rs ((op ,op)))
917                    (:delay ,cost)
918                    (:cost ,cost)
919                    ,@(when pinned '(:pinned))
920                    (:dependencies (reads rs) (reads ra) ,@other-reads
921                     (writes :memory :partially t) ,@other-writes)
922                    (:emitter
923                     (emit-d-form-inst segment ,op (reg-tn-encoding rs) (reg-tn-encoding ra) si)))))
924
925            (define-d-frs-instruction (name op &key (cost 1) other-dependencies)
926                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
927                  `(define-instruction ,name (segment frs ra si)
928                    (:declare (type (signed-byte 16) si))
929                    (:printer d-frs ((op ,op)))
930                    (:delay ,cost)
931                    (:cost ,cost)
932                    (:dependencies (reads frs) (reads ra) ,@other-reads
933                     (writes :memory :partially t) ,@other-writes)
934                    (:emitter
935                     (emit-d-form-inst segment ,op (fp-reg-tn-encoding frs) (reg-tn-encoding ra) si)))))
936
937            (define-a-instruction (name op xo rc &key (cost 1) other-dependencies)
938                `(define-instruction ,name (segment frt fra frb frc)
939                  (:printer a ((op ,op) (xo ,xo) (rc ,rc)))
940                  (:cost ,cost)
941                  (:delay ,cost)
942                  (:dependencies (writes frt) (reads fra) (reads frb) (reads frc) ,@other-dependencies)
943                  (:emitter
944                   (emit-a-form-inst segment
945                    ,op
946                    (fp-reg-tn-encoding frt)
947                    (fp-reg-tn-encoding fra)
948                    (fp-reg-tn-encoding frb)
949                    (fp-reg-tn-encoding frb)
950                    ,xo
951                    ,rc))))
952
953            (define-2-a-instructions (name op xo &key (cost 1) other-dependencies)
954                `(progn
955                  (define-a-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
956                  (define-a-instruction ,(symbolicate name ".")
957                      ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))
958
959            (define-a-tab-instruction (name op xo rc &key (cost 1) other-dependencies)
960                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
961                  `(define-instruction ,name (segment frt fra frb)
962                    (:printer a-tab ((op ,op) (xo ,xo) (rc ,rc)))
963                    (:cost ,cost)
964                    (:delay 1)
965                    (:dependencies (reads fra) (reads frb) ,@other-reads
966                     (writes frt) ,@other-writes)
967                    (:emitter
968                     (emit-a-form-inst segment
969                      ,op
970                      (fp-reg-tn-encoding frt)
971                      (fp-reg-tn-encoding fra)
972                      (fp-reg-tn-encoding frb)
973                      0
974                      ,xo
975                      ,rc)))))
976
977            (define-2-a-tab-instructions (name op xo &key (cost 1) other-dependencies)
978                `(progn
979                  (define-a-tab-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
980                  (define-a-tab-instruction ,(symbolicate name ".")
981                      ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))
982
983            (define-a-tac-instruction (name op xo rc &key (cost 1) other-dependencies)
984                (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
985                  `(define-instruction ,name (segment frt fra frb)
986                    (:printer a-tac ((op ,op) (xo ,xo) (rc ,rc)))
987                    (:cost ,cost)
988                    (:delay 1)
989                    (:dependencies (reads fra) (reads frb) ,@other-reads
990                     (writes frt) ,@other-writes)
991                    (:emitter
992                     (emit-a-form-inst segment
993                      ,op
994                      (fp-reg-tn-encoding frt)
995                      (fp-reg-tn-encoding fra)
996                      0
997                      (fp-reg-tn-encoding frb)
998                      ,xo
999                      ,rc)))))
1000
1001            (define-2-a-tac-instructions (name op xo &key (cost 1) other-dependencies)
1002                `(progn
1003                  (define-a-tac-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
1004                  (define-a-tac-instruction ,(symbolicate name ".")
1005                      ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))
1006
1007            (define-crbit-instruction (name op xo)
1008                `(define-instruction ,name (segment dbit abit bbit)
1009                  (:printer xl ((op ,op ) (xo ,xo)))
1010                  (:delay 1)
1011                  (:cost 1)
1012                  (:dependencies (reads :ccr) (writes :ccr))
1013                  (:emitter (emit-x-form-inst segment 19
1014                             (valid-bi-encoding dbit)
1015                             (valid-bi-encoding abit)
1016                             (valid-bi-encoding bbit)
1017                             ,xo
1018                             0)))))
1019
1020    ;;; The instructions, in numerical order
1021
1022   (define-instruction unimp (segment data)
1023     (:declare (type (signed-byte 16) data))
1024     (:printer xinstr ((op-to-a #.(logior (ash 3 10) (ash 6 5) 0)))
1025               :default :control #'unimp-control)
1026     :pinned
1027     (:delay 0)
1028     (:emitter (emit-d-form-inst segment 3 6 0 data)))
1029
1030   (define-instruction twi (segment tcond ra si)
1031     (:printer d-to ((op 3)))
1032     (:delay 0)
1033     :pinned
1034     (:emitter (emit-d-form-inst segment 3 (valid-tcond-encoding tcond) (reg-tn-encoding ra) si)))
1035
1036   (define-d-si-instruction mulli 7 :cost 5)
1037   (define-d-si-instruction subfic 8)
1038
1039   (define-instruction cmplwi (segment crf ra &optional (ui nil ui-p))
1040     (:printer d-crf-ui ((op 10) (l 0)) '(:name :tab bf "," ra "," ui))
1041     (:dependencies (if ui-p (reads ra) (reads crf)) (writes :ccr))
1042     (:delay 1)
1043     (:emitter
1044      (unless ui-p
1045        (setq ui ra ra crf crf :cr0))
1046      (emit-d-form-inst segment
1047                        10
1048                        (valid-cr-field-encoding crf)
1049                        (reg-tn-encoding ra)
1050                        ui)))
1051
1052   (define-instruction cmpwi (segment crf ra  &optional (si nil si-p))
1053     (:printer d-crf-si ((op 11) (l 0)) '(:name :tab bf "," ra "," si))
1054     (:dependencies (if si-p (reads ra) (reads crf)) (writes :ccr))
1055     (:delay 1)
1056     (:emitter
1057      (unless si-p
1058        (setq si ra ra crf crf :cr0))
1059      (emit-d-form-inst segment
1060                        11
1061                        (valid-cr-field-encoding crf)
1062                        (reg-tn-encoding ra)
1063                        si)))
1064
1065   (define-d-si-instruction addic 12 :other-dependencies ((writes :xer)))
1066   (define-d-si-instruction addic. 13 :other-dependencies ((writes :xer) (writes :ccr)))
1067
1068   (define-d-si-instruction addi 14 :fixup :l)
1069   (define-d-si-instruction addis 15 :fixup :ha)
1070
1071   ;; There's no real support here for branch options that decrement
1072   ;; and test the CTR :
1073   ;; (a) the instruction scheduler doesn't know that anything's happening
1074   ;;    to the CTR
1075   ;; (b) Lisp may have to assume that the CTR always has a lisp
1076   ;;    object/locative in it.
1077
1078   (define-instruction bc (segment bo bi target)
1079     (:declare (type label target))
1080     (:printer b ((op 16) (aa 0) (lk 0)))
1081     (:attributes branch)
1082     (:delay 0)
1083     (:dependencies (reads :ccr))
1084     (:emitter
1085      (emit-conditional-branch segment bo bi target)))
1086
1087   (define-instruction bcl (segment bo bi target)
1088     (:declare (type label target))
1089     (:printer b ((op 16) (aa 0) (lk 1)))
1090     (:attributes branch)
1091     (:delay 0)
1092     (:dependencies (reads :ccr))
1093     (:emitter
1094      (emit-conditional-branch segment bo bi target nil t)))
1095
1096   (define-instruction bca (segment bo bi target)
1097     (:declare (type label target))
1098     (:printer b ((op 16) (aa 1) (lk 0)))
1099     (:attributes branch)
1100     (:delay 0)
1101     (:dependencies (reads :ccr))
1102     (:emitter
1103      (emit-conditional-branch segment bo bi target t)))
1104
1105   (define-instruction bcla (segment bo bi target)
1106     (:declare (type label target))
1107     (:printer b ((op 16) (aa 1) (lk 1)))
1108     (:attributes branch)
1109     (:delay 0)
1110     (:dependencies (reads :ccr))
1111     (:emitter
1112      (emit-conditional-branch segment bo bi target t t)))
1113
1114 ;;; There may (or may not) be a good reason to use this in preference
1115 ;;; to "b[la] target".  I can't think of a -bad- reason ...
1116
1117   (define-instruction bu (segment target)
1118     (:declare (type label target))
1119     (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (aa 0) (lk 0))
1120               '(:name :tab bd))
1121     (:attributes branch)
1122     (:delay 0)
1123     (:emitter
1124      (emit-conditional-branch segment #.(valid-bo-encoding :bo-u) 0 target nil nil)))
1125
1126
1127   (define-instruction bt (segment bi  target)
1128     (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-t)) (aa 0) (lk 0))
1129               '(:name :tab bi "," bd))
1130     (:attributes branch)
1131     (:delay 0)
1132     (:emitter
1133      (emit-conditional-branch segment #.(valid-bo-encoding :bo-t) bi target nil nil)))
1134
1135   (define-instruction bf (segment bi  target)
1136     (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-f)) (aa 0) (lk 0))
1137               '(:name :tab bi "," bd))
1138     (:attributes branch)
1139     (:delay 0)
1140     (:emitter
1141      (emit-conditional-branch segment #.(valid-bo-encoding :bo-f) bi target nil nil)))
1142
1143   (define-instruction b? (segment cr-field-name cr-name  &optional (target nil target-p))
1144     (:attributes branch)
1145     (:delay 0)
1146     (:emitter
1147      (unless target-p
1148        (setq target cr-name cr-name cr-field-name cr-field-name :cr0))
1149      (let*  ((+cond (position cr-name cr-bit-names))
1150              (-cond (position cr-name cr-bit-inverse-names))
1151              (b0 (if +cond :bo-t
1152                      (if -cond
1153                          :bo-f
1154                          (error "Unknown branch condition ~s" cr-name))))
1155              (cr-form (list cr-field-name (if +cond cr-name (svref cr-bit-names -cond)))))
1156        (emit-conditional-branch segment b0 cr-form target))))
1157
1158   (define-instruction sc (segment)
1159     (:printer sc ((op 17)))
1160     (:attributes branch)
1161     (:delay 0)
1162     :pinned
1163     (:emitter (emit-sc-form-inst segment 17 2)))
1164
1165   (define-instruction b (segment target)
1166     (:printer i ((op 18) (aa 0) (lk 0)))
1167     (:attributes branch)
1168     (:delay 0)
1169     (:emitter
1170      (emit-i-form-branch segment target nil)))
1171
1172   (define-instruction ba (segment target)
1173     (:printer i-abs ((op 18) (aa 1) (lk 0)))
1174     (:attributes branch)
1175     (:delay 0)
1176     (:emitter
1177      (when (typep target 'fixup)
1178        (note-fixup segment :ba target)
1179        (setq target 0))
1180      (emit-i-form-inst segment 18 (ash target -2) 1 0)))
1181
1182
1183   (define-instruction bl (segment target)
1184     (:printer i ((op 18) (aa 0) (lk 1)))
1185     (:attributes branch)
1186     (:delay 0)
1187     (:emitter
1188      (emit-i-form-branch segment target t)))
1189
1190   (define-instruction bla (segment target)
1191     (:printer i-abs ((op 18) (aa 1) (lk 1)))
1192     (:attributes branch)
1193     (:delay 0)
1194     (:emitter
1195      (when (typep target 'fixup)
1196        (note-fixup segment :ba target)
1197        (setq target 0))
1198      (emit-i-form-inst segment 18 (ash target -2) 1 1)))
1199
1200   (define-instruction blr (segment)
1201     (:printer xl-bo-bi ((op 19) (xo 16) (bo #.(valid-bo-encoding :bo-u))(bi 0) (lk 0))  '(:name))
1202     (:attributes branch)
1203     (:delay 0)
1204     (:dependencies (reads :ccr) (reads :ctr))
1205     (:emitter
1206      (emit-x-form-inst segment 19 (valid-bo-encoding :bo-u) 0 0 16 0)))
1207
1208   (define-instruction bclr (segment bo bi)
1209     (:printer xl-bo-bi ((op 19) (xo 16)))
1210     (:attributes branch)
1211     (:delay 0)
1212     (:dependencies (reads :ccr) (reads :lr))
1213     (:emitter
1214      (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 16 0)))
1215
1216   (define-instruction bclrl (segment bo bi)
1217     (:printer xl-bo-bi ((op 19) (xo 16) (lk 1)))
1218     (:attributes branch)
1219     (:delay 0)
1220     (:dependencies (reads :ccr) (reads :lr))
1221     (:emitter
1222      (emit-x-form-inst segment 19 (valid-bo-encoding bo)
1223                        (valid-bi-encoding bi) 0 16 1)))
1224
1225   (define-crbit-instruction crnor 19 33)
1226   (define-crbit-instruction crandc 19 129)
1227   (define-instruction isync (segment)
1228     (:printer xl-xo ((op 19) (xo 150)))
1229     (:delay 1)
1230     :pinned
1231     (:emitter (emit-x-form-inst segment 19 0 0 0 150 0)))
1232
1233   (define-crbit-instruction crxor 19 193)
1234   (define-crbit-instruction crnand 19 225)
1235   (define-crbit-instruction crand 19 257)
1236   (define-crbit-instruction creqv 19 289)
1237   (define-crbit-instruction crorc 19 417)
1238   (define-crbit-instruction cror 19 449)
1239
1240   (define-instruction bcctr (segment bo bi)
1241     (:printer xl-bo-bi ((op 19) (xo 528)))
1242     (:attributes branch)
1243     (:delay 0)
1244     (:dependencies (reads :ccr) (reads :ctr))
1245     (:emitter
1246      (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 528 0)))
1247
1248   (define-instruction bcctrl (segment bo bi)
1249     (:printer xl-bo-bi ((op 19) (xo 528) (lk 1)))
1250     (:attributes branch)
1251     (:delay 0)
1252     (:dependencies (reads :ccr) (reads :ctr) (writes :lr))
1253     (:emitter
1254      (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 528 1)))
1255
1256   (define-instruction bctr (segment)
1257     (:printer xl-bo-bi ((op 19) (xo 528) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (lk 0))  '(:name))
1258     (:attributes branch)
1259     (:delay 0)
1260     (:dependencies (reads :ccr) (reads :ctr))
1261     (:emitter
1262      (emit-x-form-inst segment 19 #.(valid-bo-encoding :bo-u) 0 0  528 0)))
1263
1264   (define-instruction bctrl (segment)
1265     (:printer xl-bo-bi ((op 19) (xo 528) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (lk 1))  '(:name))
1266     (:attributes branch)
1267     (:delay 0)
1268     (:dependencies (reads :ccr) (reads :ctr))
1269     (:emitter
1270      (emit-x-form-inst segment 19 #.(valid-bo-encoding :bo-u) 0 0  528 1)))
1271
1272   (define-instruction rlwimi (segment ra rs sh mb me)
1273     (:printer m-sh ((op 20) (rc 0)))
1274     (:dependencies (reads rs) (writes ra))
1275     (:delay 1)
1276     (:emitter
1277      (emit-a-form-inst segment 20 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 0)))
1278
1279   (define-instruction rlwimi. (segment ra rs sh mb me)
1280     (:printer m-sh ((op 20) (rc 1)))
1281     (:dependencies (reads rs) (writes ra) (writes :ccr))
1282     (:delay 1)
1283     (:emitter
1284      (emit-a-form-inst segment 20 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 1)))
1285
1286   (define-instruction rlwinm (segment ra rs sh mb me)
1287     (:printer m-sh ((op 21) (rc 0)))
1288     (:delay 1)
1289     (:dependencies (reads rs) (writes ra))
1290     (:emitter
1291      (emit-a-form-inst segment 21 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 0)))
1292
1293   (define-instruction rlwinm. (segment ra rs sh mb me)
1294     (:printer m-sh ((op 21) (rc 1)))
1295     (:delay 1)
1296     (:dependencies (reads rs) (writes ra) (writes :ccr))
1297     (:emitter
1298      (emit-a-form-inst segment 21 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 1)))
1299
1300   (define-instruction rlwnm (segment ra rs rb mb me)
1301     (:printer m ((op 23) (rc 0) (rb nil :type 'reg)))
1302     (:delay 1)
1303     (:dependencies (reads rs) (writes ra) (reads rb))
1304     (:emitter
1305      (emit-a-form-inst segment 23 (reg-tn-encoding rs) (reg-tn-encoding ra) (reg-tn-encoding rb) mb me 0)))
1306
1307   (define-instruction rlwnm. (segment ra rs rb mb me)
1308     (:printer m ((op 23) (rc 1) (rb nil :type 'reg)))
1309     (:delay 1)
1310     (:dependencies (reads rs) (reads rb) (writes ra) (writes :ccr))
1311     (:emitter
1312      (emit-a-form-inst segment 23 (reg-tn-encoding rs) (reg-tn-encoding ra) (reg-tn-encoding rb) mb me 1)))
1313
1314
1315   (define-d-rs-ui-instruction ori 24)
1316
1317   (define-instruction nop (segment)
1318     (:printer d-rs-ui ((op 24) (rs 0) (ra 0) (ui 0)) '(:name))
1319     (:cost 1)
1320     (:delay 1)
1321     (:emitter
1322      (emit-d-form-inst segment 24 0 0 0)))
1323
1324   (define-d-rs-ui-instruction oris 25)
1325   (define-d-rs-ui-instruction xori 26)
1326   (define-d-rs-ui-instruction xoris 27)
1327   (define-d-rs-ui-instruction andi. 28 :other-dependencies ((writes :ccr)))
1328   (define-d-rs-ui-instruction andis. 29 :other-dependencies ((writes :ccr)))
1329
1330   (define-instruction cmpw (segment crf ra  &optional (rb nil rb-p))
1331     (:printer x-14 ((op 31) (xo 0) (l 0)) '(:name :tab bf "," ra "," rb))
1332     (:delay 1)
1333     (:dependencies (reads ra) (if rb-p (reads rb) (reads crf)) (reads :xer) (writes :ccr))
1334     (:emitter
1335      (unless rb-p
1336        (setq rb ra ra crf crf :cr0))
1337      (emit-x-form-inst segment
1338                        31
1339                        (valid-cr-field-encoding crf)
1340                        (reg-tn-encoding ra)
1341                        (reg-tn-encoding rb)
1342                        0
1343                        0)))
1344
1345   (define-instruction tw (segment tcond ra rb)
1346     (:printer x-19 ((op 31) (xo 4)))
1347     (:attributes branch)
1348     (:delay 0)
1349     :pinned
1350     (:emitter (emit-x-form-inst segment 31 (valid-tcond-encoding tcond) (reg-tn-encoding ra) (reg-tn-encoding rb) 4 0)))
1351
1352   (define-4-xo-instructions subfc 31 8 :always-writes-xer t)
1353   (define-4-xo-instructions addc 31 10 :always-writes-xer t)
1354   (define-2-xo-oe-instructions mulhwu 31 11 :cost 5)
1355
1356   (define-instruction mfcr (segment rd)
1357     (:printer x-4 ((op 31) (xo 19)))
1358     (:delay 1)
1359     (:dependencies (reads :ccr) (writes rd))
1360     (:emitter (emit-x-form-inst segment 31 (reg-tn-encoding rd) 0 0 19 0)))
1361
1362   (define-x-instruction lwarx 31 20)
1363   (define-x-instruction lwzx 31 23)
1364   (define-2-x-5-instructions slw 31 24)
1365   (define-2-x-10-instructions cntlzw 31 26)
1366   (define-2-x-5-instructions and 31 28)
1367
1368   (define-instruction cmplw (segment crf ra  &optional (rb nil rb-p))
1369     (:printer x-14 ((op 31) (xo 32) (l 0)) '(:name :tab bf "," ra "," rb))
1370     (:delay 1)
1371     (:dependencies (reads ra) (if rb-p (reads rb) (reads crf)) (reads :xer) (writes :ccr))
1372     (:emitter
1373      (unless rb-p
1374        (setq rb ra ra crf crf :cr0))
1375      (emit-x-form-inst segment
1376                        31
1377                        (valid-cr-field-encoding crf)
1378                        (reg-tn-encoding ra)
1379                        (reg-tn-encoding rb)
1380                        32
1381                        0)))
1382
1383
1384   (define-4-xo-instructions subf 31 40)
1385                                         ; dcbst
1386   (define-x-instruction lwzux 31 55 :other-dependencies ((writes rt)))
1387   (define-2-x-5-instructions andc 31 60)
1388   (define-2-xo-oe-instructions mulhw 31 75 :cost 5)
1389
1390   (define-x-instruction lbzx 31 87)
1391   (define-4-xo-a-instructions neg 31 104)
1392   (define-x-instruction lbzux 31 119 :other-dependencies ((writes rt)))
1393   (define-2-x-5-instructions nor 31 124)
1394   (define-4-xo-instructions subfe 31 136 :always-reads-xer t :always-writes-xer t)
1395
1396   (define-instruction-macro sube (rt ra rb)
1397     `(inst subfe ,rt ,rb ,ra))
1398
1399   (define-instruction-macro sube. (rt ra rb)
1400     `(inst subfe. ,rt ,rb ,ra))
1401
1402   (define-instruction-macro subeo (rt ra rb)
1403     `(inst subfeo ,rt ,rb ,ra))
1404
1405   (define-instruction-macro subeo. (rt ra rb)
1406     `(inst subfeo ,rt ,rb ,ra))
1407
1408   (define-4-xo-instructions adde 31 138 :always-reads-xer t :always-writes-xer t)
1409
1410   (define-instruction mtcrf (segment mask rt)
1411     (:printer xfx-fxm ((op 31) (xo 144)))
1412     (:delay 1)
1413     (:dependencies (reads rt) (writes :ccr))
1414     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash mask 1) 144 0)))
1415
1416   (define-x-5-st-instruction stwcx. 31 150 t :other-dependencies ((writes :ccr)))
1417   (define-x-5-st-instruction stwx 31 151 nil)
1418   (define-x-5-st-instruction stwux 31 183 nil :other-dependencies ((writes ra)))
1419   (define-4-xo-a-instructions subfze 31 200 :always-reads-xer t :always-writes-xer t)
1420   (define-4-xo-a-instructions addze 31 202 :always-reads-xer t :always-writes-xer t)
1421   (define-x-5-st-instruction stbx 31 215 nil)
1422   (define-4-xo-a-instructions subfme 31 232 :always-reads-xer t :always-writes-xer t)
1423   (define-4-xo-a-instructions addme 31 234 :always-reads-xer t :always-writes-xer t)
1424   (define-4-xo-instructions mullw 31 235 :cost 5)
1425   (define-x-5-st-instruction stbux 31 247 nil :other-dependencies ((writes ra)))
1426   (define-4-xo-instructions add 31 266)
1427   (define-x-instruction lhzx 31 279)
1428   (define-2-x-5-instructions eqv 31 284)
1429   (define-x-instruction lhzux 31 311 :other-dependencies ((writes ra)))
1430   (define-2-x-5-instructions xor 31 316)
1431
1432   (define-instruction mfmq (segment rt)
1433     (:printer xfx ((op 31) (xo 339) (spr 0)) '(:name :tab rt))
1434     (:delay 1)
1435     (:dependencies (reads :xer) (writes rt))
1436     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 0 5) 339 0)))
1437
1438   (define-instruction mfxer (segment rt)
1439     (:printer xfx ((op 31) (xo 339) (spr 1)) '(:name :tab rt))
1440     (:delay 1)
1441     (:dependencies (reads :xer) (writes rt))
1442     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 1 5) 339 0)))
1443
1444   (define-instruction mflr (segment rt)
1445     (:printer xfx ((op 31) (xo 339) (spr 8)) '(:name :tab rt))
1446     (:delay 1)
1447     (:dependencies (reads :lr) (writes rt))
1448     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 8 5) 339 0)))
1449
1450   (define-instruction mfctr (segment rt)
1451     (:printer xfx ((op 31) (xo 339) (spr 9)) '(:name :tab rt))
1452     (:delay 1)
1453     (:dependencies (reads rt) (reads :ctr))
1454     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 9 5) 339 0)))
1455
1456
1457   (define-x-instruction lhax 31 343)
1458   (define-x-instruction lhaux 31 375 :other-dependencies ((writes ra)))
1459   (define-x-5-st-instruction sthx 31 407 nil)
1460   (define-2-x-5-instructions orc 31 412)
1461   (define-x-5-st-instruction sthux 31 439 nil :other-dependencies ((writes ra)))
1462
1463   (define-instruction or (segment ra rs rb)
1464     (:printer x-5 ((op 31) (xo 444) (rc 0)) '((:cond
1465                                                 ((rs :same-as rb) 'mr)
1466                                                 (t :name))
1467                                               :tab
1468                                               ra "," rs
1469                                               (:unless (:same-as rs) "," rb)))
1470     (:delay 1)
1471     (:cost 1)
1472     (:dependencies (reads rb) (reads rs) (writes ra))
1473     (:emitter
1474      (emit-x-form-inst segment
1475                        31
1476                        (reg-tn-encoding rs)
1477                        (reg-tn-encoding ra)
1478                        (reg-tn-encoding rb)
1479                        444
1480                        0)))
1481
1482   (define-instruction or. (segment ra rs rb)
1483     (:printer x-5 ((op 31) (xo 444) (rc 1)) '((:cond
1484                                                 ((rs :same-as rb) 'mr.)
1485                                                 (t :name))
1486                                               :tab
1487                                               ra "," rs
1488                                               (:unless (:same-as rs) "," rb)))
1489     (:delay 1)
1490     (:cost 1)
1491     (:dependencies (reads rb) (reads rs) (writes ra) (writes :ccr))
1492     (:emitter
1493      (emit-x-form-inst segment
1494                        31
1495                        (reg-tn-encoding rs)
1496                        (reg-tn-encoding ra)
1497                        (reg-tn-encoding rb)
1498                        444
1499                        1)))
1500
1501   (define-instruction-macro mr (ra rs)
1502     `(inst or ,ra ,rs ,rs))
1503
1504   (define-instruction-macro mr. (ra rs)
1505     `(inst or. ,ra ,rs ,rs))
1506
1507   (define-4-xo-instructions divwu 31 459 :cost 36)
1508
1509                                         ; This is a 601-specific instruction class.
1510   (define-4-xo-instructions div 31 331 :cost 36)
1511
1512                                         ; This is a 601-specific instruction.
1513   (define-instruction mtmq (segment rt)
1514     (:printer xfx ((op 31) (xo 467) (spr (ash 0 5))) '(:name :tab rt))
1515     (:delay 1)
1516     (:dependencies (reads rt) (writes :xer))
1517     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 0 5) 467 0)))
1518
1519   (define-instruction mtxer (segment rt)
1520     (:printer xfx ((op 31) (xo 467) (spr (ash 1 5))) '(:name :tab rt))
1521     (:delay 1)
1522     (:dependencies (reads rt) (writes :xer))
1523     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 1 5) 467 0)))
1524
1525   (define-instruction mtlr (segment rt)
1526     (:printer xfx ((op 31) (xo 467) (spr (ash 8 5))) '(:name :tab rt))
1527     (:delay 1)
1528     (:dependencies (reads rt) (writes :lr))
1529     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 8 5) 467 0)))
1530
1531   (define-instruction mtctr (segment rt)
1532     (:printer xfx ((op 31) (xo 467) (spr (ash 9 5))) '(:name :tab rt))
1533     (:delay 1)
1534     (:dependencies (reads rt) (writes :ctr))
1535     (:emitter (emit-xfx-form-inst segment 31 (reg-tn-encoding rt) (ash 9 5) 467 0)))
1536
1537
1538   (define-2-x-5-instructions nand 31 476)
1539   (define-4-xo-instructions divw 31 491 :cost 36)
1540   (define-instruction mcrxr (segment crf)
1541     (:printer x-18 ((op 31) (xo 512)))
1542     (:delay 1)
1543     (:dependencies (reads :xer) (writes :ccr) (writes :xer))
1544     (:emitter (emit-x-form-inst segment 31 (valid-cr-field-encoding crf) 0 0 512 0)))
1545
1546   (define-instruction lswx (segment rs ra rb)
1547     (:printer x ((op 31) (xo 533) (rc 0)))
1548     (:delay 1)
1549     :pinned
1550     (:cost 8)
1551     (:emitter (emit-x-form-inst sb!assem:segment 31 (reg-tn-encoding rs) (reg-tn-encoding ra) (reg-tn-encoding rb) 533 0)))
1552   (define-x-instruction lwbrx 31 534)
1553   (define-x-20-instruction lfsx 31 535)
1554   (define-2-x-5-instructions srw 31 536)
1555   (define-x-20-instruction lfsux 31 567 :other-dependencies ((writes ra)))
1556
1557   (define-instruction lswi (segment rt ra rb)
1558     (:printer x-1 ((op 31) (xo 597) (rc 0)))
1559     :pinned
1560     (:delay 8)
1561     (:cost 8)
1562     (:emitter (emit-x-form-inst sb!assem:segment 31 (reg-tn-encoding rt) (reg-tn-encoding ra) rb 597 0)))
1563
1564   (define-instruction sync (segment)
1565     (:printer x-27 ((op 31) (xo 598)))
1566     (:delay 1)
1567     :pinned
1568     (:emitter (emit-x-form-inst segment 31 0 0 0 598 0)))
1569   (define-x-20-instruction lfdx 31 599)
1570   (define-x-20-instruction lfdux 31 631 :other-dependencies ((writes ra)))
1571   (define-instruction stswx (segment rs ra rb)
1572     (:printer x-5 ((op 31) (xo 661)))
1573     :pinned
1574     (:cost 8)
1575     (:delay 1)
1576     (:emitter (emit-x-form-inst sb!assem:segment 31
1577                                 (reg-tn-encoding rs)
1578                                 (reg-tn-encoding ra)
1579                                 (reg-tn-encoding rb)
1580                                 661
1581                                 0)))
1582   (define-x-5-st-instruction stwbrx 31 662 nil)
1583   (define-x-23-st-instruction stfsx 31 663)
1584   (define-x-23-st-instruction stfsux 31 695 :other-dependencies ((writes ra)))
1585   (define-instruction stswi (segment rs ra nb)
1586     (:printer x-8 ((op 31) (xo 725)))
1587     :pinned
1588     (:delay 1)
1589     (:emitter
1590      (emit-x-form-inst segment 31
1591                        (reg-tn-encoding rs)
1592                        (reg-tn-encoding ra)
1593                        nb
1594                        725
1595                        0)))
1596
1597   (define-x-23-st-instruction stfdx 31 727)
1598   (define-x-23-st-instruction stfdux 31 759 :other-dependencies ((writes ra)))
1599   (define-x-instruction lhbrx 31 790)
1600   (define-2-x-5-instructions sraw 31 792)
1601
1602   (define-instruction srawi (segment ra rs rb)
1603     (:printer x-9 ((op 31) (xo 824) (rc 0)))
1604     (:cost 1)
1605     (:delay 1)
1606     (:dependencies (reads rs) (writes ra))
1607     (:emitter
1608      (emit-x-form-inst segment 31
1609                        (reg-tn-encoding rs)
1610                        (reg-tn-encoding ra)
1611                        rb
1612                        824
1613                        0)))
1614
1615   (define-instruction srawi. (segment ra rs rb)
1616     (:printer x-9 ((op 31) (xo 824) (rc 1)))
1617     (:cost 1)
1618     (:delay 1)
1619     (:dependencies (reads rs) (writes ra) (writes :ccr))
1620     (:emitter
1621      (emit-x-form-inst segment 31
1622                        (reg-tn-encoding rs)
1623                        (reg-tn-encoding ra)
1624                        rb
1625                        824
1626                         1)))
1627
1628   (define-instruction eieio (segment)
1629     (:printer x-27 ((op 31) (xo 854)))
1630     :pinned
1631     (:delay 1)
1632     (:emitter (emit-x-form-inst segment 31 0 0 0 854 0)))
1633
1634   (define-x-5-st-instruction sthbrx 31 918 nil)
1635
1636   (define-2-x-10-instructions extsb 31 954)
1637   (define-2-x-10-instructions extsh 31 922)
1638                                         ; Whew.
1639
1640   (define-instruction lwz (segment rt ra si)
1641     (:declare (type (or fixup (signed-byte 16)) si))
1642     (:printer d ((op 32)))
1643     (:delay 2)
1644     (:cost 2)
1645     (:dependencies (reads ra) (writes rt) (reads :memory))
1646     (:emitter
1647      (when (typep si 'fixup)
1648        (note-fixup segment :l si)
1649        (setq si 0))
1650      (emit-d-form-inst segment 32 (reg-tn-encoding rt) (reg-tn-encoding ra) si)))
1651
1652   (define-d-instruction lwzu 33 :other-dependencies ((writes ra)))
1653   (define-d-instruction lbz 34)
1654   (define-d-instruction lbzu 35 :other-dependencies ((writes ra)))
1655   (define-d-rs-instruction stw 36)
1656   (define-d-rs-instruction stwu 37 :other-dependencies ((writes ra)))
1657   (define-d-rs-instruction stb 38)
1658   (define-d-rs-instruction stbu 39 :other-dependencies ((writes ra)))
1659   (define-d-instruction lhz 40)
1660   (define-d-instruction lhzu 41 :other-dependencies ((writes ra)))
1661   (define-d-instruction lha 42)
1662   (define-d-instruction lhau 43 :other-dependencies ((writes ra)))
1663   (define-d-rs-instruction sth 44)
1664   (define-d-rs-instruction sthu 45 :other-dependencies ((writes ra)))
1665   (define-d-instruction lmw 46 :pinned t)
1666   (define-d-rs-instruction stmw 47 :pinned t)
1667   (define-d-frt-instruction lfs 48)
1668   (define-d-frt-instruction lfsu 49 :other-dependencies ((writes ra)))
1669   (define-d-frt-instruction lfd 50)
1670   (define-d-frt-instruction lfdu 51 :other-dependencies ((writes ra)))
1671   (define-d-frs-instruction stfs 52)
1672   (define-d-frs-instruction stfsu 53 :other-dependencies ((writes ra)))
1673   (define-d-frs-instruction stfd 54)
1674   (define-d-frs-instruction stfdu 55 :other-dependencies ((writes ra)))
1675
1676   (define-2-a-tab-instructions fdivs 59 18 :cost 17)
1677   (define-2-a-tab-instructions fsubs 59 20)
1678   (define-2-a-tab-instructions fadds 59 21)
1679   (define-2-a-tac-instructions fmuls 59 25)
1680   (define-2-a-instructions fmsubs 59 28 :cost 4)
1681   (define-2-a-instructions fmadds 59 29 :cost 4)
1682   (define-2-a-instructions fnmsubs 59 30 :cost 4)
1683   (define-2-a-instructions fnmadds 59 31 :cost 4)
1684
1685   (define-instruction fcmpu (segment crfd fra frb)
1686     (:printer x-15 ((op 63) (xo 0)))
1687     (:dependencies (reads fra) (reads frb) (reads :fpscr)
1688                    (writes :fpscr) (writes :ccr))
1689     (:cost 4)
1690     (:delay 4)
1691     (:emitter (emit-x-form-inst segment
1692                                 63
1693                                 (valid-cr-field-encoding crfd)
1694                                 (fp-reg-tn-encoding fra)
1695                                 (fp-reg-tn-encoding frb)
1696                                 0
1697                                 0)))
1698
1699
1700   (define-2-x-21-instructions frsp 63 12)
1701   (define-2-x-21-instructions fctiw 63 14)
1702   (define-2-x-21-instructions fctiwz 63 15)
1703
1704   (define-2-a-tab-instructions fdiv 63 18 :cost 31)
1705   (define-2-a-tab-instructions fsub 63 20)
1706   (define-2-a-tab-instructions fadd 63 21)
1707   (define-2-a-tac-instructions fmul 63 25 :cost 5)
1708   (define-2-a-instructions fmsub 63 28 :cost 5)
1709   (define-2-a-instructions fmadd 63 29 :cost 5)
1710   (define-2-a-instructions fnmsub 63 30 :cost 5)
1711   (define-2-a-instructions fnmadd 63 31 :cost 5)
1712
1713   (define-instruction fcmpo (segment crfd fra frb)
1714     (:printer x-15 ((op 63) (xo 32)))
1715     (:dependencies (reads fra) (reads frb) (reads :fpscr)
1716                    (writes :fpscr) (writes :ccr))
1717     (:cost 4)
1718     (:delay 1)
1719     (:emitter (emit-x-form-inst segment
1720                                 63
1721                                 (valid-cr-field-encoding crfd)
1722                                 (fp-reg-tn-encoding fra)
1723                                 (fp-reg-tn-encoding frb)
1724                                 32
1725                               0)))
1726
1727   (define-2-x-21-instructions fneg 63 40)
1728
1729   (define-2-x-21-instructions fmr 63 72)
1730   (define-2-x-21-instructions fnabs 63 136)
1731   (define-2-x-21-instructions fabs 63 264)
1732
1733   (define-instruction mffs (segment frd)
1734   (:printer x-22 ((op 63)  (xo 583) (rc 0)))
1735   (:delay 1)
1736   (:dependencies (reads :fpscr) (writes frd))
1737   (:emitter (emit-x-form-inst segment
1738                           63
1739                           (fp-reg-tn-encoding frd)
1740                           0
1741                           0
1742                           583
1743                           0)))
1744
1745   (define-instruction mffs. (segment frd)
1746   (:printer x-22 ((op 63)  (xo 583) (rc 1)))
1747   (:delay 1)
1748   (:dependencies (reads :fpscr) (writes frd) (writes :ccr))
1749   (:emitter (emit-x-form-inst segment
1750                           63
1751                           (fp-reg-tn-encoding frd)
1752                           0
1753                           0
1754                           583
1755                           1)))
1756
1757   (define-instruction mtfsf (segment mask rb)
1758   (:printer xfl ((op 63) (xo 711) (rc 0)))
1759   (:dependencies (reads rb) (writes :fpscr))
1760   (:delay 1)
1761   (:emitter (emit-xfl-form-inst segment 63  (ash mask 1) (fp-reg-tn-encoding rb) 711 0)))
1762
1763   (define-instruction mtfsf. (segment mask rb)
1764   (:printer xfl ((op 63) (xo 711) (rc 1)))
1765   (:delay 1)
1766   (:dependencies (reads rb) (writes :ccr) (writes :fpscr))
1767   (:emitter (emit-xfl-form-inst segment 63  (ash mask 1) (fp-reg-tn-encoding rb) 711 1)))
1768
1769
1770
1771 \f
1772 ;;; Here in the future, macros are our friends.
1773
1774   (define-instruction-macro subis (rt ra simm)
1775     `(inst addis ,rt ,ra (- ,simm)))
1776
1777   (define-instruction-macro sub (rt rb ra)
1778     `(inst subf ,rt ,ra ,rb))
1779   (define-instruction-macro sub. (rt rb ra)
1780     `(inst subf. ,rt ,ra ,rb))
1781   (define-instruction-macro subo (rt rb ra)
1782     `(inst subfo ,rt ,ra ,rb))
1783   (define-instruction-macro subo. (rt rb ra)
1784     `(inst subfo. ,rt ,ra ,rb))
1785
1786
1787   (define-instruction-macro subic (rt ra simm)
1788     `(inst addic ,rt ,ra (- ,simm)))
1789
1790
1791   (define-instruction-macro subic. (rt ra simm)
1792     `(inst addic. ,rt ,ra (- ,simm)))
1793
1794
1795
1796   (define-instruction-macro subc (rt rb ra)
1797     `(inst subfc ,rt ,ra ,rb))
1798   (define-instruction-macro subc. (rt rb ra)
1799     `(inst subfc. ,rt ,ra ,rb))
1800   (define-instruction-macro subco (rt rb ra)
1801     `(inst subfco ,rt ,ra ,rb))
1802   (define-instruction-macro subco. (rt rb ra)
1803     `(inst subfco. ,rt ,ra ,rb))
1804
1805   (define-instruction-macro subi (rt ra simm)
1806     `(inst addi ,rt ,ra (- ,simm)))
1807
1808   (define-instruction-macro li (rt val)
1809     `(inst addi ,rt zero-tn ,val))
1810
1811   (define-instruction-macro lis (rt val)
1812     `(inst addis ,rt zero-tn ,val))
1813
1814
1815   (define-instruction-macro not (ra rs)
1816     `(inst nor ,ra ,rs ,rs))
1817
1818   (define-instruction-macro not. (ra rs)
1819     `(inst nor. ,ra ,rs ,rs))
1820
1821
1822   (!def-vm-support-routine emit-nop (segment)
1823                            (emit-word segment #x60000000))
1824
1825   (define-instruction-macro extlwi (ra rs n b)
1826     `(inst rlwinm ,ra ,rs ,b 0 (1- ,n)))
1827
1828   (define-instruction-macro extlwi. (ra rs n b)
1829     `(inst rlwinm. ,ra ,rs ,b 0 (1- ,n)))
1830
1831   (define-instruction-macro extrwi (ra rs n b)
1832     `(inst rlwinm ,ra ,rs (mod (+ ,b ,n) 32) (- 32 ,n) 31))
1833
1834   (define-instruction-macro extrwi. (ra rs n b)
1835     `(inst rlwinm. ,ra ,rs (mod (+ ,b ,n) 32) (- 32 ,n) 31))
1836
1837   (define-instruction-macro srwi (ra rs n)
1838     `(inst rlwinm ,ra ,rs (- 32 ,n) ,n 31))
1839
1840   (define-instruction-macro srwi. (ra rs n)
1841     `(inst rlwinm. ,ra ,rs (- 32 ,n) ,n 31))
1842
1843   (define-instruction-macro clrlwi (ra rs n)
1844     `(inst rlwinm ,ra ,rs 0 ,n 31))
1845
1846   (define-instruction-macro clrlwi. (ra rs n)
1847     `(inst rlwinm. ,ra ,rs 0 ,n 31))
1848
1849   (define-instruction-macro clrrwi (ra rs n)
1850     `(inst rlwinm ,ra ,rs 0 0 (- 31 ,n)))
1851
1852   (define-instruction-macro clrrwi. (ra rs n)
1853     `(inst rlwinm. ,ra ,rs 0 0 (- 31 ,n)))
1854
1855   (define-instruction-macro inslw (ra rs n b)
1856     `(inst rlwimi ,ra ,rs (- 32 ,b) ,b (+ ,b (1- ,n))))
1857
1858   (define-instruction-macro inslw. (ra rs n b)
1859     `(inst rlwimi. ,ra ,rs (- 32 ,b) ,b (+ ,b (1- ,n))))
1860
1861   (define-instruction-macro rotlw (ra rs rb)
1862     `(inst rlwnm ,ra ,rs ,rb 0 31))
1863
1864   (define-instruction-macro rotlw. (ra rs rb)
1865     `(inst rlwnm. ,ra ,rs ,rb 0 31))
1866
1867   (define-instruction-macro rotlwi (ra rs n)
1868     `(inst rlwinm ,ra ,rs ,n 0 31))
1869
1870   (define-instruction-macro rotrwi (ra rs n)
1871     `(inst rlwinm ,ra ,rs (- 32 ,n) 0 31))
1872
1873   (define-instruction-macro slwi (ra rs n)
1874     `(inst rlwinm ,ra ,rs ,n 0 (- 31 ,n)))
1875
1876   (define-instruction-macro slwi. (ra rs n)
1877     `(inst rlwinm. ,ra ,rs ,n 0 (- 31 ,n))))
1878
1879
1880
1881
1882 #|
1883 (macrolet
1884   ((define-conditional-branches (name bo-name)
1885      (let* ((bo-enc (valid-bo-encoding bo-name)))
1886        `(progn
1887           (define-instruction-macro ,(symbolicate name "A") (bi target)
1888             ``(inst bca ,,,bo-enc ,,bi ,,target))
1889           (define-instruction-macro ,(symbolicate name "L") (bi target)
1890             ``(inst bcl ,,,bo-enc ,,bi ,,target))
1891           (define-instruction-macro ,(symbolicate name "LA") (bi target)
1892             ``(inst bcla ,,,bo-enc ,,bi ,,target))
1893           (define-instruction-macro ,(symbolicate name "CTR") (bi target)
1894             ``(inst bcctr ,,,bo-enc ,,bi ,,target))
1895           (define-instruction-macro ,(symbolicate name "CTRL") (bi target)
1896             ``(inst bcctrl ,,,bo-enc ,,bi ,,target))
1897           (define-instruction-macro ,(symbolicate name "LR") (bi target)
1898             ``(inst bclr ,,,bo-enc ,,bi ,,target))
1899           (define-instruction-macro ,(symbolicate name "LRL") (bi target)
1900             ``(inst bclrl ,,,bo-enc ,,bi ,,target))))))
1901   (define-conditional-branches bt :bo-t)
1902   (define-conditional-branches bf :bo-f))
1903 |#
1904
1905 (macrolet
1906   ((define-positive-conditional-branches (name cr-bit-name)
1907      `(progn
1908         (define-instruction-macro ,name (crf &optional (target nil target-p))
1909           (unless target-p
1910             (setq target crf crf :cr0))
1911           `(inst bt `(,,crf ,,,cr-bit-name) ,target))
1912 #|
1913         (define-instruction-macro ,(symbolicate name "A") (target &optional (cr-field :cr0))
1914           ``(inst bta (,,cr-field ,,,cr-bit-name) ,,target))
1915         (define-instruction-macro ,(symbolicate name "L") (target &optional (cr-field :cr0))
1916           ``(inst btl (,,cr-field ,,,cr-bit-name) ,,target))
1917         (define-instruction-macro ,(symbolicate name "LA") (target &optional (cr-field :cr0))
1918           ``(inst btla (,,cr-field ,,,cr-bit-name) ,,target))
1919         (define-instruction-macro ,(symbolicate name "CTR") (target &optional (cr-field :cr0))
1920           ``(inst btctr (,,cr-field ,,,cr-bit-name) ,,target))
1921         (define-instruction-macro ,(symbolicate name "CTRL") (target &optional (cr-field :cr0))
1922           ``(inst btctrl (,,cr-field ,,,cr-bit-name) ,,target))
1923         (define-instruction-macro ,(symbolicate name "LR") (target &optional (cr-field :cr0))
1924           ``(inst btlr (,,cr-field ,,,cr-bit-name) ,,target))
1925         (define-instruction-macro ,(symbolicate name "LRL") (target &optional (cr-field :cr0))
1926           ``(inst btlrl (,,cr-field ,,,cr-bit-name) ,,target))
1927 |#
1928         )))
1929   (define-positive-conditional-branches beq :eq)
1930   (define-positive-conditional-branches blt :lt)
1931   (define-positive-conditional-branches bgt :gt)
1932   (define-positive-conditional-branches bso :so)
1933   (define-positive-conditional-branches bun :so))
1934
1935
1936 (macrolet
1937   ((define-negative-conditional-branches (name cr-bit-name)
1938      `(progn
1939         (define-instruction-macro ,name (crf &optional (target nil target-p))
1940           (unless target-p
1941             (setq target crf crf :cr0))
1942           `(inst bf `(,,crf ,,,cr-bit-name) ,target))
1943 #|
1944         (define-instruction-macro ,(symbolicate name "A") (target &optional (cr-field :cr0))
1945           ``(inst bfa (,,cr-field ,,,cr-bit-name) ,,target))
1946         (define-instruction-macro ,(symbolicate name "L") (target &optional (cr-field :cr0))
1947           ``(inst bfl (,,cr-field ,,,cr-bit-name) ,,target))
1948         (define-instruction-macro ,(symbolicate name "LA") (target &optional (cr-field :cr0))
1949           ``(inst bfla (,,cr-field ,,,cr-bit-name) ,,target))
1950         (define-instruction-macro ,(symbolicate name "CTR") (target &optional (cr-field :cr0))
1951           ``(inst bfctr (,,cr-field ,,,cr-bit-name) ,,target))
1952         (define-instruction-macro ,(symbolicate name "CTRL") (target &optional (cr-field :cr0))
1953           ``(inst bfctrl (,,cr-field ,,,cr-bit-name) ,,target))
1954         (define-instruction-macro ,(symbolicate name "LR") (target &optional (cr-field :cr0))
1955           ``(inst bflr (,,cr-field ,,,cr-bit-name) ,,target))
1956         (define-instruction-macro ,(symbolicate name "LRL") (target &optional (cr-field :cr0))
1957           ``(inst bflrl (,,cr-field ,,,cr-bit-name) ,,target))
1958 |#
1959 )))
1960   (define-negative-conditional-branches bne :eq)
1961   (define-negative-conditional-branches bnl :lt)
1962   (define-negative-conditional-branches bge :lt)
1963   (define-negative-conditional-branches bng :gt)
1964   (define-negative-conditional-branches ble :gt)
1965   (define-negative-conditional-branches bns :so)
1966   (define-negative-conditional-branches bnu :so))
1967
1968
1969
1970 (define-instruction-macro j (func-tn offset)
1971   `(progn
1972     (inst addi lip-tn ,func-tn ,offset)
1973     (inst mtctr lip-tn)
1974     (inst bctr)))
1975
1976
1977 #|
1978 (define-instruction-macro bua (target)
1979   `(inst bca :bo-u 0 ,target))
1980
1981 (define-instruction-macro bul (target)
1982   `(inst bcl :bo-u 0 ,target))
1983
1984 (define-instruction-macro bula (target)
1985   `(inst bcla :bo-u 0 ,target))
1986 |#
1987
1988 (define-instruction-macro blrl ()
1989   `(inst bclrl :bo-u 0))
1990
1991 \f
1992 ;;; Some more macros
1993
1994 (defun %lr (reg value)
1995   (etypecase value
1996     ((signed-byte 16)
1997      (inst li reg value))
1998     ((unsigned-byte 16)
1999      (inst ori reg zero-tn value))
2000     ((or (signed-byte 32) (unsigned-byte 32))
2001      (let* ((high-half (ldb (byte 16 16) value))
2002             (low-half (ldb (byte 16 0) value)))
2003        (declare (type (unsigned-byte 16) high-half low-half))
2004        (cond ((and (logbitp 15 low-half) (= high-half #xffff))
2005               (inst li reg (dpb low-half (byte 16 0) -1)))
2006              ((and (not (logbitp 15 low-half)) (zerop high-half))
2007               (inst li reg low-half))
2008              (t
2009               (inst lis reg (if (logbitp 15 high-half)
2010                                 (dpb high-half (byte 16 0) -1)
2011                                 high-half))
2012               (unless (zerop low-half)
2013                 (inst ori reg reg low-half))))))
2014     (fixup
2015      (inst lis reg value)
2016      (inst addi reg reg value))))
2017
2018 (define-instruction-macro lr (reg value)
2019   `(%lr ,reg ,value))
2020
2021
2022 \f
2023 ;;;; Instructions for dumping data and header objects.
2024
2025 (define-instruction word (segment word)
2026   (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
2027   :pinned
2028   (:delay 0)
2029   (:emitter
2030    (emit-word segment word)))
2031
2032 (define-instruction short (segment short)
2033   (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
2034   :pinned
2035   (:delay 0)
2036   (:emitter
2037    (emit-short segment short)))
2038
2039 (define-instruction byte (segment byte)
2040   (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
2041   :pinned
2042   (:delay 0)
2043   (:emitter
2044    (emit-byte segment byte)))
2045
2046 (define-bitfield-emitter emit-header-object 32
2047   (byte 24 8) (byte 8 0))
2048
2049 (defun emit-header-data (segment type)
2050   (emit-back-patch
2051    segment 4
2052    #'(lambda (segment posn)
2053        (emit-word segment
2054                   (logior type
2055                           (ash (+ posn (component-header-length))
2056                                (- n-widetag-bits word-shift)))))))
2057
2058 (define-instruction simple-fun-header-word (segment)
2059   :pinned
2060   (:delay 0)
2061   (:emitter
2062    (emit-header-data segment simple-fun-header-widetag)))
2063
2064 (define-instruction lra-header-word (segment)
2065   :pinned
2066   (:delay 0)
2067   (:emitter
2068    (emit-header-data segment return-pc-header-widetag)))
2069
2070 \f
2071 ;;;; Instructions for converting between code objects, functions, and lras.
2072 (defun emit-compute-inst (segment vop dst src label temp calc)
2073   (emit-chooser
2074    ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
2075    segment 12 3
2076    #'(lambda (segment posn delta-if-after)
2077        (let ((delta (funcall calc label posn delta-if-after)))
2078          (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
2079            (emit-back-patch segment 4
2080                             #'(lambda (segment posn)
2081                                 (assemble (segment vop)
2082                                           (inst addi dst src
2083                                                 (funcall calc label posn 0)))))
2084            t)))
2085    #'(lambda (segment posn)
2086        (let ((delta (funcall calc label posn 0)))
2087          (assemble (segment vop)
2088                    (inst lis temp (ldb (byte 16 16) delta))
2089                    (inst ori temp temp (ldb (byte 16 0) delta))
2090                    (inst add dst src temp))))))
2091
2092 ;; code = lip - header - label-offset + other-pointer-tag
2093 (define-instruction compute-code-from-lip (segment dst src label temp)
2094   (:declare (type tn dst src temp) (type label label))
2095   (:attributes variable-length)
2096   (:dependencies (reads src) (writes dst) (writes temp))
2097   (:delay 0)
2098   (:vop-var vop)
2099   (:emitter
2100    (emit-compute-inst segment vop dst src label temp
2101                       #'(lambda (label posn delta-if-after)
2102                           (- other-pointer-lowtag
2103                              ;;function-pointer-type
2104                              (label-position label posn delta-if-after)
2105                              (component-header-length))))))
2106
2107 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
2108 ;;      = lra - (header + label-offset)
2109 (define-instruction compute-code-from-lra (segment dst src label temp)
2110   (:declare (type tn dst src temp) (type label label))
2111   (:attributes variable-length)
2112   (:dependencies (reads src) (writes dst) (writes temp))
2113   (:delay 0)
2114   (:vop-var vop)
2115   (:emitter
2116    (emit-compute-inst segment vop dst src label temp
2117                       #'(lambda (label posn delta-if-after)
2118                           (- (+ (label-position label posn delta-if-after)
2119                                 (component-header-length)))))))
2120
2121 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
2122 ;;     = code + header + label-offset
2123 (define-instruction compute-lra-from-code (segment dst src label temp)
2124   (:declare (type tn dst src temp) (type label label))
2125   (:attributes variable-length)
2126   (:dependencies (reads src) (writes dst) (writes temp))
2127   (:delay 0)
2128   (:vop-var vop)
2129   (:emitter
2130    (emit-compute-inst segment vop dst src label temp
2131                       #'(lambda (label posn delta-if-after)
2132                           (+ (label-position label posn delta-if-after)
2133                              (component-header-length))))))