Handle run-program with :directory nil.

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

diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp
index 2e02456..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)
@@ -278,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))
@@ -301,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)))))