Changeset 8882

Mar 24, 2008, 11:12:46 PM (14 years ago)

Fix handling of *record-source-file* and *save-source-locations*.

We now respect *r-s-f* and *s-s-l* so that only the right information
is stored in the fasl and spurious source-notes are no longer created.

4 edited


  • branches/working-0711/ccl/level-0/l0-source-files.lisp

    r8871 r8882  
    2626(defun record-source-file (name definition-type-name)
    27   (push (list definition-type-name name *loading-file-source-file* *loading-toplevel-location*)
     27  (push (list definition-type-name name *loading-toplevel-location*)
    2828        *early-source-files*))
  • branches/working-0711/ccl/level-1/l1-init.lisp

    r8877 r8882  
    255255(defparameter *break-level* 0)
    256256(defparameter *last-break-level* 0)
    257 (defvar *record-source-file* nil)       ; set in l1-utils.
     257(defvar *record-source-file* t)
    258258(defvar *warn-if-redefine* nil)         ; set in l1-utils.
    259259(defparameter *level-1-loaded* nil)     ; set t by l1-boot
    260 (defparameter *save-definitions* t)
    261 (defparameter *save-local-symbols* t)
    262 (defparameter *save-source-locations* nil)
     260(defvar *save-definitions* t)
     261(defvar *save-local-symbols* t)
     262(defvar *save-source-locations* nil
     263  "Controls whether complete source locations is stored.
     265If NIL we don't store any source location (other than the filename if *record-source-file* is non-NIL).
     267If T we store as much source location information as we have available.
     269If :NO-TEXT we don't store the original source code.")
    264271(defvar *modules* nil
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r8868 r8882  
    408408           (*fasl-source-file* filename)
    409409           (*fcomp-toplevel-forms* '())
    410            (*loading-file-source-file* (namestring orig-file)) ; why orig-file???
     410           (*loading-file-source-file* (namestring (or *compile-file-original-truename* orig-file)))
     411           (*fcomp-file-source-note* (%make-source-note :file-name *loading-file-source-file*))
    411412           (*fcomp-source-note-map* (and (or *fasl-save-source-locations* *compile-code-coverage*)
    412413                                         (make-hash-table :test #'eq :shared nil)))
    416417           (read-package nil)
    417418           form)
    418       (declare (special *fasl-eof-forms* *fcomp-toplevel-forms* *fasl-source-file*))
    419       ;;This should really be something like `(set-loading-source
    420       ;;,filename) but then couldn't compile level-1 with this...  ->
    421       ;;In any case, change this to be a fasl opcode, so don't make an
    422       ;;lfun just to do this...  There are other reasons - more
    423       ;;compelling ones than "fear of tiny lfuns" - for making this a
    424       ;;fasl opcode.
     419      (declare (special *fasl-eof-forms* *fcomp-toplevel-forms* *fasl-source-file* *fcomp-file-source-note*))
    425420      (fcomp-output-form $fasl-src env *loading-file-source-file*)
    426421      (let* ((*fcomp-previous-position* nil))
    442437                    (read-recording-source *fcomp-stream*
    443438                                           :eofval eofval
    444                                            :file-name (or *compile-file-original-truename* *loading-file-source-file*)
     439                                           :file-name *loading-file-source-file*
    445440                                           :start-offset (or *compile-file-original-buffer-offset* 0)
    446441                                           :map *fcomp-source-note-map*)))))
    468463(defun fcomp-output-source-being-compiled (env)
    469   (when *fcomp-source-being-compiled*
    470     (fcomp-output-form $fasl-toplevel-location env *fcomp-source-being-compiled*)))
     464  (let ((effective-note (cond
     465                          ((and *record-source-file* *fasl-save-source-locations*)
     466                           (if *fcomp-source-being-compiled*
     467                             (if (eql :no-text *fasl-save-source-locations*)
     468                               (%make-source-note :start-pos (source-note-start-pos *fcomp-source-being-compiled*)
     469                                                  :end-pos (source-note-end-pos *fcomp-source-being-compiled*)
     470                                                  :file-name (source-note-file-name *fcomp-source-being-compiled*))
     471                               *fcomp-source-being-compiled*)
     472                             nil))
     473                          (*record-source-file*
     474                           ;; we don't want the full source note, but we do want the file name
     475                           (locally (declare (special *fcomp-file-source-note*))
     476                             *fcomp-file-source-note*))
     477                          (t
     478                           ;; output this so *loading-toplevel-location* gets reset after each form.
     479                           nil))))
     480    (fcomp-output-form $fasl-toplevel-location env effective-note)
     481    effective-note))
    472483(defun fcomp-form (form env processing-mode
  • branches/working-0711/ccl/lib/source-files.lisp

    r8878 r8882  
    2525(in-package "CCL")
    27  ;; Attempting to record-source while defining the source recording framework is a bad idea. When
    28  ;; we're done loading this file we re-enable source recording.
    29 (setf *record-source-file* nil)
     27(defparameter *old-record-source-file*
     28  (prog1
     29      *record-source-file*
     30    ;; this needs to be in the value of parameter so that it is evaluated before the call to
     31    ;; record-source-file in the execution of the defparameter itself.
     32    (setf *record-source-file* nil))
     33  "While compiling this file we don't want *record-source-file*, this stores the value of
     34  *record-source-file* on entry to this file.")
    3136;;;; * Mapping names of things to the text which defines the thing.
    126131;;;; ** Storing definitions for a name
    128 (defun record-source-file (name definition-type-name
    129                            &key (file-name *loading-file-source-file*)
    130                                 (toplevel-source-note *loading-toplevel-location*))
     133(defun record-source-file (name definition-type-name &optional (toplevel-source-note *loading-toplevel-location*))
    131134  "Records where the thing of type DEFINITION-TYPE-NAME named NAME is stored.
    133136NAME is a definition-name; DEFINITION-TYPE-NAME is a symbol naming a definition-type-name (see
    134 definition-type-instance) or a definition-type object; FILE-NAME is the file where this thing is
    135 stored and TOPLEVEL-SOURCE-NOTE is the source-note. If TOPLEVEL-SOURCE-NOTE is non-NIL we use it and
    136 ignore the FILE-NAME argument."
    137   (when (not *record-source-file*)
    138     (return-from record-source-file nil))
    139   (when (and (null file-name)
    140              (null toplevel-source-note))
    141     ;; no file-name, no toplevel-location, what is it we want to record?
    142     (return-from record-source-file nil))
    143   ;; bootstrapping
    144   (unless (member definition-type-name *definition-types* :key #'definition-type-name)
    145     (warn "No known definition-type named ~S." definition-type-name)
    146     (return-from record-source-file nil))
    147   (let* ((definition-type (definition-type-instance definition-type-name))
    148          (source-note (or toplevel-source-note ;; mb 2007-03-23: do we really want to ignore file-name?
    149                           (%make-source-note :file-name (truename file-name))))
    150          (existing-note (definition-source definition-type name)))
    151     (when (and *warn-if-redefine*
    152                (not (equal (full-pathname (source-note-file-name existing-note))
    153                            (full-pathname (source-note-file-name source-note)))))
    154       ;; have an existing definition in another file. warn.
    155       (warn "The ~S ~S, which was defined in ~S, is being redefined in ~S."
    156             definition-type-name (effective-name definition-type name)
    157             (source-note-file-name existing-note)
    158             (source-note-file-name source-note)))
    159     (setf (definition-source definition-type name) source-note)
    160     (list definition-type-name (effective-name definition-type name) source-note)))
     137definition-type-instance) or a definition-type object; TOPLEVEL-SOURCE-NOTE is the source-note."
     138  (when (and *record-source-file* toplevel-source-note)
     139    (let* ((definition-type (definition-type-instance definition-type-name))
     140           (source-note  toplevel-source-note)
     141           (existing-note (definition-source definition-type name)))
     142      (when (and *warn-if-redefine*
     143                 (not (equal (full-pathname (source-note-file-name existing-note))
     144                             (full-pathname (source-note-file-name source-note)))))
     145        ;; have an existing definition in another file. warn.
     146        (warn "The ~S ~S, which was defined in ~S, is being redefined in ~S."
     147              definition-type-name (effective-name definition-type name)
     148              (source-note-file-name existing-note)
     149              (source-note-file-name source-note)))
     150      (setf (definition-source definition-type name) source-note)
     151      (list definition-type-name (effective-name definition-type name) source-note))))
    162153;;;; * Framework for definig definition-types
    477468;;;; * Done loading the r-s-f stuff. Do some housekeeping.
    479 (setf *record-source-file* t)
     470(setf *record-source-file* *old-record-source-file*)
    481472;; Now that the real r-s-f framework is ready we can go back and fixup the early stuff. This early
    492483  while *early-source-files*
    493   for (type name file-name source-note) = (pop *early-source-files*)
    494   do (record-source-file name type
    495                          :file-name file-name
    496                          :toplevel-source-note source-note))
     484  for (type name source-note) = (pop *early-source-files*)
     485  do (record-source-file name type source-note))
Note: See TracChangeset for help on using the changeset viewer.