X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=878935359971dbfeda1cd6e9885a0ea210c97428;hb=56ce3857f7830670d55d2fe17246353dff2e71f7;hp=c64d63253664d887523a610f550a441929d5fc93;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index c64d632..8789353 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -218,7 +218,7 @@ ;;; ;;; start of instructions ;;; ... -;;; function-headers and lra's buried in here randomly +;;; fun-headers and lra's buried in here randomly ;;; ... ;;; start of trace-table ;;; @@ -252,13 +252,13 @@ (defstruct (offs-hook (:copier nil)) (offset 0 :type offset) - (function (required-argument) :type function) + (function (missing-arg) :type function) (before-address nil :type (member t nil))) (defstruct (segment (:conc-name seg-) (:constructor %make-segment) (:copier nil)) - (sap-maker (required-argument) + (sap-maker (missing-arg) :type (function () sb!sys:system-area-pointer)) (length 0 :type length) (virtual-location 0 :type address) @@ -286,7 +286,7 @@ ;; offset of next position (next-offs 0 :type offset) ;; a sap pointing to our segment - (segment-sap (required-argument) :type sb!sys:system-area-pointer) + (segment-sap (missing-arg) :type sb!sys:system-area-pointer) ;; the current segment (segment nil :type (or null segment)) ;; what to align to in most cases @@ -440,7 +440,7 @@ (incf (dstate-next-offs dstate) lra-size)) nil) -;;; Print the function-header (entry-point) pseudo-instruction at the +;;; Print the fun-header (entry-point) pseudo-instruction at the ;;; current location in DSTATE to STREAM. (defun fun-header-hook (stream dstate) (declare (type (or null stream) stream) @@ -973,13 +973,13 @@ (defstruct (source-form-cache (:conc-name sfcache-) (:copier nil)) (debug-source nil :type (or null sb!di:debug-source)) - (top-level-form-index -1 :type fixnum) - (top-level-form nil :type list) + (toplevel-form-index -1 :type fixnum) + (toplevel-form nil :type list) (form-number-mapping-table nil :type (or null (vector list))) (last-location-retrieved nil :type (or null sb!di:code-location)) (last-form-retrieved -1 :type fixnum)) -(defun get-top-level-form (debug-source tlf-index) +(defun get-toplevel-form (debug-source tlf-index) (let ((name (sb!di:debug-source-name debug-source))) (ecase (sb!di:debug-source-from debug-source) (:file @@ -1005,7 +1005,8 @@ (file-position f char-offset)) (t (warn "Source file ~S has been modified; ~@ - using form offset instead of file index." + using form offset instead of ~ + file index." name) (let ((*read-suppress* t)) (dotimes (i local-tlf-index) (read f))))) @@ -1025,41 +1026,41 @@ (and cache (and (eq (sb!di:code-location-debug-source loc) (sfcache-debug-source cache)) - (eq (sb!di:code-location-top-level-form-offset loc) - (sfcache-top-level-form-index cache))))) + (eq (sb!di:code-location-toplevel-form-offset loc) + (sfcache-toplevel-form-index cache))))) (defun get-source-form (loc context &optional cache) (let* ((cache-valid (cache-valid loc cache)) - (tlf-index (sb!di:code-location-top-level-form-offset loc)) + (tlf-index (sb!di:code-location-toplevel-form-offset loc)) (form-number (sb!di:code-location-form-number loc)) - (top-level-form + (toplevel-form (if cache-valid - (sfcache-top-level-form cache) - (get-top-level-form (sb!di:code-location-debug-source loc) + (sfcache-toplevel-form cache) + (get-toplevel-form (sb!di:code-location-debug-source loc) tlf-index))) (mapping-table (if cache-valid (sfcache-form-number-mapping-table cache) - (sb!di:form-number-translations top-level-form tlf-index)))) + (sb!di:form-number-translations toplevel-form tlf-index)))) (when (and (not cache-valid) cache) (setf (sfcache-debug-source cache) (sb!di:code-location-debug-source loc) - (sfcache-top-level-form-index cache) tlf-index - (sfcache-top-level-form cache) top-level-form + (sfcache-toplevel-form-index cache) tlf-index + (sfcache-toplevel-form cache) toplevel-form (sfcache-form-number-mapping-table cache) mapping-table)) - (cond ((null top-level-form) + (cond ((null toplevel-form) nil) ((> form-number (length mapping-table)) (warn "bogus form-number in form! The source file has probably ~@ been changed too much to cope with.") (when cache ;; Disable future warnings. - (setf (sfcache-top-level-form cache) nil)) + (setf (sfcache-toplevel-form cache) nil)) nil) (t (when cache (setf (sfcache-last-location-retrieved cache) loc) (setf (sfcache-last-form-retrieved cache) form-number)) - (sb!di:source-path-context top-level-form + (sb!di:source-path-context toplevel-form (aref mapping-table form-number) context))))) @@ -1372,7 +1373,8 @@ last-debug-fun)) (if (null segments) (let ((offs (fun-insts-offset function))) - (make-code-segment code offs (- max-offset offs))) + (list + (make-code-segment code offs (- max-offset offs)))) (nreverse segments))))))) ;;; Return a list of the segments of memory containing machine code @@ -1500,7 +1502,7 @@ (dolist (seg segments) (disassemble-segment seg stream dstate))))) -;;;; top-level functions +;;;; top level functions ;;; Disassemble the machine code instructions for FUNCTION. (defun disassemble-function (function &key @@ -1731,7 +1733,7 @@ ;;; routines to find things in the Lisp environment -;;; an alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUNCTION-NAME) for slots +;;; an alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUN-NAME) for slots ;;; in a symbol object that we know about (defparameter *grokked-symbol-slots* (sort `((,sb!vm:symbol-value-slot . symbol-value)