X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-info.lisp;h=82ebf9d5a563606d17956f817c1d84e9d25847c2;hb=b14a61c6af3e3005c94e633e727177346240066e;hp=5ef9dee22188f098020dee7a7abbd405a4eef350;hpb=abfeff6ea6c7eaa2ab023539e7efbb408d8d42ea;p=sbcl.git diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 5ef9dee..82ebf9d 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -17,13 +17,13 @@ ;;; Compiled debug variables are in a packed binary representation in the ;;; DEBUG-FUN-VARS: ;;; single byte of boolean flags: -;;; uninterned name -;;; packaged name -;;; environment-live -;;; has distinct save location -;;; has ID (name not unique in this fun) -;;; minimal debug-info argument (name generated as ARG-0, ...) -;;; deleted: placeholder for unused minimal argument +;;; uninterned name +;;; packaged name +;;; environment-live +;;; has distinct save location +;;; has ID (name not unique in this fun) +;;; minimal debug-info argument (name generated as ARG-0, ...) +;;; deleted: placeholder for unused minimal argument ;;; [name length in bytes (as var-length integer), if not minimal] ;;; [...name bytes..., if not minimal] ;;; [if packaged, var-length integer that is package name length] @@ -32,21 +32,20 @@ ;;; SC-Offset of primary location (as var-length integer) ;;; [If has save SC, SC-OFFSET of save location (as var-length integer)] -;;; FIXME: The first two are no longer used in SBCL. -;;;(defconstant compiled-debug-var-uninterned #b00000001) -;;;(defconstant compiled-debug-var-packaged #b00000010) -(def!constant compiled-debug-var-environment-live #b00000100) -(def!constant compiled-debug-var-save-loc-p #b00001000) -(def!constant compiled-debug-var-id-p #b00010000) -(def!constant compiled-debug-var-minimal-p #b00100000) -(def!constant compiled-debug-var-deleted-p #b01000000) +(def!constant compiled-debug-var-more-context-p #b00000001) +(def!constant compiled-debug-var-more-count-p #b00000010) +(def!constant compiled-debug-var-environment-live #b00000100) +(def!constant compiled-debug-var-save-loc-p #b00001000) +(def!constant compiled-debug-var-id-p #b00010000) +(def!constant compiled-debug-var-minimal-p #b00100000) +(def!constant compiled-debug-var-deleted-p #b01000000) ;;;; compiled debug blocks ;;;; ;;;; Compiled debug blocks are in a packed binary representation in the ;;;; DEBUG-FUN-BLOCKS: ;;;; number of successors + bit flags (single byte) -;;;; elsewhere-p +;;;; elsewhere-p ;;;; ...ordinal number of each successor in the function's blocks vector... ;;;; number of locations in this block ;;;; kind of first location (single byte) @@ -60,22 +59,23 @@ (defconstant-eqx compiled-debug-block-nsucc-byte (byte 2 0) #'equalp) (def!constant compiled-debug-block-elsewhere-p #b00000100) -(defconstant-eqx compiled-code-location-kind-byte (byte 3 0) #'equalp) +(defconstant-eqx compiled-code-location-kind-byte (byte 4 0) #'equalp) (defparameter *compiled-code-location-kinds* #(:unknown-return :known-return :internal-error :non-local-exit - :block-start :call-site :single-value-return :non-local-entry)) + :block-start :call-site :single-value-return :non-local-entry + :step-before-vop)) ;;;; DEBUG-FUN objects (def!struct (debug-fun (:constructor nil))) (def!struct (compiled-debug-fun (:include debug-fun) - #-sb-xc-host (:pure t)) + #-sb-xc-host (:pure t)) ;; KLUDGE: Courtesy of more than a decade of, ah, organic growth in ;; CMU CL, there are two distinct -- but coupled -- mechanisms to ;; finding the name of a function. The slot here is one mechanism ;; (used in CMU CL to look up names in the debugger, e.g. in - ;; BACKTRACE). The other mechanism is the the NAME slot in function + ;; BACKTRACE). The other mechanism is the NAME slot in function ;; primitive objects (used in CMU CL to look up names elsewhere, ;; e.g. in CL:FUNCTION-LAMBDA-EXPRESSION and in CL:DESCRIBE). ;; @@ -196,33 +196,33 @@ ;;; of records in this format: ;;; name representation + kind + return convention (single byte) ;;; bit flags (single byte) -;;; setf, nfp, variables +;;; setf, nfp, variables ;;; [package name length (as var-length int), if name is packaged] ;;; [...package name bytes, if name is packaged] ;;; [name length (as var-length int), if there is a name] ;;; [...name bytes, if there is a name] ;;; [variables length (as var-length int), if variables flag] ;;; [...bytes holding variable descriptions] -;;; If variables are dumped (level 1), then the variables are all -;;; arguments (in order) with the minimal-arg bit set. +;;; If variables are dumped (level 1), then the variables are all +;;; arguments (in order) with the minimal-arg bit set. ;;; [If returns is specified, then the number of return values] ;;; [...sequence of var-length ints holding sc-offsets of the return -;;; value locations, if fixed return values are specified.] +;;; value locations, if fixed return values are specified.] ;;; return-pc location sc-offset (as var-length int) ;;; old-fp location sc-offset (as var-length int) ;;; [nfp location sc-offset (as var-length int), if nfp flag] ;;; code-start-pc (as a var-length int) -;;; This field implicitly encodes start of this function's code in the -;;; function map, as a delta from the previous function's code start. -;;; If the first function in the component, then this is the delta from -;;; 0 (i.e. the absolute offset.) +;;; This field implicitly encodes start of this function's code in the +;;; function map, as a delta from the previous function's code start. +;;; If the first function in the component, then this is the delta from +;;; 0 (i.e. the absolute offset.) ;;; start-pc (as a var-length int) -;;; This encodes the environment start PC as an offset from the -;;; code-start PC. +;;; This encodes the environment start PC as an offset from the +;;; code-start PC. ;;; elsewhere-pc -;;; This encodes the elsewhere code start for this function, as a delta -;;; from the previous function's elsewhere code start. (i.e. the -;;; encoding is the same as for code-start-pc.) +;;; This encodes the elsewhere code start for this function, as a delta +;;; from the previous function's elsewhere code start. (i.e. the +;;; encoding is the same as for code-start-pc.) ;;; ### For functions with XEPs, name could be represented more simply ;;; and compactly as some sort of info about with how to find the @@ -232,50 +232,63 @@ ;;; to at least know which function is an XEP for the real function ;;; (which would be useful info anyway). -;;;; debug source +;;;; DEBUG SOURCE +;;; There is one per compiled file and one per function compiled at +;;; toplevel or loaded from source. (def!struct (debug-source #-sb-xc-host (:pure t)) - ;; This slot indicates where the definition came from: - ;; :FILE - from a file (i.e. COMPILE-FILE) - ;; :LISP - from Lisp (i.e. COMPILE) - (from (missing-arg) :type (member :file :lisp)) - ;; If :FILE, the file name, if :LISP or :STREAM, then a vector of - ;; the top level forms. When from COMPILE, form 0 is #'(LAMBDA ...). - (name nil) + ;; (This is one of those structures where IWBNI we had multiple + ;; inheritance. The first four slots describe compilation of a + ;; file, the fifth and sixth compilation of a form processed by + ;; EVAL, and the seventh and eigth all compilation units; and these + ;; are orthogonal concerns that can combine independently.) + + ;; When the DEBUG-SOURCE describes a file, the file's namestring. + ;; Otherwise, NIL. + (namestring nil :type (or null string)) ;; the universal time that the source was written, or NIL if ;; unavailable (created nil :type (or unsigned-byte null)) - ;; the universal time that the source was compiled - (compiled (missing-arg) :type unsigned-byte) ;; the source path root number of the first form read from this ;; source (i.e. the total number of forms converted previously in - ;; this compilation) + ;; this compilation). (Note: this will always be 0 so long as the + ;; SOURCE-INFO structure has exactly one FILE-INFO.) (source-root 0 :type index) ;; The FILE-POSITIONs of the truly top level forms read from this ;; file (if applicable). The vector element type will be chosen to - ;; hold the largest element. May be null to save space, or if - ;; :DEBUG-SOURCE-FORM is :LISP. + ;; hold the largest element. (start-positions nil :type (or (simple-array * (*)) null)) - ;; If from :LISP, this is the function whose source is form 0. - (info nil)) + + ;; For functions processed by EVAL (including EVAL-WHEN and LOAD on + ;; a source file), the source form. + (form nil :type list) + ;; This is the function whose source is the form. + (function nil) + + ;; the universal time that the source was compiled + (compiled (missing-arg) :type unsigned-byte) + ;; Additional information from (WITH-COMPILATION-UNIT (:SOURCE-PLIST ...)) + (plist *source-plist*)) ;;;; DEBUG-INFO structures (def!struct debug-info ;; Some string describing something about the code in this component. - (name (missing-arg) :type simple-string) + (name (missing-arg) :type t) ;; A list of DEBUG-SOURCE structures describing where the code for this ;; component came from, in the order that they were read. - ;; - ;; KLUDGE: comment from CMU CL: - ;; *** NOTE: the offset of this slot is wired into the fasl dumper - ;; *** so that it can backpatch the source info when compilation - ;; *** is complete. - (source nil :type list)) + (source nil)) + +(defconstant +debug-info-source-index+ + (let* ((dd (find-defstruct-description 'debug-info)) + (slots (dd-slots dd)) + (source (locally (declare (notinline find)) ; bug 117 bogowarning + (find 'source slots :key #'dsd-name)))) + (dsd-index source))) (def!struct (compiled-debug-info - (:include debug-info) - #-sb-xc-host (:pure t)) + (:include debug-info) + #-sb-xc-host (:pure t)) ;; a SIMPLE-VECTOR of alternating DEBUG-FUN objects and fixnum ;; PCs, used to map PCs to functions, so that we can figure out what ;; function we were running in. Each function is valid between the @@ -289,3 +302,13 @@ ;; works? Would this break if we used a more general memory map? -- ;; WHN 20000120 (fun-map (missing-arg) :type simple-vector :read-only t)) + +(defvar *!initial-debug-sources*) + +(defun !debug-info-cold-init () + (let ((now (get-universal-time))) + (dolist (debug-source *!initial-debug-sources*) + (let* ((namestring (debug-source-namestring debug-source)) + (timestamp (file-write-date namestring))) + (setf (debug-source-created debug-source) timestamp + (debug-source-compiled debug-source) now)))))