From ce2de4927aa06025a584897370aab9e9345da343 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sat, 21 Jan 2017 19:12:23 +0300 Subject: [PATCH] Reduce debug-info size, part 2. Use a single context vector for one debug-info, not one per debug-fun. Remove compiled-debug-info-kind and use different subtypes of compiled-debug-info. --- src/code/debug-info.lisp | 54 ++++++++++++++++++++++++++++++++++++-------- src/code/debug-int.lisp | 3 ++- src/compiler/debug-dump.lisp | 29 ++++++++++++------------ 3 files changed, 61 insertions(+), 25 deletions(-) diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 84e181fa3..ecf7bbb3e 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -72,7 +72,8 @@ ;;;; DEBUG-FUN objects -(def!struct (debug-fun (:constructor nil))) +(def!struct (debug-fun (:constructor nil) + (:copier nil))) (def!struct (compiled-debug-fun (:include debug-fun) #-sb-xc-host (:pure t)) @@ -88,9 +89,7 @@ ;; A list of DEBUG-FUN objects is maintained for each COMPONENT. To ;; figure out which DEBUG-FUN object corresponds to your FUNCTION ;; object, you compare the name values of each. -- WHN 2001-12-20 - (name (missing-arg) :type (or simple-string cons symbol)) - ;; The kind of function (same as FUNCTIONAL-KIND): - (kind nil :type (member nil :optional :external :toplevel :cleanup)) + (name (missing-arg) :type (or simple-string cons symbol) :read-only t) ;; a description of variable locations for this function, in alphabetical ;; order by name; or NIL if no information is available ;; @@ -120,7 +119,6 @@ ;; Check whether this slot's data might have the same problem that ;; that slot's data did. (blocks nil :type (or (simple-array (unsigned-byte 8) (*)) null)) - (contexts nil :type (or simple-vector null)) ;; If all code locations in this function are in the same top level ;; form, then this is the number of that form, otherwise NIL. If ;; NIL, then each code location represented in the BLOCKS specifies @@ -182,12 +180,46 @@ (old-fp (missing-arg) :type sc-offset) ;; The earliest PC in this function at which the environment is properly ;; initialized (arguments moved from passing locations, etc.) - (start-pc (missing-arg) :type index) + (start-pc (missing-arg) :type index :read-only t) ;; The start of elsewhere code for this function (if any.) - (elsewhere-pc (missing-arg) :type index) - (closure-save nil :type (or sc-offset null)) + (elsewhere-pc (missing-arg) :type index :read-only t) + (closure-save nil :type (or sc-offset null) :read-only t) #!+unwind-to-frame-and-call-vop - (bsp-save nil :type (or sc-offset null))) + (bsp-save nil :type (or sc-offset null) :read-only t)) + +(def!struct (compiled-debug-fun-optional (:include compiled-debug-fun) + #-sb-xc-host (:pure t) + (:copier nil) + (:predicate nil))) +(def!struct (compiled-debug-fun-external (:include compiled-debug-fun) + #-sb-xc-host (:pure t) + (:copier nil) + (:predicate nil))) +(def!struct (compiled-debug-fun-toplevel (:include compiled-debug-fun) + #-sb-xc-host (:pure t) + (:copier nil) + (:predicate nil))) +(def!struct (compiled-debug-fun-cleanup (:include compiled-debug-fun) + #-sb-xc-host (:pure t) + (:copier nil) + (:predicate nil))) + +(defun compiled-debug-fun-ctor (kind) + (ecase kind + (:optional #'make-compiled-debug-fun-optional) + (:external #'make-compiled-debug-fun-external) + (:toplevel #'make-compiled-debug-fun-toplevel) + (:cleanup #'make-compiled-debug-fun-cleanup) + ((nil) #'make-compiled-debug-fun))) + +(defun compiled-debug-fun-kind (debug-fun) + (etypecase debug-fun + (compiled-debug-fun-optional :optional) + (compiled-debug-fun-external :external) + (compiled-debug-fun-toplevel :toplevel) + (compiled-debug-fun-cleanup :cleanup) + (compiled-debug-fun nil))) + ;;;; minimal debug function @@ -298,7 +330,9 @@ ;; always careful to put our code in low memory. Is that how it ;; works? Would this break if we used a more general memory map? -- ;; WHN 20000120 - (fun-map (missing-arg) :type simple-vector :read-only t)) + (fun-map (missing-arg) :type simple-vector :read-only t) + ;; Location contexts + (contexts nil :type (or simple-vector null) :read-only t)) (defvar *!initial-debug-sources*) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 7b894bd89..930107d59 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -1668,7 +1668,8 @@ register." "")) (context (and (logtest sb!c::compiled-code-location-context flags) - (svref (sb!c::compiled-debug-fun-contexts compiler-debug-fun) + (svref (sb!c::compiled-debug-info-contexts + (%code-debug-info (compiled-debug-fun-component debug-fun))) (sb!c:read-var-integerf blocks i))))) (vector-push-extend (make-known-code-location pc debug-fun block tlf-offset diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 9e4c86883..b3497f26c 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -160,7 +160,9 @@ (when stepping (write-var-string stepping byte-buffer)) (when context - (write-var-integer (vector-push-extend context *contexts*) byte-buffer))) + (write-var-integer (or (position context *contexts* :test #'equal) + (vector-push-extend context *contexts*)) + byte-buffer))) (values)) ;;; Extract context info from a Location-Info structure and use it to @@ -231,9 +233,6 @@ (let ((*previous-location* 0) (physenv (lambda-physenv fun)) (byte-buffer *byte-buffer*) - (*contexts* (make-array 10 - :fill-pointer 0 - :adjustable t)) prev-block locations elsewhere-locations) @@ -262,7 +261,7 @@ (values (!make-specialized-array (length byte-buffer) '(unsigned-byte 8) byte-buffer) - tlf-num form-number *contexts*)))) + tlf-num form-number)))) ;;; Return DEBUG-SOURCE structure containing information derived from ;;; INFO. @@ -550,9 +549,8 @@ (dispatch (lambda-optional-dispatch fun)) (main-p (and dispatch (eq fun (optional-dispatch-main-entry dispatch))))) - (make-compiled-debug-fun + (funcall (compiled-debug-fun-ctor (if main-p nil (functional-kind fun))) :name (leaf-debug-name fun) - :kind (if main-p nil (functional-kind fun)) #!-fp-and-pc-standard-save :return-pc #!-fp-and-pc-standard-save (tn-sc-offset (ir2-physenv-return-pc 2env)) #!-fp-and-pc-standard-save :old-fp @@ -594,14 +592,11 @@ (compute-args fun var-locs)))) (if (and (>= level 1) (not toplevel-p)) - (multiple-value-bind (blocks tlf-num form-number contexts) + (multiple-value-bind (blocks tlf-num form-number) (compute-debug-blocks fun var-locs) (setf (compiled-debug-fun-blocks dfun) blocks (compiled-debug-fun-tlf-number dfun) tlf-num - (compiled-debug-fun-form-number dfun) form-number - (compiled-debug-fun-contexts dfun) - (and (plusp (length contexts)) - (coerce contexts 'simple-vector)))) + (compiled-debug-fun-form-number dfun) form-number)) (multiple-value-bind (tlf-num form-number) (find-tlf-number fun) (setf (compiled-debug-fun-tlf-number dfun) tlf-num (compiled-debug-fun-form-number dfun) form-number))) @@ -643,7 +638,10 @@ (*byte-buffer* (make-array 10 :element-type '(unsigned-byte 8) :fill-pointer 0 - :adjustable t))) + :adjustable t)) + (*contexts* (make-array 10 + :fill-pointer 0 + :adjustable t))) (dolist (lambda (component-lambdas component)) (clrhash var-locs) (push (cons (label-position (block-label (lambda-block lambda))) @@ -652,7 +650,10 @@ (let* ((sorted (sort dfuns #'< :key #'car)) (fun-map (compute-debug-fun-map sorted))) (make-compiled-debug-info :name (component-name component) - :fun-map fun-map)))) + :fun-map fun-map + :contexts + (and (plusp (length *contexts*)) + (coerce *contexts* 'simple-vector)))))) ;;; Write BITS out to BYTE-BUFFER in backend byte order. The length of ;;; BITS must be evenly divisible by eight. -- 2.11.4.GIT