X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=15622b2acb373ad1b41a01b7ae7e91a6c137909b;hb=5470bfd1ed062203f4ab009f6ec19e81f8f32066;hp=465887f735c2a26579c198b29ad0d4e59dc881ae;hpb=099d6dd1f6a5ac2ffec5c14d07a4b905322ef968;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 465887f..15622b2 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -193,7 +193,8 @@ ;;; These exist for caching data stored in packed binary form in ;;; compiler debug-functions. Debug-functions store these. -(defstruct (debug-var (:constructor nil)) +(defstruct (debug-var (:constructor nil) + (:copier nil)) ;; the name of the variable (symbol (required-argument) :type symbol) ;; a unique integer identification relative to other variables with the same @@ -216,7 +217,8 @@ (defstruct (compiled-debug-var (:include debug-var) (:constructor make-compiled-debug-var - (symbol id alive-p sc-offset save-sc-offset))) + (symbol id alive-p sc-offset save-sc-offset)) + (:copier nil)) ;; Storage class and offset. (unexported). (sc-offset nil :type sb!c::sc-offset) ;; Storage class and offset when saved somewhere. @@ -224,14 +226,16 @@ (defstruct (interpreted-debug-var (:include debug-var (alive-p t)) - (:constructor make-interpreted-debug-var (symbol ir1-var))) + (:constructor make-interpreted-debug-var (symbol ir1-var)) + (:copier nil)) ;; This is the IR1 structure that holds information about interpreted vars. (ir1-var nil :type sb!c::lambda-var)) ;;;; frames ;;; These represent call-frames on the stack. -(defstruct (frame (:constructor nil)) +(defstruct (frame (:constructor nil) + (:copier nil)) ;; the next frame up, or NIL when top frame (up nil :type (or frame null)) ;; the previous frame down, or NIL when the bottom frame. Before @@ -273,7 +277,8 @@ (:constructor make-compiled-frame (pointer up debug-function code-location number #!+gengc saved-state-chain - &optional escaped))) + &optional escaped)) + (:copier nil)) ;; This indicates whether someone interrupted the frame. ;; (unexported). If escaped, this is a pointer to the state that was ;; saved when we were interrupted. On the non-gengc system, this is @@ -296,7 +301,8 @@ (:include frame) (:constructor make-interpreted-frame (pointer up debug-function code-location number - real-frame closure))) + real-frame closure)) + (:copier nil)) ;; This points to the compiled-frame for SB!EVAL:INTERNAL-APPLY-LOOP. (real-frame nil :type compiled-frame) ;; This is the closed over data used by the interpreter. @@ -314,7 +320,7 @@ ;;; code-locations and other objects that reference DEBUG-FUNCTIONs ;;; point to unique objects. This is due to the overhead in cached ;;; information. -(defstruct debug-function +(defstruct (debug-function (:copier nil)) ;; Some representation of the function arguments. See ;; DEBUG-FUNCTION-LAMBDA-LIST. ;; NOTE: must parse vars before parsing arg list stuff. @@ -334,7 +340,8 @@ (defstruct (compiled-debug-function (:include debug-function) (:constructor %make-compiled-debug-function - (compiler-debug-fun component))) + (compiler-debug-fun component)) + (:copier nil)) ;; Compiler's dumped debug-function information. (unexported). (compiler-debug-fun nil :type sb!c::compiled-debug-function) ;; Code object. (unexported). @@ -360,7 +367,8 @@ (defstruct (interpreted-debug-function (:include debug-function) - (:constructor %make-interpreted-debug-function (ir1-lambda))) + (:constructor %make-interpreted-debug-function (ir1-lambda)) + (:copier nil)) ;; This is the IR1 lambda that this debug-function represents. (ir1-lambda nil :type sb!c::clambda)) @@ -368,7 +376,8 @@ (:include debug-function) (:constructor make-bogus-debug-function (%name &aux (%lambda-list nil) (%debug-vars nil) - (blocks nil) (%function nil)))) + (blocks nil) (%function nil))) + (:copier nil)) %name) (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq)) @@ -382,8 +391,9 @@ ;;;; DEBUG-BLOCKs ;;; These exist for caching data stored in packed binary form in compiler -;;; debug-blocks. -(defstruct (debug-block (:constructor nil)) +;;; DEBUG-BLOCKs. +(defstruct (debug-block (:constructor nil) + (:copier nil)) ;; Code-locations where execution continues after this block. (successors nil :type list) ;; This indicates whether the block is a special glob of code shared by @@ -408,14 +418,16 @@ (defstruct (compiled-debug-block (:include debug-block) (:constructor make-compiled-debug-block - (code-locations successors elsewhere-p))) - ;; Code-location information for the block. + (code-locations successors elsewhere-p)) + (:copier nil)) + ;; code-location information for the block (code-locations nil :type simple-vector)) (defstruct (interpreted-debug-block (:include debug-block (elsewhere-p nil)) (:constructor %make-interpreted-debug-block - (ir1-block))) + (ir1-block)) + (:copier nil)) ;; This is the IR1 block this debug-block represents. (ir1-block nil :type sb!c::cblock) ;; Code-location information for the block. @@ -466,7 +478,8 @@ ;;; This is an internal structure that manages information about a ;;; breakpoint locations. See *COMPONENT-BREAKPOINT-OFFSETS*. (defstruct (breakpoint-data (:constructor make-breakpoint-data - (component offset))) + (component offset)) + (:copier nil)) ;; This is the component in which the breakpoint lies. component ;; This is the byte offset into the component. @@ -484,7 +497,8 @@ (breakpoint-data-offset obj)))) (defstruct (breakpoint (:constructor %make-breakpoint - (hook-function what kind %info))) + (hook-function what kind %info)) + (:copier nil)) ;; This is the function invoked when execution encounters the ;; breakpoint. It takes a frame, the breakpoint, and optionally a ;; list of values. Values are supplied for :FUNCTION-END breakpoints @@ -551,7 +565,8 @@ ;;;; CODE-LOCATIONs -(defstruct (code-location (:constructor nil)) +(defstruct (code-location (:constructor nil) + (:copier nil)) ;; This is the debug-function containing code-location. (debug-function nil :type debug-function) ;; This is initially :UNSURE. Upon first trying to access an @@ -587,7 +602,8 @@ (:constructor make-known-code-location (pc debug-function %tlf-offset %form-number %live-set kind &aux (%unknown-p nil))) - (:constructor make-compiled-code-location (pc debug-function))) + (:constructor make-compiled-code-location (pc debug-function)) + (:copier nil)) ;; This is an index into debug-function's component slot. (pc nil :type sb!c::index) ;; This is a bit-vector indexed by a variable's position in @@ -602,7 +618,8 @@ (:include code-location (%unknown-p nil)) (:constructor make-interpreted-code-location - (ir1-node debug-function))) + (ir1-node debug-function)) + (:copier nil)) ;; This is an index into debug-function's component slot. (ir1-node nil :type sb!c::node)) @@ -736,17 +753,8 @@ ;;; XXX Should probably check whether it has reached the bottom of the ;;; stack. ;;; -;;; XXX Should handle interrupted frames, both Lisp and C. At present it -;;; manages to find a fp trail, see linux hack below. - -;;; MNA: cmucl-commit: Mon, 6 Nov 2000 10:08:39 -0800 (PST) -;;; Upon a stack trace ambiguity in x86-call-context, choose the lisp -;;; frame in preference to the C frame as this is frame of interest. - -;;; MNA: cmucl-commit: Mon, 6 Nov 2000 09:48:00 -0800 (PST) -;;; Limit the stack trace failure warning in x86-call-context to fails for the -;;; immediate frame rather failures deeper within the search. - +;;; XXX Should handle interrupted frames, both Lisp and C. At present +;;; it manages to find a fp trail, see linux hack below. (defun x86-call-context (fp &key (depth 0)) (declare (type system-area-pointer fp) (fixnum depth)) @@ -776,7 +784,8 @@ (cond ((and lisp-path-fp c-path-fp) ;; Both still seem valid - choose the lisp frame. #+nil (when (zerop depth) - (format t "debug: both still valid ~S ~S ~S ~S~%" + (format t + "debug: both still valid ~S ~S ~S ~S~%" lisp-ocfp lisp-ra c-ocfp c-ra)) #+freebsd (if (sap> lisp-ocfp c-ocfp) @@ -1590,7 +1599,7 @@ (push (frob final-arg debug-vars) res)) (:keyword (push (list :keyword - (sb!c::arg-info-keyword info) + (sb!c::arg-info-key info) (frob final-arg debug-vars)) res)) (:rest @@ -1691,11 +1700,11 @@ res)) (sb!c::more-arg ;; Just ignore the fact that the next two args are - ;; the more arg context and count, and act like they + ;; the &MORE arg context and count, and act like they ;; are regular arguments. nil) (t - ;; keyword arg + ;; &KEY arg (push (list :keyword ele (compiled-debug-function-lambda-list-var @@ -2464,7 +2473,7 @@ ;;; those variables are invalid.) (defun make-valid-lisp-obj (val) (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..") - #!+sb-show (%primitive print (sb!impl::hexstr val)) + #!+sb-show (/hexstr val) (if (or ;; fixnum (zerop (logand val 3)) @@ -2500,16 +2509,14 @@ (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (declare (type system-area-pointer fp)) (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..") - #!+sb-show (%primitive print (sb!impl::hexstr fp)) - #!+sb-show (%primitive print (sb!impl::hexstr sc-offset)) - #!+sb-show (%primitive print (sb!impl::hexstr escaped)) + (/hexstr fp) (/hexstr sc-offset) (/hexstr escaped) (macrolet ((with-escaped-value ((var) &body forms) `(if escaped (let ((,var (sb!vm:context-register escaped (sb!c:sc-offset-offset sc-offset)))) (/show0 "in escaped case, ,VAR value=..") - #!+sb-show (%primitive print (sb!impl::hexstr ,var)) + (/hexstr ,var) ,@forms) :invalid-value-for-unescaped-register-storage)) (escaped-float-value (format) @@ -2531,7 +2538,7 @@ (without-gcing (with-escaped-value (val) (/show0 "VAL=..") - #!+sb-show (%primitive print (sb!impl::hexstr val)) + (/hexstr val) (make-valid-lisp-obj val)))) (#.sb!vm:base-char-reg-sc-number (/show0 "case of BASE-CHAR-REG-SC-NUMBER") @@ -3223,10 +3230,11 @@ (defstruct (function-end-cookie (:print-object (lambda (obj str) (print-unreadable-object (obj str :type t)))) - (:constructor make-function-end-cookie (bogus-lra debug-fun))) - ;; This is a pointer to the bogus-lra created for :function-end bpts. + (:constructor make-function-end-cookie (bogus-lra debug-fun)) + (:copier nil)) + ;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints bogus-lra - ;; This is the debug-function associated with the cookie. + ;; the debug-function associated with the cookie debug-fun) ;;; This maps bogus-lra-components to cookies, so that