(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))
(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)")
(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))
(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)
(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)
(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)
(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))
(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
(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
(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))
;;;; 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))
(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))
(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
(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))
(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))
(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))
(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))
(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))
(: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))
(: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))
(: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
(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
(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)
(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)
(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)
(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))
(: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))
(: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)))))
\f
;;;; Branch/Jump instructions.
(defun emit-relative-branch (segment opcode r1 r2 target)
- (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)))))
+ (emit-chooser
+ segment 20 2
+ #'(lambda (segment posn 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)))
+ #'(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))))))
(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
(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 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) (reads r2-or-target))
+ (:dependencies (reads r1) (if target (reads r2-or-target)))
(:delay 1)
(:emitter
(unless target
(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) (reads r2-or-target))
+ (:dependencies (reads r1) (if target (reads r2-or-target)))
(:delay 1)
(:emitter
(unless target
(: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)
(: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)
(: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)
(: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)
(: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)))
(: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)))
(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))
(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)
(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)
(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
(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))
(: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
(fixup
(inst lui reg value)
(inst addu reg value))))
-
+
(define-instruction-macro li (reg value)
`(%li ,reg ,value))
(: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))
(: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))
(: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))
(: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))
(: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)))
\f
(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-from-system-area sap (* n-byte-bits (1+ offset))
- vector (* n-word-bits
- vector-data-offset)
- (* length n-byte-bits))
+ (copy-ub8-from-system-area sap (1+ offset) vector 0 length)
(collect ((sc-offsets)
(lengths))
(lengths 1) ; the length byte
(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)
(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))
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)
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))
(: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)
(: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)
(: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))))))
\f
;;;; Loads and Stores
(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
(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)
(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)
(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)
(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)
;; 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
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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
(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)
(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
projects / sbcl.git / blobdiff