X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=a286675cb8328ff7beef7b5805a54f3437cdf4b0;hb=447477e72bd4fe54e678a28bdcc4a2802797d6ed;hp=82c128c1c9fff959283a9dc75f02bc435c01f005;hpb=31f072311935e32751508ecf824905c6b58a1d95;p=sbcl.git diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 82c128c..a286675 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -20,7 +20,8 @@ (deftype location-kind () '(member :unknown-return :known-return :internal-error :non-local-exit - :block-start :call-site :single-value-return :non-local-entry)) + :block-start :call-site :single-value-return :non-local-entry + :step-before-vop)) ;;; The LOCATION-INFO structure holds the information what we need ;;; about locations which code generation decided were "interesting". @@ -89,7 +90,7 @@ ;;; are spilled. (defun dump-1-location (node block kind tlf-num label live var-locs vop) (declare (type node node) (type ir2-block block) - (type local-tn-bit-vector live) + (type (or null local-tn-bit-vector) live) (type (or label index) label) (type location-kind kind) (type (or index null) tlf-num) (type hash-table var-locs) (type (or vop null) vop)) @@ -109,9 +110,19 @@ (write-var-integer (source-path-tlf-number path) *byte-buffer*)) (write-var-integer (source-path-form-number path) *byte-buffer*)) - (write-packed-bit-vector (compute-live-vars live node block var-locs vop) - *byte-buffer*) - + (if live + (write-packed-bit-vector (compute-live-vars live node block var-locs vop) + *byte-buffer*) + (write-packed-bit-vector + (make-array (logandc2 (+ (hash-table-count var-locs) 7) 7) + :initial-element 0 + :element-type 'bit) + *byte-buffer*)) + + (write-var-string (or (and (typep node 'combination) + (combination-step-info node)) + "") + *byte-buffer*) (values)) ;;; Extract context info from a Location-Info structure and use it to @@ -331,7 +342,7 @@ (declare (type index flags)) (when minimal (setq flags (logior flags compiled-debug-var-minimal-p)) - (unless tn + (unless (and tn (tn-offset tn)) (setq flags (logior flags compiled-debug-var-deleted-p)))) (when (and (or (eq kind :environment) (and (eq kind :debug-environment) @@ -349,7 +360,7 @@ (vector-push-extend name buffer) (unless (zerop id) (vector-push-extend id buffer))) - (if tn + (if (and tn (tn-offset tn)) (vector-push-extend (tn-sc-offset tn) buffer) (aver minimal)) (when save-tn @@ -496,7 +507,7 @@ (defun compute-1-debug-fun (fun var-locs) (declare (type clambda fun) (type hash-table var-locs)) (let* ((dfun (dfun-from-fun fun)) - (actual-level (policy (lambda-bind fun) debug)) + (actual-level (policy (lambda-bind fun) compute-debug-fun)) (level (if #!+sb-dyncount *collect-dynamic-statistics* #!-sb-dyncount nil (max actual-level 2)