- (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))))
(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)
(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))))
- (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))))
(defun compare-kind (kind)
(or (position kind compare-kinds)
(error "Unknown floating point compare kind: ~S~%Must be one of: ~S"
(defun compare-kind (kind)
(or (position kind compare-kinds)
(error "Unknown floating point compare kind: ~S~%Must be one of: ~S"
(defun float-operation (op)
(or (position op float-operations)
(error "Unknown floating point operation: ~S~%Must be one of: ~S"
(defun float-operation (op)
(or (position op float-operations)
(error "Unknown floating point operation: ~S~%Must be one of: ~S"
-(defconstant special-op #b000000)
-(defconstant bcond-op #b000001)
-(defconstant cop0-op #b010000)
-(defconstant cop1-op #b010001)
-(defconstant cop2-op #b010010)
-(defconstant cop3-op #b010011)
+(def!constant special-op #b000000)
+(def!constant bcond-op #b000001)
+(def!constant cop0-op #b010000)
+(def!constant cop1-op #b010001)
+(def!constant cop2-op #b010010)
+(def!constant cop3-op #b010011)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter jump-printer
#'(lambda (value stream dstate)
(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)))))
(funct :field (byte 2 0) :type 'float-operation)
(funct-filler :field (byte 4 2) :value 0)
(ft :value nil :type 'fp-reg))
(funct :field (byte 2 0) :type 'float-operation)
(funct-filler :field (byte 4 2) :value 0)
(ft :value nil :type 'fp-reg))
(fixup
(unless allow-fixups
(error "Fixups aren't allowed."))
(note-fixup segment :addi src2)
(emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
(fixup
(unless allow-fixups
(error "Fixups aren't allowed."))
(note-fixup segment :addi src2)
(emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
(:printer register ((op special-op) (funct #b100000)))
(:printer immediate ((op #b001000)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100000)))
(:printer immediate ((op #b001000)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100001)))
(:printer immediate ((op #b001001)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100001)))
(:printer immediate ((op #b001001)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(: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))
(: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))
(:printer register ((op special-op) (funct #b100101)))
(:printer immediate ((op #b001101)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100101)))
(:printer immediate ((op #b001101)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100110)))
(:printer immediate ((op #b001110)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b100110)))
(:printer immediate ((op #b001110)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b101010)))
(:printer immediate ((op #b001010)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b101010)))
(:printer immediate ((op #b001010)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b101011)))
(:printer immediate ((op #b001011)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(:printer register ((op special-op) (funct #b101011)))
(:printer immediate ((op #b001011)))
(:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
(define-instruction divu (segment src1 src2)
(:declare (type tn src1 src2))
(:printer register ((op special-op) (rd 0) (funct #b011011))
(define-instruction divu (segment src1 src2)
(:declare (type tn src1 src2))
(:printer register ((op special-op) (rd 0) (funct #b011011))
(defconstant-eqx float-unop-printer
`(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs))
(defconstant-eqx float-unop-printer
`(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs))
(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))
(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))
- (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)))))
- (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)))
- (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)
(define-instruction b (segment target)
(:declare (type label target))
(:printer immediate ((op #b000100) (rs 0) (rt 0)
(define-instruction bal (segment target)
(:declare (type label target))
(:printer immediate ((op bcond-op) (rs 0) (rt #b01001)
(define-instruction bal (segment target)
(:declare (type label target))
(:printer immediate ((op bcond-op) (rs 0) (rt #b01001)
(define-instruction j (segment target)
(:declare (type (or tn fixup) target))
(:printer register ((op special-op) (rt 0) (rd 0) (funct #b001000))
(define-instruction j (segment target)
(:declare (type (or tn fixup) target))
(:printer register ((op special-op) (rt 0) (rd 0) (funct #b001000))
- (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)))))
- (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)
(define-instruction bc1f (segment target)
(:declare (type label target))
(:printer coproc-branch ((op cop1-op) (funct #x100)
(define-instruction bc1t (segment target)
(:declare (type label target))
(:printer coproc-branch ((op cop1-op) (funct #x101)
(define-instruction bc1t (segment target)
(:declare (type label target))
(:printer coproc-branch ((op cop1-op) (funct #x101)
(define-instruction move (segment dst src)
(:declare (type tn dst src))
(:printer register ((op special-op) (rt 0) (funct #b100001))
(define-instruction move (segment dst src)
(:declare (type tn dst src))
(:printer register ((op special-op) (rt 0) (funct #b100001))
(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))
(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))
(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)
(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)
(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)
(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)
(type (unsigned-byte 8) length)
(type (simple-array (unsigned-byte 8) (*)) vector))
(cond (length-only
(values 0 (1+ length) nil nil))
(t
(type (unsigned-byte 8) length)
(type (simple-array (unsigned-byte 8) (*)) vector))
(cond (length-only
(values 0 (1+ length) nil nil))
(t
- (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"))
+ (#.single-step-around-trap
+ (nt "Single step around trap"))
+ (#.single-step-before-trap
+ (nt "Single step before trap"))))))
(define-instruction break (segment code &optional (subcode 0))
(:declare (type (unsigned-byte 10) code subcode))
(:printer break ((op special-op) (funct #b001101))
(define-instruction break (segment code &optional (subcode 0))
(:declare (type (unsigned-byte 10) code subcode))
(:printer break ((op special-op) (funct #b001101))
- (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)))
- (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))))))
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(:dependencies (reads src) (writes dst) (writes temp))
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(:dependencies (reads src) (writes dst) (writes 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))))))
- #'(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)))))))
(define-instruction compute-lra-from-code (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(define-instruction compute-lra-from-code (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
- #'(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))))))
;; 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)
;; 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)