;;; I wonder whether the separation of the disassembler from the
;;; virtual machine is valid or adds value.
-;;; FIXME: In CMU CL, the code in this file seems to be fully
-;;; compiled, not byte compiled. I'm not sure that's reasonable:
-;;; there's a lot of code in this file, and considering the overall
-;;; speed of the compiler, having some byte-interpretation overhead
-;;; for every few bytes emitted doesn't seem likely to be noticeable.
-;;; I'd like to see what happens if I come back and byte-compile this
-;;; file.
-
;;; Note: In CMU CL, this used to be a call to SET-DISASSEM-PARAMS.
(setf sb!disassem:*disassem-inst-alignment-bytes* 1)
(sb!disassem:define-argument-type displacement
:sign-extend t
- :use-label #'offset-next)
+ :use-label #'offset-next
+ :printer #'(lambda (value stream dstate)
+ (sb!disassem:maybe-note-assembler-routine value nil dstate)
+ (print-label value stream dstate)))
(sb!disassem:define-argument-type accum
:printer #'(lambda (value stream dstate)
(let ((offset (fixup-offset fixup)))
(if (label-p offset)
(emit-back-patch segment
- 4 ; FIXME: sb!vm:word-bytes
+ 4 ; FIXME: sb!vm:n-word-bytes
#'(lambda (segment posn)
(declare (ignore posn))
(emit-dword segment
(- (+ (component-header-length)
(or (label-position offset)
0))
- other-pointer-type))))
+ other-pointer-lowtag))))
(emit-dword segment (or offset 0)))))
(defun emit-relative-fixup (segment fixup)
(t
(format stream "~A PTR [" (symbol-name (ea-size ea)))
(when (ea-base ea)
- (write-string (x86-location-print-name (ea-base ea)) stream)
+ (write-string (sb!c::location-print-name (ea-base ea)) stream)
(when (ea-index ea)
(write-string "+" stream)))
(when (ea-index ea)
- (write-string (x86-location-print-name (ea-index ea)) stream))
+ (write-string (sb!c::location-print-name (ea-index ea)) stream))
(unless (= (ea-scale ea) 1)
(format stream "*~A" (ea-scale ea)))
(typecase (ea-disp ea)
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off of EBP.
- (let ((disp (- (* (1+ (tn-offset thing)) word-bytes))))
+ (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
(cond ((< -128 disp 127)
(emit-mod-reg-r/m-byte segment #b01 reg #b101)
(emit-byte segment disp))
(emit-absolute-fixup segment
(make-fixup nil
:code-object
- (- (* (tn-offset thing) word-bytes)
- other-pointer-type))))))
+ (- (* (tn-offset thing) n-word-bytes)
+ other-pointer-lowtag))))))
(ea
(let* ((base (ea-base thing))
(index (ea-index thing))
(cond (length-only
(values 0 (1+ length) nil nil))
(t
- (sb!kernel:copy-from-system-area sap (* byte-bits (1+ offset))
- vector (* word-bits
+ (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
+ vector (* n-word-bits
vector-data-offset)
- (* length byte-bits))
+ (* length n-byte-bits))
(collect ((sc-offsets)
(lengths))
(lengths 1) ; the length byte
;; from first principles whether it's defined in some way that genesis
;; can't grok.
(case (byte-imm-code chunk dstate)
- (#.sb!vm:error-trap
+ (#.error-trap
(nt "error trap")
(sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
- (#.sb!vm:cerror-trap
+ (#.cerror-trap
(nt "cerror trap")
(sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
- (#.sb!vm:breakpoint-trap
+ (#.breakpoint-trap
(nt "breakpoint trap"))
- (#.sb!vm:pending-interrupt-trap
+ (#.pending-interrupt-trap
(nt "pending interrupt trap"))
- (#.sb!vm:halt-trap
+ (#.halt-trap
(nt "halt trap"))
- (#.sb!vm:function-end-breakpoint-trap
+ (#.fun-end-breakpoint-trap
(nt "function end breakpoint trap")))))
(define-instruction break (segment code)
(logior type
(ash (+ posn
(component-header-length))
- (- type-bits
+ (- n-widetag-bits
word-shift)))))))
-(define-instruction function-header-word (segment)
+(define-instruction simple-fun-header-word (segment)
(:emitter
- (emit-header-data segment function-header-type)))
+ (emit-header-data segment simple-fun-header-widetag)))
(define-instruction lra-header-word (segment)
(:emitter
- (emit-header-data segment return-pc-header-type)))
+ (emit-header-data segment return-pc-header-widetag)))
\f
;;;; fp instructions
;;;;