/[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.27 by wlott, Sat Dec 14 18:16:16 1991 UTC revision 1.28 by wlott, Thu May 21 22:48:47 1992 UTC
# Line 26  Line 26 
26    
27  (deftype location-kind ()  (deftype location-kind ()
28    '(member :unknown-return :known-return :internal-error :non-local-exit    '(member :unknown-return :known-return :internal-error :non-local-exit
29             :block-start :call-site :single-value-return))             :block-start :call-site :single-value-return :non-local-entry))
30    
31    
32  ;;; The Location-Info structure holds the information what we need about  ;;; The Location-Info structure holds the information what we need about
# Line 39  Line 39 
39    (kind nil :type location-kind)    (kind nil :type location-kind)
40    ;;    ;;
41    ;; The label pointing to the interesting code location.    ;; The label pointing to the interesting code location.
42    (label nil :type label)    (label nil :type (or label index))
43    ;;    ;;
44    ;; The VOP that emitted this location (for node, save-set, ir2-block, etc.)    ;; The VOP that emitted this location (for node, save-set, ir2-block, etc.)
45    (vop nil :type vop))    (vop nil :type vop))
# Line 52  Line 52 
52  ;;; thus want debug info.  ;;; thus want debug info.
53  ;;;  ;;;
54  (defun note-debug-location (vop label kind)  (defun note-debug-location (vop label kind)
55    (declare (type vop vop) (type label label) (type location-kind kind))    (declare (type vop vop) (type (or label index) label)
56               (type location-kind kind))
57    (setf (ir2-block-locations (vop-block vop))    (setf (ir2-block-locations (vop-block vop))
58          (nconc (ir2-block-locations (vop-block vop))          (nconc (ir2-block-locations (vop-block vop))
59                 (list (make-location-info kind label vop))))                 (list (make-location-info kind label vop))))
# Line 193  Line 194 
194  ;;;  ;;;
195  (defun dump-block-locations (block locations tlf-num var-locs)  (defun dump-block-locations (block locations tlf-num var-locs)
196    (declare (type cblock block) (list locations))    (declare (type cblock block) (list locations))
197    (write-var-integer (1+ (length locations)) *byte-buffer*)    (if (and locations
198    (let ((2block (block-info block)))             (eq (location-kind (first locations))
199      (dump-1-location (continuation-next (block-start block))                 :non-local-entry))
200                       2block :block-start tlf-num        (write-var-integer (length locations) *byte-buffer*)
201                       (ir2-block-%label 2block)        (let ((2block (block-info block)))
202                       (ir2-block-live-out 2block)          (write-var-integer (+ (length locations) 1) *byte-buffer*)
203                       var-locs          (dump-1-location (continuation-next (block-start block))
204                       nil))                           2block :block-start tlf-num
205                             (ir2-block-%label 2block)
206                             (ir2-block-live-out 2block)
207                             var-locs
208                             nil)))
209    (dolist (loc locations)    (dolist (loc locations)
210      (dump-location-from-info loc tlf-num var-locs))      (dump-location-from-info loc tlf-num var-locs))
211    (undefined-value))    (undefined-value))

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

  ViewVC Help
Powered by ViewVC 1.1.5