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