X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Finsts.lisp;h=a6b7c7231461df6c2c804a520db62c7730d807d3;hb=85483d976cc2d779493985f77f39efefb2ea622b;hp=63332dbd729220cdf361aecdac9c6946b9ba4090;hpb=e67cc0f952040723f7d0f37ddb88fe895f4b1464;p=sbcl.git diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index 63332db..a6b7c72 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -23,8 +23,8 @@ (null null-offset) (t (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers) - (tn-offset tn) - (error "~S isn't a register." tn))))) + (tn-offset tn) + (error "~S isn't a register." tn))))) (defun fp-reg-tn-encoding (tn) (declare (type tn tn)) @@ -45,55 +45,54 @@ (tn (ecase (sb-name (sc-sb (tn-sc loc))) (immediate-constant - ;; Can happen if $ZERO or $NULL are passed in. - nil) + ;; Can happen if $ZERO or $NULL are passed in. + nil) (registers - (unless (zerop (tn-offset loc)) - (tn-offset loc))) + (unless (zerop (tn-offset loc)) + (tn-offset loc))) (float-registers - (+ (tn-offset loc) 32)))) + (+ (tn-offset loc) 32)))) (symbol (ecase loc (:memory 0) (:hi-reg 64) (:low-reg 65) (:float-status 66) - (:ctrl-stat-reg 67) - (:r31 31))))) + (:ctrl-stat-reg 67))))) (defparameter reg-symbols (map 'vector #'(lambda (name) - (cond ((null name) nil) - (t (make-symbol (concatenate 'string "$" name))))) + (cond ((null name) nil) + (t (make-symbol (concatenate 'string "$" name))))) *register-names*)) (sb!disassem:define-arg-type reg :printer #'(lambda (value stream dstate) - (declare (stream stream) (fixnum value)) - (let ((regname (aref reg-symbols value))) - (princ regname stream) - (sb!disassem:maybe-note-associated-storage-ref - value - 'registers - regname - dstate)))) + (declare (stream stream) (fixnum value)) + (let ((regname (aref reg-symbols value))) + (princ regname stream) + (sb!disassem:maybe-note-associated-storage-ref + value + 'registers + regname + dstate)))) (defparameter float-reg-symbols - #.(coerce + #.(coerce (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n))) 'vector)) (sb!disassem:define-arg-type fp-reg :printer #'(lambda (value stream dstate) - (declare (stream stream) (fixnum value)) - (let ((regname (aref float-reg-symbols value))) - (princ regname stream) - (sb!disassem:maybe-note-associated-storage-ref - value - 'float-registers - regname - dstate)))) + (declare (stream stream) (fixnum value)) + (let ((regname (aref float-reg-symbols value))) + (princ regname stream) + (sb!disassem:maybe-note-associated-storage-ref + value + 'float-registers + regname + dstate)))) (sb!disassem:define-arg-type control-reg :printer "(CR:#x~X)") @@ -101,9 +100,9 @@ (sb!disassem:define-arg-type relative-label :sign-extend t :use-label #'(lambda (value dstate) - (declare (type (signed-byte 16) value) - (type sb!disassem:disassem-state dstate)) - (+ (ash (1+ value) 2) (sb!disassem:dstate-cur-addr dstate)))) + (declare (type (signed-byte 16) value) + (type sb!disassem:disassem-state dstate)) + (+ (ash (1+ value) 2) (sb!disassem:dstate-cur-addr dstate)))) (deftype float-format () '(member :s :single :d :double :w :word)) @@ -116,15 +115,15 @@ (sb!disassem:define-arg-type float-format :printer #'(lambda (value stream dstate) - (declare (ignore dstate) - (stream stream) - (fixnum value)) - (princ (case value - (0 's) - (1 'd) - (4 'w) - (t '?)) - stream))) + (declare (ignore dstate) + (stream stream) + (fixnum value)) + (princ (case value + (0 's) + (1 'd) + (4 'w) + (t '?)) + stream))) (defconstant-eqx compare-kinds '(:f :un :eq :ueq :olt :ult :ole :ule :sf :ngle :seq :ngl :lt :nge :le :ngt) @@ -140,8 +139,8 @@ (defun compare-kind (kind) (or (position kind compare-kinds) (error "Unknown floating point compare kind: ~S~%Must be one of: ~S" - kind - compare-kinds))) + kind + compare-kinds))) (sb!disassem:define-arg-type compare-kind :printer compare-kinds-vec) @@ -159,8 +158,8 @@ (defun float-operation (op) (or (position op float-operations) (error "Unknown floating point operation: ~S~%Must be one of: ~S" - op - float-operations))) + op + float-operations))) (sb!disassem:define-arg-type float-operation :printer float-operation-names) @@ -199,9 +198,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter jump-printer #'(lambda (value stream dstate) - (let ((addr (ash value 2))) - (sb!disassem:maybe-note-assembler-routine addr t dstate) - (write addr :base 16 :radix t :stream stream))))) + (let ((addr (ash value 2))) + (sb!disassem:maybe-note-assembler-routine addr t dstate) + (write addr :base 16 :radix t :stream stream))))) (sb!disassem:define-instruction-format (jump 32 :default-printer '(:name :tab target)) @@ -223,10 +222,10 @@ (sb!disassem:define-instruction-format (break 32 :default-printer - '(:name :tab code (:unless (:constant 0) subcode))) + '(:name :tab code (:unless (:constant 0) ", " subcode))) (op :field (byte 6 26) :value special-op) (code :field (byte 10 16)) - (subcode :field (byte 10 6) :value 0) + (subcode :field (byte 10 6)) (funct :field (byte 6 0) :value #b001101)) (sb!disassem:define-instruction-format @@ -243,10 +242,10 @@ (defconstant-eqx float-printer `(:name ,@float-fmt-printer - :tab - fd - (:unless (:same-as fd) ", " fs) - ", " ft) + :tab + fd + (:unless (:same-as fd) ", " fs) + ", " ft) #'equalp) (sb!disassem:define-instruction-format @@ -272,13 +271,13 @@ (sb!disassem:define-instruction-format (float-op 32 - :include 'float - :default-printer - '('f funct "." format - :tab - fd - (:unless (:same-as fd) ", " fs) - ", " ft)) + :include 'float + :default-printer + '('f funct "." format + :tab + fd + (:unless (:same-as fd) ", " fs) + ", " ft)) (funct :field (byte 2 0) :type 'float-operation) (funct-filler :field (byte 4 2) :value 0) (ft :value nil :type 'fp-reg)) @@ -313,28 +312,28 @@ ;;;; Math instructions. (defun emit-math-inst (segment dst src1 src2 reg-opcode immed-opcode - &optional allow-fixups) + &optional allow-fixups) (unless src2 (setf src2 src1) (setf src1 dst)) (etypecase src2 (tn (emit-register-inst segment special-op (reg-tn-encoding src1) - (reg-tn-encoding src2) (reg-tn-encoding dst) - 0 reg-opcode)) + (reg-tn-encoding src2) (reg-tn-encoding dst) + 0 reg-opcode)) (integer (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1) - (reg-tn-encoding dst) src2)) + (reg-tn-encoding dst) src2)) (fixup (unless allow-fixups (error "Fixups aren't allowed.")) (note-fixup segment :addi src2) (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1) - (reg-tn-encoding dst) 0)))) + (reg-tn-encoding dst) 0)))) (define-instruction add (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (signed-byte 16) null) src1 src2)) + (type (or tn (signed-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b100000))) (:printer immediate ((op #b001000))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -344,7 +343,7 @@ (define-instruction addu (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (signed-byte 16) fixup null) src1 src2)) + (type (or tn (signed-byte 16) fixup null) src1 src2)) (:printer register ((op special-op) (funct #b100001))) (:printer immediate ((op #b001001))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -364,8 +363,8 @@ (setf src2 src1) (setf src1 dst)) (emit-math-inst segment dst src1 - (if (integerp src2) (- src2) src2) - #b100010 #b001000))) + (if (integerp src2) (- src2) src2) + #b100010 #b001000))) (define-instruction subu (segment dst src1 &optional src2) (:declare @@ -380,12 +379,12 @@ (setf src2 src1) (setf src1 dst)) (emit-math-inst segment dst src1 - (if (integerp src2) (- src2) src2) - #b100011 #b001001 t))) + (if (integerp src2) (- src2) src2) + #b100011 #b001001 t))) (define-instruction and (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 16) null) src1 src2)) + (type (or tn (unsigned-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b100100))) (:printer immediate ((op #b001100) (immediate nil :sign-extend nil))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -395,7 +394,7 @@ (define-instruction or (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 16) null) src1 src2)) + (type (or tn (unsigned-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b100101))) (:printer immediate ((op #b001101))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -405,7 +404,7 @@ (define-instruction xor (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 16) null) src1 src2)) + (type (or tn (unsigned-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b100110))) (:printer immediate ((op #b001110))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -423,7 +422,7 @@ (define-instruction slt (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (signed-byte 16) null) src1 src2)) + (type (or tn (signed-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b101010))) (:printer immediate ((op #b001010))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -433,7 +432,7 @@ (define-instruction sltu (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (signed-byte 16) null) src1 src2)) + (type (or tn (signed-byte 16) null) src1 src2)) (:printer register ((op special-op) (funct #b101011))) (:printer immediate ((op #b001011))) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) @@ -450,17 +449,17 @@ (:delay 1) (:emitter (emit-register-inst segment special-op (reg-tn-encoding src1) - (reg-tn-encoding src2) 0 0 #b011010))) + (reg-tn-encoding src2) 0 0 #b011010))) (define-instruction divu (segment src1 src2) (:declare (type tn src1 src2)) (:printer register ((op special-op) (rd 0) (funct #b011011)) - divmul-printer) + divmul-printer) (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg)) (:delay 1) (:emitter (emit-register-inst segment special-op (reg-tn-encoding src1) - (reg-tn-encoding src2) 0 0 #b011011))) + (reg-tn-encoding src2) 0 0 #b011011))) (define-instruction mult (segment src1 src2) (:declare (type tn src1 src2)) @@ -469,7 +468,7 @@ (:delay 1) (:emitter (emit-register-inst segment special-op (reg-tn-encoding src1) - (reg-tn-encoding src2) 0 0 #b011000))) + (reg-tn-encoding src2) 0 0 #b011000))) (define-instruction multu (segment src1 src2) (:declare (type tn src1 src2)) @@ -478,7 +477,7 @@ (:delay 1) (:emitter (emit-register-inst segment special-op (reg-tn-encoding src1) - (reg-tn-encoding src2) 0 0 #b011001))) + (reg-tn-encoding src2) 0 0 #b011001))) (defun emit-shift-inst (segment opcode dst src1 src2) (unless src2 @@ -487,11 +486,11 @@ (etypecase src2 (tn (emit-register-inst segment special-op (reg-tn-encoding src2) - (reg-tn-encoding src1) (reg-tn-encoding dst) - 0 (logior #b000100 opcode))) + (reg-tn-encoding src1) (reg-tn-encoding dst) + 0 (logior #b000100 opcode))) ((unsigned-byte 5) (emit-register-inst segment special-op 0 (reg-tn-encoding src1) - (reg-tn-encoding dst) src2 opcode)))) + (reg-tn-encoding dst) src2 opcode)))) (defconstant-eqx shift-printer '(:name :tab @@ -503,9 +502,9 @@ (define-instruction sll (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 5) null) src1 src2)) + (type (or tn (unsigned-byte 5) null) src1 src2)) (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000000)) - shift-printer) + shift-printer) (:printer register ((op special-op) (funct #b000100)) shift-printer) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) (:delay 0) @@ -514,9 +513,9 @@ (define-instruction sra (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 5) null) src1 src2)) + (type (or tn (unsigned-byte 5) null) src1 src2)) (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000011)) - shift-printer) + shift-printer) (:printer register ((op special-op) (funct #b000111)) shift-printer) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) (:delay 0) @@ -525,9 +524,9 @@ (define-instruction srl (segment dst src1 &optional src2) (:declare (type tn dst) - (type (or tn (unsigned-byte 5) null) src1 src2)) + (type (or tn (unsigned-byte 5) null) src1 src2)) (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000010)) - shift-printer) + shift-printer) (:printer register ((op special-op) (funct #b000110)) shift-printer) (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst)) (:delay 0) @@ -539,15 +538,15 @@ (define-instruction float-op (segment operation format dst src1 src2) (:declare (type float-operation operation) - (type float-format format) - (type tn dst src1 src2)) + (type float-format format) + (type tn dst src1 src2)) (:printer float-op ()) (:dependencies (reads src1) (reads src2) (writes dst)) (:delay 0) (:emitter (emit-float-inst segment cop1-op 1 (float-format-value format) - (fp-reg-tn-encoding src2) (fp-reg-tn-encoding src1) - (fp-reg-tn-encoding dst) (float-operation operation)))) + (fp-reg-tn-encoding src2) (fp-reg-tn-encoding src1) + (fp-reg-tn-encoding dst) (float-operation operation)))) (defconstant-eqx float-unop-printer `(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs)) @@ -560,8 +559,8 @@ (:delay 0) (:emitter (emit-float-inst segment cop1-op 1 (float-format-value format) - 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) - #b000101))) + 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) + #b000101))) (define-instruction fneg (segment format dst &optional (src dst)) (:declare (type float-format format) (type tn dst src)) @@ -570,32 +569,32 @@ (:delay 0) (:emitter (emit-float-inst segment cop1-op 1 (float-format-value format) - 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) - #b000111))) - + 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) + #b000111))) + (define-instruction fcvt (segment format1 format2 dst src) (:declare (type float-format format1 format2) (type tn dst src)) (:printer float-aux ((funct #b10) (sub-funct nil :type 'float-format)) - `(:name "." sub-funct "." format :tab fd ", " fs)) + `(:name "." sub-funct "." format :tab fd ", " fs)) (:dependencies (reads src) (writes dst)) (:delay 0) (:emitter (emit-float-inst segment cop1-op 1 (float-format-value format2) 0 - (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) - (logior #b100000 (float-format-value format1))))) + (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) + (logior #b100000 (float-format-value format1))))) (define-instruction fcmp (segment operation format fs ft) (:declare (type compare-kind operation) - (type float-format format) - (type tn fs ft)) + (type float-format format) + (type tn fs ft)) (:printer float-aux ((fd 0) (funct #b11) (sub-funct nil :type 'compare-kind)) - `(:name "-" sub-funct "." format :tab fs ", " ft)) + `(:name "-" sub-funct "." format :tab fs ", " ft)) (:dependencies (reads fs) (reads ft) (writes :float-status)) (:delay 1) (:emitter - (emit-float-inst segment cop1-op 1 (float-format-value format) - (fp-reg-tn-encoding ft) (fp-reg-tn-encoding fs) 0 - (logior #b110000 (compare-kind operation))))) + (emit-float-inst segment cop1-op 1 (float-format-value format) + (fp-reg-tn-encoding ft) (fp-reg-tn-encoding fs) 0 + (logior #b110000 (compare-kind operation))))) ;;;; Branch/Jump instructions. @@ -604,61 +603,61 @@ (emit-chooser segment 20 2 #'(lambda (segment posn magic-value) - (declare (ignore magic-value)) + (declare (ignore magic-value)) (let ((delta (ash (- (label-position target) (+ posn 4)) -2))) - (when (typep delta '(signed-byte 16)) - (emit-back-patch segment 4 - #'(lambda (segment posn) - (emit-immediate-inst segment - opcode - (if (fixnump r1) - r1 - (reg-tn-encoding r1)) - (if (fixnump r2) - r2 - (reg-tn-encoding r2)) - (ash (- (label-position target) - (+ posn 4)) - -2)))) - t))) + (when (typep delta '(signed-byte 16)) + (emit-back-patch segment 4 + #'(lambda (segment posn) + (emit-immediate-inst segment + opcode + (if (fixnump r1) + r1 + (reg-tn-encoding r1)) + (if (fixnump r2) + r2 + (reg-tn-encoding r2)) + (ash (- (label-position target) + (+ posn 4)) + -2)))) + t))) #'(lambda (segment posn) - (declare (ignore posn)) - (let ((linked)) - ;; invert branch condition - (if (or (= opcode bcond-op) (= opcode cop1-op)) - (setf r2 (logxor r2 #b00001)) - (setf opcode (logxor opcode #b00001))) - ;; check link flag - (if (= opcode bcond-op) - (if (logand r2 #b10000) - (progn (setf r2 (logand r2 #b01111)) - (setf linked t)))) - (emit-immediate-inst segment - opcode - (if (fixnump r1) r1 (reg-tn-encoding r1)) - (if (fixnump r2) r2 (reg-tn-encoding r2)) - 4) - (emit-nop segment) - (emit-back-patch segment 8 - #'(lambda (segment posn) - (declare (ignore posn)) - (emit-immediate-inst segment #b001111 0 - (reg-tn-encoding lip-tn) - (ldb (byte 16 16) - (label-position target))) - (emit-immediate-inst segment #b001101 0 - (reg-tn-encoding lip-tn) - (ldb (byte 16 0) - (label-position target))))) - (emit-register-inst segment special-op (reg-tn-encoding lip-tn) - 0 (if linked 31 0) 0 - (if linked #b001001 #b001000)))))) + (declare (ignore posn)) + (let ((linked)) + ;; invert branch condition + (if (or (= opcode bcond-op) (= opcode cop1-op)) + (setf r2 (logxor r2 #b00001)) + (setf opcode (logxor opcode #b00001))) + ;; check link flag + (if (= opcode bcond-op) + (if (logand r2 #b10000) + (progn (setf r2 (logand r2 #b01111)) + (setf linked t)))) + (emit-immediate-inst segment + opcode + (if (fixnump r1) r1 (reg-tn-encoding r1)) + (if (fixnump r2) r2 (reg-tn-encoding r2)) + 4) + (emit-nop segment) + (emit-back-patch segment 8 + #'(lambda (segment posn) + (declare (ignore posn)) + (emit-immediate-inst segment #b001111 0 + (reg-tn-encoding lip-tn) + (ldb (byte 16 16) + (label-position target))) + (emit-immediate-inst segment #b001101 0 + (reg-tn-encoding lip-tn) + (ldb (byte 16 0) + (label-position target))))) + (emit-register-inst segment special-op (reg-tn-encoding lip-tn) + 0 (if linked 31 0) 0 + (if linked #b001001 #b001000)))))) (define-instruction b (segment target) (:declare (type label target)) (:printer immediate ((op #b000100) (rs 0) (rt 0) - (immediate nil :type 'relative-label)) - '(:name :tab immediate)) + (immediate nil :type 'relative-label)) + '(:name :tab immediate)) (:attributes branch) (:delay 1) (:emitter @@ -667,18 +666,18 @@ (define-instruction bal (segment target) (:declare (type label target)) (:printer immediate ((op bcond-op) (rs 0) (rt #b01001) - (immediate nil :type 'relative-label)) - '(:name :tab immediate)) + (immediate nil :type 'relative-label)) + '(:name :tab immediate)) (:attributes branch) - (:dependencies (writes :r31)) + (:dependencies (writes lip-tn)) (:delay 1) (:emitter (emit-relative-branch segment bcond-op 0 #b10001 target))) (define-instruction beq (segment r1 r2-or-target &optional target) (:declare (type tn r1) - (type (or tn fixnum label) r2-or-target) - (type (or label null) target)) + (type (or tn fixnum label) r2-or-target) + (type (or label null) target)) (:printer immediate ((op #b000100) (immediate nil :type 'relative-label))) (:attributes branch) (:dependencies (reads r1) (if target (reads r2-or-target))) @@ -691,8 +690,8 @@ (define-instruction bne (segment r1 r2-or-target &optional target) (:declare (type tn r1) - (type (or tn fixnum label) r2-or-target) - (type (or label null) target)) + (type (or tn fixnum label) r2-or-target) + (type (or label null) target)) (:printer immediate ((op #b000101) (immediate nil :type 'relative-label))) (:attributes branch) (:dependencies (reads r1) (if target (reads r2-or-target))) @@ -711,7 +710,7 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op #b000110) (rt 0) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) (:dependencies (reads reg)) (:delay 1) @@ -722,7 +721,7 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op #b000111) (rt 0) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) (:dependencies (reads reg)) (:delay 1) @@ -733,7 +732,7 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op bcond-op) (rt 0) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) (:dependencies (reads reg)) (:delay 1) @@ -744,7 +743,7 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op bcond-op) (rt 1) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) (:dependencies (reads reg)) (:delay 1) @@ -755,9 +754,9 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op bcond-op) (rt #b01000) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) - (:dependencies (reads reg) (writes :r31)) + (:dependencies (reads reg) (writes lip-tn)) (:delay 1) (:emitter (emit-relative-branch segment bcond-op reg #b10000 target))) @@ -766,10 +765,10 @@ (:declare (type label target) (type tn reg)) (:printer immediate ((op bcond-op) (rt #b01001) (immediate nil :type 'relative-label)) - cond-branch-printer) + cond-branch-printer) (:attributes branch) (:delay 1) - (:dependencies (reads reg) (writes :r31)) + (:dependencies (reads reg) (writes lip-tn)) (:emitter (emit-relative-branch segment bcond-op reg #b10001 target))) @@ -780,7 +779,7 @@ (define-instruction j (segment target) (:declare (type (or tn fixup) target)) (:printer register ((op special-op) (rt 0) (rd 0) (funct #b001000)) - j-printer) + j-printer) (:printer jump ((op #b000010)) j-printer) (:attributes branch) (:dependencies (reads target)) @@ -789,35 +788,48 @@ (etypecase target (tn (emit-register-inst segment special-op (reg-tn-encoding target) - 0 0 0 #b001000)) + 0 0 0 #b001000)) (fixup - (note-fixup segment :jump target) - (emit-jump-inst segment #b000010 0))))) + (note-fixup segment :lui target) + (emit-immediate-inst segment #b001111 0 28 0) + (note-fixup segment :addi target) + (emit-immediate-inst segment #b001001 28 28 0) + (emit-register-inst segment special-op 28 0 0 0 #b001000))))) (define-instruction jal (segment reg-or-target &optional target) (:declare (type (or null tn fixup) target) - (type (or tn fixup (integer -16 31)) reg-or-target)) + (type (or tn fixup) reg-or-target)) (:printer register ((op special-op) (rt 0) (funct #b001001)) j-printer) (:printer jump ((op #b000011)) j-printer) (:attributes branch) - (:dependencies (if target (writes reg-or-target) (writes :r31))) + (:dependencies (cond + (target + (writes reg-or-target) (reads target)) + (t + (writes lip-tn) + (when (tn-p reg-or-target) + (reads reg-or-target))))) (:delay 1) (:emitter (unless target - (setf target reg-or-target) - (setf reg-or-target 31)) + (setf target reg-or-target + reg-or-target lip-tn)) (etypecase target (tn (emit-register-inst segment special-op (reg-tn-encoding target) 0 - reg-or-target 0 #b001001)) + (reg-tn-encoding reg-or-target) 0 #b001001)) (fixup - (note-fixup segment :jump target) - (emit-jump-inst segment #b000011 0))))) + (note-fixup segment :lui target) + (emit-immediate-inst segment #b001111 0 28 0) + (note-fixup segment :addi target) + (emit-immediate-inst segment #b001001 28 28 0) + (emit-register-inst segment special-op 28 0 + (reg-tn-encoding reg-or-target) 0 #b001001))))) (define-instruction bc1f (segment target) (:declare (type label target)) (:printer coproc-branch ((op cop1-op) (funct #x100) - (offset nil :type 'relative-label))) + (offset nil :type 'relative-label))) (:attributes branch) (:dependencies (reads :float-status)) (:delay 1) @@ -827,7 +839,7 @@ (define-instruction bc1t (segment target) (:declare (type label target)) (:printer coproc-branch ((op cop1-op) (funct #x101) - (offset nil :type 'relative-label))) + (offset nil :type 'relative-label))) (:attributes branch) (:dependencies (reads :float-status)) (:delay 1) @@ -840,9 +852,9 @@ (define-instruction lui (segment reg value) (:declare (type tn reg) - (type (or fixup (signed-byte 16) (unsigned-byte 16)) value)) + (type (or fixup (signed-byte 16) (unsigned-byte 16)) value)) (:printer immediate ((op #b001111) - (immediate nil :sign-extend nil :printer "#x~4,'0X"))) + (immediate nil :sign-extend nil :printer "#x~4,'0X"))) (:dependencies (writes reg)) (:delay 0) (:emitter @@ -857,53 +869,53 @@ (define-instruction mfhi (segment reg) (:declare (type tn reg)) (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010000)) - mvsreg-printer) + mvsreg-printer) (:dependencies (reads :hi-reg) (writes reg)) (:delay 2) (:emitter (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0 - #b010000))) + #b010000))) (define-instruction mthi (segment reg) (:declare (type tn reg)) (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010001)) - mvsreg-printer) + mvsreg-printer) (:dependencies (reads reg) (writes :hi-reg)) (:delay 0) (:emitter (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0 - #b010001))) + #b010001))) (define-instruction mflo (segment reg) (:declare (type tn reg)) (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010010)) - mvsreg-printer) + mvsreg-printer) (:dependencies (reads :low-reg) (writes reg)) (:delay 2) (:emitter (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0 - #b010010))) + #b010010))) (define-instruction mtlo (segment reg) (:declare (type tn reg)) (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010011)) - mvsreg-printer) + mvsreg-printer) (:dependencies (reads reg) (writes :low-reg)) (:delay 0) (:emitter (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0 - #b010011))) + #b010011))) (define-instruction move (segment dst src) (:declare (type tn dst src)) (:printer register ((op special-op) (rt 0) (funct #b100001)) - '(:name :tab rd ", " rs)) + '(:name :tab rd ", " rs)) (:attributes flushable) (:dependencies (reads src) (writes dst)) (:delay 0) (:emitter (emit-register-inst segment special-op (reg-tn-encoding src) 0 - (reg-tn-encoding dst) 0 #b100001))) + (reg-tn-encoding dst) 0 #b100001))) (define-instruction fmove (segment format dst src) (:declare (type float-format format) (type tn dst src)) @@ -913,8 +925,8 @@ (:delay 0) (:emitter (emit-float-inst segment cop1-op 1 (float-format-value format) 0 - (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) - #b000110))) + (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst) + #b000110))) (defun %li (reg value) (etypecase value @@ -928,7 +940,7 @@ (fixup (inst lui reg value) (inst addu reg value)))) - + (define-instruction-macro li (reg value) `(%li ,reg ,value)) @@ -941,7 +953,7 @@ (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from) - (fp-reg-tn-encoding to) 0 0))) + (fp-reg-tn-encoding to) 0 0))) (define-instruction mtc1-odd (segment to from) (:declare (type tn to from)) @@ -949,17 +961,17 @@ (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from) - (1+ (fp-reg-tn-encoding to)) 0 0))) + (1+ (fp-reg-tn-encoding to)) 0 0))) (define-instruction mfc1 (segment to from) (:declare (type tn to from)) (:printer register ((op cop1-op) (rs 0) (rd nil :type 'fp-reg) (funct 0)) - sub-op-printer) + sub-op-printer) (:dependencies (reads from) (writes to)) (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to) - (fp-reg-tn-encoding from) 0 0))) + (fp-reg-tn-encoding from) 0 0))) (define-instruction mfc1-odd (segment to from) (:declare (type tn to from)) @@ -967,7 +979,7 @@ (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to) - (1+ (fp-reg-tn-encoding from)) 0 0))) + (1+ (fp-reg-tn-encoding from)) 0 0))) (define-instruction mfc1-odd2 (segment to from) (:declare (type tn to from)) @@ -975,7 +987,7 @@ (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to)) - (fp-reg-tn-encoding from) 0 0))) + (fp-reg-tn-encoding from) 0 0))) (define-instruction mfc1-odd3 (segment to from) (:declare (type tn to from)) @@ -983,27 +995,27 @@ (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to)) - (1+ (fp-reg-tn-encoding from)) 0 0))) + (1+ (fp-reg-tn-encoding from)) 0 0))) (define-instruction cfc1 (segment reg cr) (:declare (type tn reg) (type (unsigned-byte 5) cr)) (:printer register ((op cop1-op) (rs #b00010) (rd nil :type 'control-reg) - (funct 0)) sub-op-printer) + (funct 0)) sub-op-printer) (:dependencies (reads :ctrl-stat-reg) (writes reg)) (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00010 (reg-tn-encoding reg) - cr 0 0))) + cr 0 0))) (define-instruction ctc1 (segment reg cr) (:declare (type tn reg) (type (unsigned-byte 5) cr)) (:printer register ((op cop1-op) (rs #b00110) (rd nil :type 'control-reg) - (funct 0)) sub-op-printer) + (funct 0)) sub-op-printer) (:dependencies (reads reg) (writes :ctrl-stat-reg)) (:delay 1) (:emitter (emit-register-inst segment cop1-op #b00110 (reg-tn-encoding reg) - cr 0 0))) + cr 0 0))) @@ -1012,21 +1024,16 @@ (define-instruction-macro entry-point () nil) -#+nil -(define-bitfield-emitter emit-break-inst 32 - (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0)) - (defun snarf-error-junk (sap offset &optional length-only) - (let* ((length (sb!sys:sap-ref-8 sap offset)) + (let* ((length (sap-ref-8 sap offset)) (vector (make-array length :element-type '(unsigned-byte 8)))) - (declare (type sb!sys:system-area-pointer sap) + (declare (type system-area-pointer sap) (type (unsigned-byte 8) length) (type (simple-array (unsigned-byte 8) (*)) vector)) (cond (length-only (values 0 (1+ length) nil nil)) (t - (sb!kernel:copy-ub8-from-system-area sap (1+ offset) - vector 0 length) + (copy-ub8-from-system-area sap (1+ offset) vector 0 length) (collect ((sc-offsets) (lengths)) (lengths 1) ; the length byte @@ -1055,28 +1062,36 @@ (defun break-control (chunk inst stream dstate) (declare (ignore inst)) (flet ((nt (x) (if stream (sb!disassem:note x dstate)))) - (case (break-code chunk dstate) - (#.error-trap - (nt "Error trap") - (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.cerror-trap - (nt "Cerror trap") - (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.breakpoint-trap - (nt "Breakpoint trap")) - (#.pending-interrupt-trap - (nt "Pending interrupt trap")) - (#.halt-trap - (nt "Halt trap")) - (#.fun-end-breakpoint-trap - (nt "Function end breakpoint trap")) - ))) + (when (= (break-code chunk dstate) 0) + (case (break-subcode chunk dstate) + (#.halt-trap + (nt "Halt trap")) + (#.pending-interrupt-trap + (nt "Pending interrupt trap")) + (#.error-trap + (nt "Error trap") + (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) + (#.cerror-trap + (nt "Cerror trap") + (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) + (#.breakpoint-trap + (nt "Breakpoint trap")) + (#.fun-end-breakpoint-trap + (nt "Function end breakpoint trap")) + (#.after-breakpoint-trap + (nt "After breakpoint trap")) + (#.pseudo-atomic-trap + (nt "Pseudo atomic trap")) + (#.object-not-list-trap + (nt "Object not list trap")) + (#.object-not-instance-trap + (nt "Object not instance trap")))))) (define-instruction break (segment code &optional (subcode 0)) (:declare (type (unsigned-byte 10) code subcode)) (:printer break ((op special-op) (funct #b001101)) - '(:name :tab code (:unless (:constant 0) subcode)) - :control #'break-control ) + '(:name :tab code (:unless (:constant 0) ", " subcode)) + :control #'break-control) :pinned (:cost 0) (:delay 0) @@ -1084,12 +1099,12 @@ (emit-break-inst segment special-op code subcode #b001101))) (define-instruction syscall (segment) - (:printer register ((op special-op) (rd 0) (rt 0) (rs 0) (funct #b001100)) - '(:name)) + (:printer register ((op special-op) (rd 0) (rt 0) (rs 0) (funct #b001110)) + '(:name)) :pinned (:delay 0) (:emitter - (emit-register-inst segment special-op 0 0 0 0 #b001100))) + (emit-register-inst segment special-op 0 0 0 0 #b001110))) (define-instruction nop (segment) (:printer register ((op 0) (rd 0) (rd 0) (rs 0) (funct 0)) '(:name)) @@ -1131,11 +1146,11 @@ segment 4 #'(lambda (segment posn) (emit-word segment - (logior type - (ash (+ posn (component-header-length)) - (- n-widetag-bits word-shift))))))) + (logior type + (ash (+ posn (component-header-length)) + (- n-widetag-bits word-shift))))))) -(define-instruction fun-header-word (segment) +(define-instruction simple-fun-header-word (segment) :pinned (:cost 0) (:delay 0) @@ -1156,22 +1171,22 @@ segment 12 3 #'(lambda (segment posn delta-if-after) (let ((delta (funcall calc label posn delta-if-after))) - (when (<= (- (ash 1 15)) delta (1- (ash 1 15))) - (emit-back-patch segment 4 - #'(lambda (segment posn) - (assemble (segment vop) - (inst addu dst src - (funcall calc label posn 0))))) - t))) + (when (typep delta '(signed-byte 16)) + (emit-back-patch segment 4 + #'(lambda (segment posn) + (assemble (segment vop) + (inst addu dst src + (funcall calc label posn 0))))) + t))) #'(lambda (segment posn) (let ((delta (funcall calc label posn 0))) - (assemble (segment vop) - (inst lui temp (ldb (byte 16 16) delta)) - (inst or temp (ldb (byte 16 0) delta)) - (inst addu dst src temp)))))) + (assemble (segment vop) + (inst lui temp (ldb (byte 16 16) delta)) + (inst or temp (ldb (byte 16 0) delta)) + (inst addu dst src temp)))))) -;; code = fn - header - label-offset + other-pointer-tag -(define-instruction compute-code-from-fn (segment dst src label temp) +;; code = lip - header - label-offset + other-pointer-lowtag +(define-instruction compute-code-from-lip (segment dst src label temp) (:declare (type tn dst src temp) (type label label)) (:attributes variable-length) (:dependencies (reads src) (writes dst) (writes temp)) @@ -1179,10 +1194,10 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (- other-pointer-lowtag - (label-position label posn delta-if-after) - (component-header-length)))))) + #'(lambda (label posn delta-if-after) + (- other-pointer-lowtag + (label-position label posn delta-if-after) + (component-header-length)))))) ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag ;; = lra - (header + label-offset) @@ -1194,11 +1209,12 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (- (+ (label-position label posn delta-if-after) - (component-header-length))))))) + #'(lambda (label posn delta-if-after) + (- (+ (label-position label posn delta-if-after) + (component-header-length))))))) ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag +;; = code + header + label-offset (define-instruction compute-lra-from-code (segment dst src label temp) (:declare (type tn dst src temp) (type label label)) (:attributes variable-length) @@ -1207,9 +1223,9 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (+ (label-position label posn delta-if-after) - (component-header-length)))))) + #'(lambda (label posn delta-if-after) + (+ (label-position label posn delta-if-after) + (component-header-length)))))) ;;;; Loads and Stores @@ -1220,7 +1236,7 @@ (note-fixup segment :addi index) (setf index 0)) (emit-immediate-inst segment opcode (reg-tn-encoding reg) - (+ (reg-tn-encoding base) oddhack) index)) + (+ (reg-tn-encoding base) oddhack) index)) (defconstant-eqx load-store-printer '(:name :tab @@ -1231,7 +1247,7 @@ (define-instruction lb (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100000)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1240,7 +1256,7 @@ (define-instruction lh (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100001)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1249,7 +1265,7 @@ (define-instruction lwl (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100010)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1258,7 +1274,7 @@ (define-instruction lw (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100011)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1268,7 +1284,7 @@ ;; next is just for ease of coding double-in-int c-call convention (define-instruction lw-odd (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) (:emitter @@ -1276,7 +1292,7 @@ (define-instruction lbu (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100100)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1285,7 +1301,7 @@ (define-instruction lhu (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100101)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1294,7 +1310,7 @@ (define-instruction lwr (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b100110)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1303,7 +1319,7 @@ (define-instruction sb (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b101000)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1312,7 +1328,7 @@ (define-instruction sh (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b101001)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1321,7 +1337,7 @@ (define-instruction swl (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b101010)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1330,7 +1346,7 @@ (define-instruction sw (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b101011)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1339,7 +1355,7 @@ (define-instruction swr (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b101110)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1352,11 +1368,11 @@ (note-fixup segment :addi index) (setf index 0)) (emit-immediate-inst segment opcode (reg-tn-encoding base) - (+ (fp-reg-tn-encoding reg) odd) index)) + (+ (fp-reg-tn-encoding reg) odd) index)) (define-instruction lwc1 (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b110001) (rt nil :type 'fp-reg)) load-store-printer) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) @@ -1365,7 +1381,7 @@ (define-instruction lwc1-odd (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:dependencies (reads base) (reads :memory) (writes reg)) (:delay 1) (:emitter @@ -1373,7 +1389,7 @@ (define-instruction swc1 (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:printer immediate ((op #b111001) (rt nil :type 'fp-reg)) load-store-printer) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) @@ -1382,7 +1398,7 @@ (define-instruction swc1-odd (segment reg base &optional (index 0)) (:declare (type tn reg base) - (type (or (signed-byte 16) fixup) index)) + (type (or (signed-byte 16) fixup) index)) (:dependencies (reads base) (reads reg) (writes :memory)) (:delay 0) (:emitter