/[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.15 by ram, Mon Jul 23 14:12:54 1990 UTC revision 1.16 by ram, Thu Aug 16 16:10:40 1990 UTC
# Line 80  Line 80 
80      (do-live-tns (tn live block)      (do-live-tns (tn live block)
81        (let ((leaf (tn-leaf tn)))        (let ((leaf (tn-leaf tn)))
82          (when (and (lambda-var-p leaf)          (when (and (lambda-var-p leaf)
83                     (or (not (eq (tn-kind tn) :environment))                     (or (not (member (tn-kind tn)
84                                        '(:environment :debug-environment)))
85                         (rassoc leaf (lexenv-variables (node-lexenv node)))))                         (rassoc leaf (lexenv-variables (node-lexenv node)))))
86            (let ((num (gethash leaf var-locs)))            (let ((num (gethash leaf var-locs)))
87              (when num              (when num
# Line 332  Line 333 
333  ;;; makes Var's name unique in the function.  Buffer is the vector we stick the  ;;; makes Var's name unique in the function.  Buffer is the vector we stick the
334  ;;; result in.  ;;; result in.
335  ;;;  ;;;
336    ;;;    The debug-variable is only marked as always-live if the TN is
337    ;;; environment live and is an argument.  If a :debug-environment TN, then we
338    ;;; also exclude set variables, since the variable is not guranteed to be live
339    ;;; everywhere in that case.
340    ;;;
341  (defun dump-1-variable (fun var tn id buffer)  (defun dump-1-variable (fun var tn id buffer)
342    (declare (type lambda-var var) (type tn tn) (type unsigned-byte id)    (declare (type lambda-var var) (type tn tn) (type unsigned-byte id)
343             (type clambda fun))             (type clambda fun))
# Line 339  Line 345 
345           (package (symbol-package name))           (package (symbol-package name))
346           (package-p (and package (not (eq package *package*))))           (package-p (and package (not (eq package *package*))))
347           (save-tn (tn-save-tn tn))           (save-tn (tn-save-tn tn))
348             (kind (tn-kind tn))
349           (flags 0))           (flags 0))
350      (unless package      (unless package
351        (setq flags (logior flags compiled-debug-variable-uninterned)))        (setq flags (logior flags compiled-debug-variable-uninterned)))
352      (when package-p      (when package-p
353        (setq flags (logior flags compiled-debug-variable-packaged)))        (setq flags (logior flags compiled-debug-variable-packaged)))
354      (when (and (eq (tn-kind tn) :environment)      (when (and (or (eq kind :environment)
355                       (and (eq kind :debug-environment)
356                            (null (basic-var-sets var))))
357                 (eq (lambda-var-home var) fun))                 (eq (lambda-var-home var) fun))
358        (setq flags (logior flags compiled-debug-variable-environment-live)))        (setq flags (logior flags compiled-debug-variable-environment-live)))
359      (when save-tn      (when save-tn

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

  ViewVC Help
Powered by ViewVC 1.1.5