("src/compiler/trace-table") ; needs EMIT-LABEL macro from compiler/assem.lisp
+ ("src/code/debug-info")
;; Compiling this requires fop definitions from code/fop.lisp and
;; trace table definitions from compiler/trace-table.lisp.
("src/compiler/dump")
("src/compiler/tn")
("src/compiler/life")
- ("src/code/debug-info")
-
("src/compiler/debug-dump")
("src/compiler/generic/utils")
("src/compiler/fopcompile")
"HANDLE-CIRCULARITY" "HOST" "IGNORE-IT" "ILL-BIN"
"ILL-BOUT" "ILL-IN" "ILL-OUT" "INDEX-OR-MINUS-1"
"INDEX-TOO-LARGE-ERROR" "*!INITIAL-ASSEMBLER-ROUTINES*"
+ "*!INITIAL-DEBUG-SOURCES*"
"*!INITIAL-FDEFN-OBJECTS*" "*!INITIAL-FOREIGN-SYMBOLS*"
"*!INITIAL-LAYOUTS*" "*!INITIAL-SYMBOLS*"
"INTEGER-DECODE-DOUBLE-FLOAT"
"!EARLY-TYPE-COLD-INIT" "!LATE-TYPE-COLD-INIT"
"!FIXUP-TYPE-COLD-INIT" "!TARGET-TYPE-COLD-INIT"
"!RANDOM-COLD-INIT" "!READER-COLD-INIT"
+ "!PATHNAME-COLD-INIT" "!DEBUG-INFO-COLD-INIT"
"!TYPECHECKFUNS-COLD-INIT" "!LOADER-COLD-INIT"
"!EXHAUST-COLD-INIT" "!PACKAGE-COLD-INIT"
"!POLICY-COLD-INIT-OR-RESANIFY"
(show-and-call !late-proclaim-cold-init)
(show-and-call os-cold-init-or-reinit)
+ (show-and-call !pathname-cold-init)
+ (show-and-call !debug-info-cold-init)
(show-and-call stream-cold-init-or-reset)
(show-and-call !loader-cold-init)
(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))
;; 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)))))
(name (pop-stack)))
(setf (fdefinition name) fn)))
+(define-fop (fop-note-debug-source 174 :pushp nil)
+ (warn "~@<FOP-NOTE-DEBUG-SOURCE seen in ordinary load (not cold load) -- ~
+very strange! If you didn't do something to cause this, please report it as ~
+a bug.~@:>")
+ ;; as with COLD-FSET above, we are going to be lenient with coming
+ ;; across this fop in a warm SBCL.
+ (let ((debug-source (pop-stack)))
+ (setf (sb!c::debug-source-compiled debug-source) (get-universal-time)
+ (sb!c::debug-source-created debug-source)
+ (file-write-date (sb!c::debug-source-namestring debug-source)))))
+
;;; Modify a slot in a CONSTANTS object.
(define-cloned-fops (fop-alter-code 140 :pushp nil) (fop-byte-alter-code 141)
(let ((value (pop-stack))
#+sb-xc-host
(let ((src (position "src" dir :test #'string=
:from-end t)))
- (if src
- (format nil "SYS:~{~:@(~A~);~}~:@(~A~).LISP"
- (subseq dir src) (pathname-name untruename))
- ;; FIXME: just output/stuff-groveled-from-headers.lisp
- (namestring untruename)))
+ (cond
+ (src (format nil "SYS:~{~:@(~A~);~}~:@(~A~).LISP"
+ (subseq dir src) (pathname-name untruename)))
+ (t (aver (string-equal (car (last dir)) "output"))
+ (aver (string-equal (pathname-name untruename) "stuff-groveled-from-headers"))
+ (aver (string-equal (pathname-type untruename) "lisp"))
+ "SYS:OUTPUT;STUFF-GROVELED-FROM-HEADERS.LISP")))
#-sb-xc-host
(if (and dir (eq (first dir) :absolute))
(namestring untruename)
;; might be cute to search in "SYS:TRANSLATIONS;<name>.LISP"
(error "logical host ~S not found" host)))
+(defun !pathname-cold-init ()
+ (let* ((sys *default-pathname-defaults*)
+ (src
+ (merge-pathnames
+ (make-pathname :directory '(:relative "src" :wild-inferiors)
+ :name :wild :type :wild)
+ sys))
+ (contrib
+ (merge-pathnames
+ (make-pathname :directory '(:relative "contrib" :wild-inferiors)
+ :name :wild :type :wild)
+ sys))
+ (output
+ (merge-pathnames
+ (make-pathname :directory '(:relative "output" :wild-inferiors)
+ :name :wild :type :wild)
+ sys)))
+ (setf (logical-pathname-translations "SYS")
+ `(("SYS:SRC;**;*.*.*" ,src)
+ ("SYS:CONTRIB;**;*.*.*" ,contrib)
+ ("SYS:OUTPUT;**;*.*.*" ,output)))))
\f
;;;; compiling and loading more of the system
-(let* ((sys *default-pathname-defaults*)
- (src
- (merge-pathnames
- (make-pathname :directory '(:relative "src" :wild-inferiors)
- :name :wild :type :wild)
- sys))
- (contrib
- (merge-pathnames
- (make-pathname :directory '(:relative "contrib" :wild-inferiors)
- :name :wild :type :wild)
- sys)))
- (setf (logical-pathname-translations "SYS")
- `(("SYS:SRC;**;*.*.*" ,src)
- ("SYS:CONTRIB;**;*.*.*" ,contrib))))
-
;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
;;; COMPILE-PCL, at least some of which we should probably have too:
;;;
on ~A~% ~
using ~A version ~A~%"
where
- (format-universal-time nil (get-universal-time))
- (machine-instance)
+ #+sb-xc-host "cross-compile time"
+ #-sb-xc-host (format-universal-time nil (get-universal-time))
+ #+sb-xc-host "cross-compile host"
+ #-sb-xc-host (machine-instance)
(sb!xc:lisp-implementation-type)
(sb!xc:lisp-implementation-version))))
stream)
(declare (type sb!c::source-info info))
(let ((res (sb!c::debug-source-for-info info))
(*dump-only-valid-structures* nil))
+ #+sb-xc-host (setf (sb!c::debug-source-created res) 0
+ (sb!c::debug-source-compiled res) 0)
(dump-object res fasl-output)
(let ((res-handle (dump-pop fasl-output)))
(dolist (info-handle (fasl-output-debug-info fasl-output))
(dump-push res-handle fasl-output)
(dump-fop 'fop-structset fasl-output)
(dump-word info-handle fasl-output)
- ;; FIXME: what is this bare `2'? --njf, 2004-08-16
- (dump-word 2 fasl-output))))
+ (dump-word sb!c::+debug-info-source-index+ fasl-output))
+ #+sb-xc-host
+ (progn
+ (dump-push res-handle fasl-output)
+ (dump-fop 'fop-note-debug-source fasl-output))))
(setf (fasl-output-debug-info fasl-output) nil)
(values))
\f
(defvar *info-environment*)
(defvar *lexenv*)
(defvar *source-info*)
+(defvar *source-plist*)
(defvar *trace-table*)
(defvar *undefined-warnings*)
(defvar *warnings-p*)
;;; purposes.
(defvar *current-reversed-cold-toplevels*)
+;;; the head of a list of DEBUG-SOURCEs which need to be patched when
+;;; the cold core starts up
+(defvar *current-debug-sources*)
+
;;; the name of the object file currently being cold loaded (as a string, not a
;;; pathname), or NIL if we're not currently cold loading any object file
(defvar *cold-load-filename* nil)
(cold-set '*!initial-fdefn-objects* (list-all-fdefn-objects))
(cold-set '*!reversed-cold-toplevels* *current-reversed-cold-toplevels*)
+ (cold-set '*!initial-debug-sources* *current-debug-sources*)
#!+(or x86 x86-64)
(progn
(setf (gethash warm-name *cold-fset-warm-names*) t))
(static-fset cold-name fn)))
+(define-cold-fop (fop-note-debug-source :pushp nil)
+ (let ((debug-source (pop-stack)))
+ (cold-push debug-source *current-debug-sources*)))
+
(define-cold-fop (fop-fdefinition)
(cold-fdefinition-object (pop-stack)))
#!-gencgc sb!vm:dynamic-0-space-start))
(*nil-descriptor* (make-nil-descriptor))
(*current-reversed-cold-toplevels* *nil-descriptor*)
+ (*current-debug-sources* *nil-descriptor*)
(*unbound-marker* (make-other-immediate-descriptor
0
sb!vm:unbound-marker-widetag))
do (entries `((eql ,n-supplied ,n)
(%funcall ,(force ep) ,@(subseq temps 0 n)))))
`(lambda (,n-supplied ,@temps)
- ;; FIXME: Make sure that INDEX type distinguishes between
- ;; target and host. (Probably just make the SB!XC:DEFTYPE
- ;; different from CL:DEFTYPE.)
(declare (type index ,n-supplied))
(cond
,@(if more (butlast (entries)) (entries))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.30"
+"1.0.27.31"