(declaim (type (or null inst-space) *disassem-inst-space*))
;;; minimum alignment of instructions, in bytes
-(defvar *disassem-inst-alignment-bytes* sb!vm:word-bytes)
+(defvar *disassem-inst-alignment-bytes* sb!vm:n-word-bytes)
(declaim (type alignment *disassem-inst-alignment-bytes*))
(defvar *disassem-location-column-width* 8)
(,format-var (format-or-lose ',format-name))
(args ,(gen-args-def-form field-defs format-var evalp))
(funcache *disassem-function-cache*))
- ;; FIXME: This should be SPEED 0 but can't be until we support
- ;; byte compilation of components of the SBCL system.
- ;;(declare (optimize (speed 0) (safety 0) (debug 0)))
(multiple-value-bind (printer-fun printer-defun)
(find-printer-fun ',uniquified-name
',format-name
"-PRINTER"))
(make-printer-defun printer-source funstate name)))))
\f
-;;;; Note that these things are compiled byte compiled to save space.
-
(defun make-printer-defun (source funstate function-name)
(let ((printer-form (compile-printer-list source funstate))
(bindings (make-arg-temp-bindings funstate)))
(declare (type dchunk chunk)
(type instruction inst)
(type stream stream)
- (type disassem-state dstate)
- ;; FIXME: This should be SPEED 0 but can't be until we support
- ;; byte compilation of components of the SBCL system.
- #+nil (optimize (speed 0) (safety 0) (debug 0)))
+ (type disassem-state dstate))
(macrolet ((local-format-arg (arg fmt)
`(funcall (formatter ,fmt) stream ,arg)))
(flet ((local-tab-to-arg-column ()
(preprocess-conditionals sub-printer args))
printer)))))
+;;; Return a version of the disassembly-template PRINTER with
+;;; compile-time tests (e.g. :constant without a value), and any
+;;; :CHOOSE operators resolved properly for the args ARGS.
+;;;
+;;; (:CHOOSE Sub*) simply returns the first Sub in which every field
+;;; reference refers to a valid arg.
(defun preprocess-printer (printer args)
- #!+sb-doc
- "Returns a version of the disassembly-template PRINTER with compile-time
- tests (e.g. :constant without a value), and any :CHOOSE operators resolved
- properly for the args ARGS. (:CHOOSE Sub*) simply returns the first Sub in
- which every field reference refers to a valid arg."
(preprocess-conditionals (preprocess-chooses printer args) args))
\f
+;;; Return the first non-keyword symbol in a depth-first search of TREE.
(defun find-first-field-name (tree)
- #!+sb-doc
- "Returns the first non-keyword symbol in a depth-first search of TREE."
(cond ((null tree)
nil)
((and (symbolp tree) (not (keywordp tree)))
`(defun ,name (chunk labels dstate)
(declare (type list labels)
(type dchunk chunk)
- (type disassem-state dstate)
- ;; FIXME: This should be SPEED 0 but can't be
- ;; until we support byte compilation of
- ;; components of the SBCL system.
- #+nil (optimize (speed 0) (safety 0) (debug 0)))
+ (type disassem-state dstate))
(flet ((local-filtered-value (offset)
(declare (type filtered-value-index offset))
(aref (dstate-filtered-values dstate) offset))
))
`(defun ,name (chunk dstate)
(declare (type dchunk chunk)
- (type disassem-state dstate)
- ;; FIXME: This should be SPEED 0 but can't be
- ;; until we support byte compilation of
- ;; components of the SBCL system.
- #+nil (optimize (speed 0) (safety 0) (debug 0)))
+ (type disassem-state dstate))
(flet (((setf local-filtered-value) (value offset)
(declare (type filtered-value-index offset))
(setf (aref (dstate-filtered-values dstate) offset)
(defun bytes-to-bits (bytes)
(declare (type length bytes))
- (* bytes sb!vm:byte-bits))
+ (* bytes sb!vm:n-byte-bits))
(defun bits-to-bytes (bits)
(declare (type length bits))
(multiple-value-bind (bytes rbits)
- (truncate bits sb!vm:byte-bits)
+ (truncate bits sb!vm:n-byte-bits)
(when (not (zerop rbits))
(error "~D bits is not a byte-multiple." bits))
bytes))
(dpb int (byte size 0) -1)
int))
+;;; Is ADDRESS aligned on a SIZE byte boundary?
(defun aligned-p (address size)
- #!+sb-doc
- "Returns non-NIL if ADDRESS is aligned on a SIZE byte boundary."
(declare (type address address)
(type alignment size))
(zerop (logand (1- size) address)))
+;;; Return ADDRESS aligned *upward* to a SIZE byte boundary.
(defun align (address size)
- #!+sb-doc
- "Return ADDRESS aligned *upward* to a SIZE byte boundary."
(declare (type address address)
(type alignment size))
(logandc1 (1- size) (+ (1- size) address)))
(optimize (speed 3) (safety 0)))
(sign-extend (read-suffix length dstate) length))
+;;; Get the value of the property called NAME in DSTATE. Also SETF'able.
+;;;
;;; KLUDGE: The associated run-time machinery for this is in
;;; target-disassem.lisp (much later). This is here just to make sure
;;; it's defined before it's used. -- WHN ca. 19990701
(defmacro dstate-get-prop (dstate name)
- #!+sb-doc
- "Get the value of the property called NAME in DSTATE. Also setf'able."
`(getf (dstate-properties ,dstate) ,name))
projects / sbcl.git / blobdiff