X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;h=d8afb76751df7c2b03311b334f5cb4fb19e162a7;hb=50305b602c3953440af716137a56f50cd204375d;hp=d821b6b0eaf59ceaa8c992f9934b286c6ff9be3d;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index d821b6b..d8afb76 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -38,7 +38,7 @@ (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) @@ -480,9 +480,6 @@ (,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 @@ -1047,8 +1044,6 @@ "-PRINTER")) (make-printer-defun printer-source funstate name))))) -;;;; 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))) @@ -1056,10 +1051,7 @@ (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 () @@ -1175,17 +1167,17 @@ (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)) +;;; 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))) @@ -1432,11 +1424,7 @@ `(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)) @@ -1476,11 +1464,7 @@ )) `(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) @@ -1522,12 +1506,12 @@ (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)) @@ -1539,16 +1523,14 @@ (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))) @@ -1569,10 +1551,10 @@ (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))