1.1.13: will be tagged as "sbcl-1.1.13"

[sbcl.git] / src / code / debug-info.lisp

diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp
index 991d158..82ebf9d 100644 (file)
--- a/src/code/debug-info.lisp
+++ b/src/code/debug-info.lisp
@@ -32,9 +32,8 @@
 ;;;    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-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)
@@ -60,10 +59,11 @@
 (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
 
@@ -237,29 +237,36 @@
 ;;; 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.
+
+  ;; 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
@@ -270,13 +277,15 @@
   (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))
 
+(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))
@@ -293,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)))))