X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;h=30bfebb0bb6b04bf2454e77de5930034328ddef3;hb=012fbee7176df4472ef4add1a7df558d762bc4f6;hp=1eea0453f89bb9353b9f055ca7b645fa85ade44f;hpb=dec94b039e8ec90baf21463df839a6181de606f6;p=sbcl.git diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 1eea045..30bfebb 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) @@ -1044,10 +1044,10 @@ "-PRINTER")) (make-printer-defun printer-source funstate name))))) -(defun make-printer-defun (source funstate function-name) +(defun make-printer-defun (source funstate fun-name) (let ((printer-form (compile-printer-list source funstate)) (bindings (make-arg-temp-bindings funstate))) - `(defun ,function-name (chunk inst stream dstate) + `(defun ,fun-name (chunk inst stream dstate) (declare (type dchunk chunk) (type instruction inst) (type stream stream) @@ -1167,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))) @@ -1506,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)) @@ -1523,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))) @@ -1553,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))