/[cmucl]/src/compiler/debug-dump.lisp
ViewVC logotype

Diff of /src/compiler/debug-dump.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.46 by gerd, Fri Oct 17 10:06:30 2003 UTC revision 1.47 by rtoy, Tue Apr 6 20:44:01 2004 UTC
# Line 280  Line 280 
280      (values (copy-seq *byte-buffer*) tlf-num)))      (values (copy-seq *byte-buffer*) tlf-num)))
281    
282    
283    (defun namestring-for-debug-source (file-info)
284      "Extract the namestring from FILE-INFO for the DEBUG-SOURCE.
285    Return FILE-INFO's untruename (e.g., target:foo) if it is absolute;
286    otherwise the truename."
287      (let* ((untruename (file-info-untruename file-info))
288             (dir (pathname-directory untruename)))
289        (namestring (if (and dir (eq (first dir) :absolute))
290                        untruename
291                        (file-info-name file-info)))))
292    
293  ;;; DEBUG-SOURCE-FOR-INFO  --  Interface  ;;; DEBUG-SOURCE-FOR-INFO  --  Interface
294  ;;;  ;;;
295  ;;;    Return a list of DEBUG-SOURCE structures containing information derived  ;;;    Return a list of DEBUG-SOURCE structures containing information derived
# Line 308  Line 318 
318                     (setf (debug-source-name res)                     (setf (debug-source-name res)
319                           (coerce (file-info-forms x) 'simple-vector)))                           (coerce (file-info-forms x) 'simple-vector)))
320                    (pathname                    (pathname
321                     (let* ((untruename (file-info-untruename x))                     (setf (debug-source-name res)
322                            (dir (pathname-directory untruename)))                           (namestring-for-debug-source x))))
                      (setf (debug-source-name res)  
                            (namestring  
                             (if (and dir (eq (first dir) :absolute))  
                                 untruename  
                                 name))))))  
323                  res))                  res))
324            (source-info-files info)))            (source-info-files info)))
325    

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47

  ViewVC Help
Powered by ViewVC 1.1.5