remove misplaced AVER
[sbcl.git] / src / code / debug-info.lisp
index acb051c..82ebf9d 100644 (file)
 ;;;    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]
 ;;;    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)
 \f
 ;;;; 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)
 (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))
 \f
 ;;;; 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
 ;;; 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
 ;;; to at least know which function is an XEP for the real function
 ;;; (which would be useful info anyway).
 \f
-;;;; 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*))
 \f
 ;;;; 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
   ;; 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)))))