Changeset 12079


Ignore:
Timestamp:
May 18, 2009, 6:50:37 PM (10 years ago)
Author:
gz
Message:

fix for level-0 source info

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-reader.lisp

    r11279 r12079  
    30013001  ;; Code coverage state.  This MUST be the first slot - see nx2-code-coverage.
    30023002  code-coverage
    3003   ;; The actual form - useful for debugging, otherwise unused.
    3004   #+debug-code-notes form
    30053003  ;; For the outermost source form, a string (the text of the form).
    30063004  ;; For an inner source form, the source-note of the outer source form.
     
    30153013  ;; The note that was being compiled when this note was emitted.  Could
    30163014  ;; be a list in case of a source form that is used multiple times.
    3017   parent-note)
     3015  parent-note
     3016  ;; The actual form - useful for debugging, otherwise unused.
     3017  #+debug-code-notes form)
    30183018
    30193019(defstruct (source-note (:include code-note)
  • branches/working-0711/ccl/lib/source-files.lisp

    r11763 r12079  
    703703(progn
    704704
    705 (defun record-source-file (name def-type &optional (toplevel-source-note *loading-toplevel-location*))
    706   "Records where the thing of type DEFINITION-TYPE-NAME named NAME is stored.
    707 
    708 NAME is a definition-name; DEF-TYPE is a symbol naming a definition-type-name (see
    709 definition-type-instance) or a definition-type object; TOPLEVEL-SOURCE-NOTE is the
    710 source-note."
    711   (when *record-source-file*
     705(defun record-source-file (name def-type &optional (source *loading-toplevel-location*))
     706  (when (and source *record-source-file*)
    712707    (with-lock-grabbed (*source-files-lock*)
     708      (let ((file-name (if (source-note-p source) (source-note-file-name source) source)))
     709        (when file-name
     710          (unless (equalp file-name (car *last-back-translated-name*))
     711            #-BOOTSTRAPPED (unless *last-back-translated-name* (setq *last-back-translated-name* (cons nil nil)))
     712            (setf (car *last-back-translated-name*) file-name)
     713            (setf (cdr *last-back-translated-name*)
     714                  (if (physical-pathname-p file-name)
     715                    (namestring (back-translate-pathname file-name))
     716                    file-name)))
     717          (setq file-name (cdr *last-back-translated-name*))
     718          (if (source-note-p source)
     719            (setf (source-note-file-name source) file-name)
     720            (setq source file-name))))
    713721      (when (eq def-type 't) (report-bad-arg def-type '(not (eql t))))
    714722      (record-definition-source (definition-type-instance def-type
    715723                                    :if-does-not-exist :create)
    716724                                name
    717                                 toplevel-source-note))))
     725                                source))))
    718726
    719727;; Collect level-0 source file info
    720 (let ((path-notes nil))
    721   (flet ((find-source-note (path)
    722            (dolist (note path-notes
    723                     (LET* ((NEW (%MAKE-SOURCE-NOTE :FILE-NAME PATH)))
    724                       (push new path-notes)
    725                       new))
    726              (when (eq (source-note-file-name note) path)
    727                (return note)))))
    728     (do-all-symbols (s)
    729       (let ((f (get s 'bootstrapping-source-files)))
    730         (when f
    731           (setf (gethash s %source-files%) (find-source-note f))
    732           (remprop s 'bootstrapping-source-files))))))
     728(do-all-symbols (s)
     729  (let ((f (get s 'bootstrapping-source-files)))
     730    (when f
     731      (if (consp f)
     732        (destructuring-bind ((type . source)) f
     733          (when source (record-source-file s type source)))
     734        (record-source-file s 'function f))
     735      (remprop s 'bootstrapping-source-files))))
    733736
    734737;; Collect level-1 source file info
Note: See TracChangeset for help on using the changeset viewer.