standard abbreviation FUN for "object of type FUNCTION" (or
some other kind of function when qualified, e.g.
DEBUG-FUN) in global internal names..
..find . -name *.lisp | xargs egrep -i 'debug-function'
..and 'debug-fun-function'
..and 'function-debug'
..and 'frame-function'
13 files changed:
"AMBIGUOUS-DEBUG-VARS" "AMBIGUOUS-VARIABLE-NAME" "BREAKPOINT"
"BREAKPOINT-ACTIVE-P" "BREAKPOINT-HOOK-FUNCTION" "BREAKPOINT-INFO"
"BREAKPOINT-KIND" "BREAKPOINT-P" "BREAKPOINT-WHAT" "CODE-LOCATION"
"AMBIGUOUS-DEBUG-VARS" "AMBIGUOUS-VARIABLE-NAME" "BREAKPOINT"
"BREAKPOINT-ACTIVE-P" "BREAKPOINT-HOOK-FUNCTION" "BREAKPOINT-INFO"
"BREAKPOINT-KIND" "BREAKPOINT-P" "BREAKPOINT-WHAT" "CODE-LOCATION"
- "CODE-LOCATION-DEBUG-BLOCK" "CODE-LOCATION-DEBUG-FUNCTION"
+ "CODE-LOCATION-DEBUG-BLOCK" "CODE-LOCATION-DEBUG-FUN"
"CODE-LOCATION-DEBUG-SOURCE" "CODE-LOCATION-FORM-NUMBER"
"CODE-LOCATION-P" "CODE-LOCATION-TOP-LEVEL-FORM-OFFSET"
"CODE-LOCATION-UNKNOWN-P" "CODE-LOCATION=" "DEACTIVATE-BREAKPOINT"
"DEBUG-BLOCK" "DEBUG-BLOCK-ELSEWHERE-P" "DEBUG-BLOCK-P"
"DEBUG-BLOCK-SUCCESSORS" "DEBUG-CONDITION" "DEBUG-ERROR"
"CODE-LOCATION-DEBUG-SOURCE" "CODE-LOCATION-FORM-NUMBER"
"CODE-LOCATION-P" "CODE-LOCATION-TOP-LEVEL-FORM-OFFSET"
"CODE-LOCATION-UNKNOWN-P" "CODE-LOCATION=" "DEACTIVATE-BREAKPOINT"
"DEBUG-BLOCK" "DEBUG-BLOCK-ELSEWHERE-P" "DEBUG-BLOCK-P"
"DEBUG-BLOCK-SUCCESSORS" "DEBUG-CONDITION" "DEBUG-ERROR"
- "DEBUG-FUNCTION" "DEBUG-FUNCTION-FUNCTION" "DEBUG-FUNCTION-KIND"
- "DEBUG-FUNCTION-LAMBDA-LIST" "DEBUG-FUNCTION-NAME"
- "DEBUG-FUNCTION-P" "DEBUG-FUNCTION-START-LOCATION"
- "DEBUG-FUNCTION-SYMBOL-VARIABLES"
+ "DEBUG-FUN" "DEBUG-FUN-FUN" "DEBUG-FUN-KIND"
+ "DEBUG-FUN-LAMBDA-LIST" "DEBUG-FUN-NAME"
+ "DEBUG-FUN-P" "DEBUG-FUN-START-LOCATION"
+ "DEBUG-FUN-SYMBOL-VARIABLES"
"DEBUG-SOURCE-ROOT-NUMBER" "DEBUG-VAR"
"DEBUG-VAR-ID" "DEBUG-VAR-INFO-AVAILABLE"
"DEBUG-VAR-SYMBOL-NAME" "DEBUG-VAR-P" "DEBUG-VAR-PACKAGE-NAME"
"DEBUG-VAR-SYMBOL" "DEBUG-VAR-VALID-VALUE"
"DEBUG-VAR-VALIDITY" "DEBUG-VAR-VALUE"
"DELETE-BREAKPOINT" "DO-BLOCKS"
"DEBUG-SOURCE-ROOT-NUMBER" "DEBUG-VAR"
"DEBUG-VAR-ID" "DEBUG-VAR-INFO-AVAILABLE"
"DEBUG-VAR-SYMBOL-NAME" "DEBUG-VAR-P" "DEBUG-VAR-PACKAGE-NAME"
"DEBUG-VAR-SYMBOL" "DEBUG-VAR-VALID-VALUE"
"DEBUG-VAR-VALIDITY" "DEBUG-VAR-VALUE"
"DELETE-BREAKPOINT" "DO-BLOCKS"
- "DO-DEBUG-BLOCK-LOCATIONS" "DO-DEBUG-FUNCTION-BLOCKS"
- "DO-DEBUG-FUNCTION-VARIABLES"
+ "DO-DEBUG-BLOCK-LOCATIONS" "DO-DEBUG-FUN-BLOCKS"
+ "DO-DEBUG-FUN-VARIABLES"
"FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES"
"FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES"
- "FRAME-CODE-LOCATION" "FRAME-DEBUG-FUNCTION" "FRAME-DOWN"
- "FRAME-FUNCTION-MISMATCH" "FRAME-NUMBER" "FRAME-P" "FRAME-UP"
- "FUNCTION-DEBUG-FUNCTION" "FUNCTION-END-COOKIE-VALID-P"
+ "FRAME-CODE-LOCATION" "FRAME-DEBUG-FUN" "FRAME-DOWN"
+ "FRAME-FUN-MISMATCH" "FRAME-NUMBER" "FRAME-P" "FRAME-UP"
+ "FUN-DEBUG-FUN" "FUNCTION-END-COOKIE-VALID-P"
"INVALID-CONTROL-STACK-POINTER" "INVALID-VALUE"
"LAMBDA-LIST-UNAVAILABLE" "MAKE-BREAKPOINT" "NO-DEBUG-BLOCKS"
"INVALID-CONTROL-STACK-POINTER" "INVALID-VALUE"
"LAMBDA-LIST-UNAVAILABLE" "MAKE-BREAKPOINT" "NO-DEBUG-BLOCKS"
- "NO-DEBUG-FUNCTION-RETURNS" "NO-DEBUG-INFO" "PREPROCESS-FOR-EVAL"
+ "NO-DEBUG-FUN-RETURNS" "NO-DEBUG-INFO" "PREPROCESS-FOR-EVAL"
"RETURN-FROM-FRAME" "SOURCE-PATH-CONTEXT"
"TOP-FRAME" "UNHANDLED-DEBUG-CONDITION" "UNKNOWN-CODE-LOCATION"
"UNKNOWN-CODE-LOCATION-P" "UNKNOWN-DEBUG-VAR"
"RETURN-FROM-FRAME" "SOURCE-PATH-CONTEXT"
"TOP-FRAME" "UNHANDLED-DEBUG-CONDITION" "UNKNOWN-CODE-LOCATION"
"UNKNOWN-CODE-LOCATION-P" "UNKNOWN-DEBUG-VAR"
"PRIN1-SHORT" "PRINT-BYTES"
"PRINT-CURRENT-ADDRESS" "PRINT-FIELD" "PRINT-INST"
"PRINT-INST-USING" "PRINT-NOTES-AND-NEWLINE"
"PRIN1-SHORT" "PRINT-BYTES"
"PRINT-CURRENT-ADDRESS" "PRINT-FIELD" "PRINT-INST"
"PRINT-INST-USING" "PRINT-NOTES-AND-NEWLINE"
- "PRINT-WORDS" "SAP-REF-DCHUNK" "SEG-DEBUG-FUNCTION"
+ "PRINT-WORDS" "SAP-REF-DCHUNK" "SEG-DEBUG-FUN"
"SEG-LENGTH" "SEG-START" "SEGMENT"
"SET-ADDRESS-PRINTING-RANGE" "SET-DISASSEM-PARAMS"
"SET-DSTATE-SEGMENT" "SIGN-EXTEND" "SPECIALIZE"
"SEG-LENGTH" "SEG-START" "SEGMENT"
"SET-ADDRESS-PRINTING-RANGE" "SET-DISASSEM-PARAMS"
"SET-DSTATE-SEGMENT" "SIGN-EXTEND" "SPECIALIZE"
nil))
;;; COERCE-TO-CONDITION is used in SIGNAL, ERROR, CERROR, WARN, and
nil))
;;; COERCE-TO-CONDITION is used in SIGNAL, ERROR, CERROR, WARN, and
-;;; INVOKE-DEBUGGER for parsing the hairy argument conventions into a single
-;;; argument that's directly usable by all the other routines.
+;;; INVOKE-DEBUGGER for parsing the hairy argument conventions into a
+;;; single argument that's directly usable by all the other routines.
(defun coerce-to-condition (datum arguments default-type function-name)
(cond ((typep datum 'condition)
(if arguments
(defun coerce-to-condition (datum arguments default-type function-name)
(cond ((typep datum 'condition)
(if arguments
;;; FIXME: old CMU CL representation follows:
;;; Compiled debug variables are in a packed binary representation in the
;;; FIXME: old CMU CL representation follows:
;;; Compiled debug variables are in a packed binary representation in the
-;;; DEBUG-FUNCTION-VARIABLES:
+;;; DEBUG-FUN-VARIABLES:
;;; single byte of boolean flags:
;;; uninterned name
;;; packaged name
;;; single byte of boolean flags:
;;; uninterned name
;;; packaged name
;;;; compiled debug blocks
;;;;
;;;; Compiled debug blocks are in a packed binary representation in the
;;;; compiled debug blocks
;;;;
;;;; Compiled debug blocks are in a packed binary representation in the
-;;;; DEBUG-FUNCTION-BLOCKS:
;;;; number of successors + bit flags (single byte)
;;;; elsewhere-p
;;;; ...ordinal number of each successor in the function's blocks vector...
;;;; number of successors + bit flags (single byte)
;;;; elsewhere-p
;;;; ...ordinal number of each successor in the function's blocks vector...
#(:unknown-return :known-return :internal-error :non-local-exit
:block-start :call-site :single-value-return :non-local-entry))
\f
#(:unknown-return :known-return :internal-error :non-local-exit
:block-start :call-site :single-value-return :non-local-entry))
\f
-;;;; DEBUG-FUNCTION objects
-(def!struct (debug-function (:constructor nil)))
+(def!struct (debug-fun (:constructor nil)))
-(def!struct (compiled-debug-function (:include debug-function)
- #-sb-xc-host (:pure t))
+(def!struct (compiled-debug-fun (:include debug-fun)
+ #-sb-xc-host (:pure t))
;; The name of this function. If from a DEFUN, etc., then this is the
;; function name, otherwise it is a descriptive string.
(name (required-argument) :type (or simple-string cons symbol))
;; The name of this function. If from a DEFUN, etc., then this is the
;; function name, otherwise it is a descriptive string.
(name (required-argument) :type (or simple-string cons symbol))
;;
;; Each entry is:
;; * a FLAGS value, which is a FIXNUM with various
;;
;; Each entry is:
;; * a FLAGS value, which is a FIXNUM with various
- ;; COMPILED-DEBUG-FUNCTION-FOO bits set
+ ;; COMPILED-DEBUG-FUN-FOO bits set
;; * the symbol which names this variable, unless debug info is minimal
;; * the variable ID, when it has one
;; * SC-offset of primary location, if it has one
;; * the symbol which names this variable, unless debug info is minimal
;; * the variable ID, when it has one
;; * SC-offset of primary location, if it has one
;;; The following are definitions of bit-fields in the first byte of
;;; the minimal debug function:
;;; The following are definitions of bit-fields in the first byte of
;;; the minimal debug function:
-(defconstant minimal-debug-function-name-symbol 0)
-(defconstant minimal-debug-function-name-packaged 1)
-(defconstant minimal-debug-function-name-uninterned 2)
-(defconstant minimal-debug-function-name-component 3)
-(defconstant-eqx minimal-debug-function-name-style-byte (byte 2 0) #'equalp)
-(defconstant-eqx minimal-debug-function-kind-byte (byte 3 2) #'equalp)
-(defparameter *minimal-debug-function-kinds*
+(defconstant minimal-debug-fun-name-symbol 0)
+(defconstant minimal-debug-fun-name-packaged 1)
+(defconstant minimal-debug-fun-name-uninterned 2)
+(defconstant minimal-debug-fun-name-component 3)
+(defconstant-eqx minimal-debug-fun-name-style-byte (byte 2 0) #'equalp)
+(defconstant-eqx minimal-debug-fun-kind-byte (byte 3 2) #'equalp)
+(defparameter *minimal-debug-fun-kinds*
#(nil :optional :external :top-level :cleanup))
#(nil :optional :external :top-level :cleanup))
-(defconstant minimal-debug-function-returns-standard 0)
-(defconstant minimal-debug-function-returns-specified 1)
-(defconstant minimal-debug-function-returns-fixed 2)
-(defconstant-eqx minimal-debug-function-returns-byte (byte 2 5) #'equalp)
+(defconstant minimal-debug-fun-returns-standard 0)
+(defconstant minimal-debug-fun-returns-specified 1)
+(defconstant minimal-debug-fun-returns-fixed 2)
+(defconstant-eqx minimal-debug-fun-returns-byte (byte 2 5) #'equalp)
;;; The following are bit-flags in the second byte of the minimal debug
;;; function:
;;; * If true, wrap (SETF ...) around the name.
;;; The following are bit-flags in the second byte of the minimal debug
;;; function:
;;; * If true, wrap (SETF ...) around the name.
-(defconstant minimal-debug-function-setf-bit (ash 1 0))
+(defconstant minimal-debug-fun-setf-bit (ash 1 0))
;;; * If true, there is a NFP.
;;; * If true, there is a NFP.
-(defconstant minimal-debug-function-nfp-bit (ash 1 1))
+(defconstant minimal-debug-fun-nfp-bit (ash 1 1))
;;; * If true, variables (hence arguments) have been dumped.
;;; * If true, variables (hence arguments) have been dumped.
-(defconstant minimal-debug-function-variables-bit (ash 1 2))
+(defconstant minimal-debug-fun-variables-bit (ash 1 2))
(def!struct (compiled-debug-info
(:include debug-info)
#-sb-xc-host (:pure t))
(def!struct (compiled-debug-info
(:include debug-info)
#-sb-xc-host (:pure t))
- ;; a simple-vector of alternating DEBUG-FUNCTION objects and fixnum
+ ;; a simple-vector of alternating DEBUG-FUN objects and fixnum
;; PCs, used to map PCs to functions, so that we can figure out what
;; function we were running in. Each function is valid between the
;; PC before it (inclusive) and the PC after it (exclusive). The PCs
;; PCs, used to map PCs to functions, so that we can figure out what
;; function we were running in. Each function is valid between the
;; PC before it (inclusive) and the PC after it (exclusive). The PCs
"no debug information available for ~S~%"
(no-debug-info-code-component condition)))))
"no debug information available for ~S~%"
(no-debug-info-code-component condition)))))
-(define-condition no-debug-function-returns (debug-condition)
- ((debug-function :reader no-debug-function-returns-debug-function
- :initarg :debug-function))
+(define-condition no-debug-fun-returns (debug-condition)
+ ((debug-fun :reader no-debug-fun-returns-debug-fun
+ :initarg :debug-fun))
#!+sb-doc
(:documentation
#!+sb-doc
(:documentation
- "The system could not return values from a frame with DEBUG-FUNCTION since
+ "The system could not return values from a frame with DEBUG-FUN since
it lacked information about returning values.")
(:report (lambda (condition stream)
it lacked information about returning values.")
(:report (lambda (condition stream)
- (let ((fun (debug-function-function
- (no-debug-function-returns-debug-function condition))))
+ (let ((fun (debug-fun-fun
+ (no-debug-fun-returns-debug-fun condition))))
(format stream
"~&Cannot return values from ~:[frame~;~:*~S~] since ~
the debug information lacks details about returning ~
(format stream
"~&Cannot return values from ~:[frame~;~:*~S~] since ~
the debug information lacks details about returning ~
fun)))))
(define-condition no-debug-blocks (debug-condition)
fun)))))
(define-condition no-debug-blocks (debug-condition)
- ((debug-function :reader no-debug-blocks-debug-function
- :initarg :debug-function))
+ ((debug-fun :reader no-debug-blocks-debug-fun
+ :initarg :debug-fun))
- (:documentation "The debug-function has no debug-block information.")
+ (:documentation "The debug-fun has no debug-block information.")
(:report (lambda (condition stream)
(format stream "~&~S has no debug-block information."
(:report (lambda (condition stream)
(format stream "~&~S has no debug-block information."
- (no-debug-blocks-debug-function condition)))))
+ (no-debug-blocks-debug-fun condition)))))
(define-condition no-debug-vars (debug-condition)
(define-condition no-debug-vars (debug-condition)
- ((debug-function :reader no-debug-vars-debug-function
- :initarg :debug-function))
+ ((debug-fun :reader no-debug-vars-debug-fun
+ :initarg :debug-fun))
- (:documentation "The debug-function has no DEBUG-VAR information.")
+ (:documentation "The DEBUG-FUN has no DEBUG-VAR information.")
(:report (lambda (condition stream)
(format stream "~&~S has no debug variable information."
(:report (lambda (condition stream)
(format stream "~&~S has no debug variable information."
- (no-debug-vars-debug-function condition)))))
+ (no-debug-vars-debug-fun condition)))))
(define-condition lambda-list-unavailable (debug-condition)
(define-condition lambda-list-unavailable (debug-condition)
- ((debug-function :reader lambda-list-unavailable-debug-function
- :initarg :debug-function))
+ ((debug-fun :reader lambda-list-unavailable-debug-fun
+ :initarg :debug-fun))
#!+sb-doc
(:documentation
#!+sb-doc
(:documentation
- "The debug-function has no lambda-list since argument DEBUG-VARs are
+ "The DEBUG-FUN has no lambda list since argument DEBUG-VARs are
unavailable.")
(:report (lambda (condition stream)
(format stream "~&~S has no lambda-list information available."
unavailable.")
(:report (lambda (condition stream)
(format stream "~&~S has no lambda-list information available."
- (lambda-list-unavailable-debug-function condition)))))
+ (lambda-list-unavailable-debug-fun condition)))))
(define-condition invalid-value (debug-condition)
((debug-var :reader invalid-value-debug-var :initarg :debug-var)
(define-condition invalid-value (debug-condition)
((debug-var :reader invalid-value-debug-var :initarg :debug-var)
(define-condition unknown-debug-var (debug-error)
((debug-var :reader unknown-debug-var-debug-var :initarg :debug-var)
(define-condition unknown-debug-var (debug-error)
((debug-var :reader unknown-debug-var-debug-var :initarg :debug-var)
- (debug-function :reader unknown-debug-var-debug-function
- :initarg :debug-function))
+ (debug-fun :reader unknown-debug-var-debug-fun
+ :initarg :debug-fun))
(:report (lambda (condition stream)
(format stream "~&~S is not in ~S."
(unknown-debug-var-debug-var condition)
(:report (lambda (condition stream)
(format stream "~&~S is not in ~S."
(unknown-debug-var-debug-var condition)
- (unknown-debug-var-debug-function condition)))))
+ (unknown-debug-var-debug-fun condition)))))
(define-condition invalid-control-stack-pointer (debug-error)
()
(define-condition invalid-control-stack-pointer (debug-error)
()
(fresh-line stream)
(write-string "invalid control stack pointer" stream))))
(fresh-line stream)
(write-string "invalid control stack pointer" stream))))
-(define-condition frame-function-mismatch (debug-error)
- ((code-location :reader frame-function-mismatch-code-location
+(define-condition frame-fun-mismatch (debug-error)
+ ((code-location :reader frame-fun-mismatch-code-location
- (frame :reader frame-function-mismatch-frame :initarg :frame)
- (form :reader frame-function-mismatch-form :initarg :form))
+ (frame :reader frame-fun-mismatch-frame :initarg :frame)
+ (form :reader frame-fun-mismatch-form :initarg :form))
(:report (lambda (condition stream)
(format
stream
"~&Form was preprocessed for ~S,~% but called on ~S:~% ~S"
(:report (lambda (condition stream)
(format
stream
"~&Form was preprocessed for ~S,~% but called on ~S:~% ~S"
- (frame-function-mismatch-code-location condition)
- (frame-function-mismatch-frame condition)
- (frame-function-mismatch-form condition)))))
+ (frame-fun-mismatch-code-location condition)
+ (frame-fun-mismatch-frame condition)
+ (frame-fun-mismatch-form condition)))))
;;; This signals debug-conditions. If they go unhandled, then signal
;;; an UNHANDLED-DEBUG-CONDITION error.
;;; This signals debug-conditions. If they go unhandled, then signal
;;; an UNHANDLED-DEBUG-CONDITION error.
;;;; DEBUG-VARs
;;; These exist for caching data stored in packed binary form in
;;;; DEBUG-VARs
;;; These exist for caching data stored in packed binary form in
-;;; compiler debug-functions. Debug-functions store these.
+;;; compiler DEBUG-FUNs.
(defstruct (debug-var (:constructor nil)
(:copier nil))
;; the name of the variable
(defstruct (debug-var (:constructor nil)
(:copier nil))
;; the name of the variable
(:constructor make-compiled-debug-var
(symbol id alive-p sc-offset save-sc-offset))
(:copier nil))
(:constructor make-compiled-debug-var
(symbol id alive-p sc-offset save-sc-offset))
(:copier nil))
- ;; Storage class and offset. (unexported).
+ ;; storage class and offset (unexported)
(sc-offset nil :type sb!c::sc-offset)
(sc-offset nil :type sb!c::sc-offset)
- ;; Storage class and offset when saved somewhere.
+ ;; storage class and offset when saved somewhere
(save-sc-offset nil :type (or sb!c::sc-offset null)))
;;;; frames
(save-sc-offset nil :type (or sb!c::sc-offset null)))
;;;; frames
-;;; These represent call-frames on the stack.
+;;; These represent call frames on the stack.
(defstruct (frame (:constructor nil)
(:copier nil))
;; the next frame up, or NIL when top frame
(defstruct (frame (:constructor nil)
(:copier nil))
;; the next frame up, or NIL when top frame
;; to the control stack for the given frame. This lets us get the
;; next frame down and the return-pc for that frame.
(%down :unparsed :type (or frame (member nil :unparsed)))
;; to the control stack for the given frame. This lets us get the
;; next frame down and the return-pc for that frame.
(%down :unparsed :type (or frame (member nil :unparsed)))
- ;; the debug-function for the function whose call this frame
- ;; represents
- (debug-function nil :type debug-function)
- ;; the code-location to continue upon return to frame
+ ;; the DEBUG-FUN for the function whose call this frame represents
+ (debug-fun nil :type debug-fun)
+ ;; the CODE-LOCATION where the frame's DEBUG-FUN will continue
+ ;; running when program execution returns to this frame. If someone
+ ;; interrupted this frame, the result could be an unknown
+ ;; CODE-LOCATION.
(code-location nil :type code-location)
;; an a-list of catch-tags to code-locations
(%catches :unparsed :type (or list (member :unparsed)))
(code-location nil :type code-location)
;; an a-list of catch-tags to code-locations
(%catches :unparsed :type (or list (member :unparsed)))
;; This is the frame's number for prompt printing. Top is zero.
(number 0 :type index))
;; This is the frame's number for prompt printing. Top is zero.
(number 0 :type index))
-#!+sb-doc
-(setf (fdocumentation 'frame-up 'function)
- "Return the frame immediately above frame on the stack. When frame is
- the top of the stack, this returns nil.")
-
-#!+sb-doc
-(setf (fdocumentation 'frame-debug-function 'function)
- "Return the debug-function for the function whose call frame represents.")
-
-#!+sb-doc
-(setf (fdocumentation 'frame-code-location 'function)
- "Return the code-location where the frame's debug-function will continue
- running when program execution returns to this frame. If someone
- interrupted this frame, the result could be an unknown code-location.")
-
(defstruct (compiled-frame
(:include frame)
(:constructor make-compiled-frame
(defstruct (compiled-frame
(:include frame)
(:constructor make-compiled-frame
- (pointer up debug-function code-location number
+ (pointer up debug-fun code-location number
&optional escaped))
(:copier nil))
;; This indicates whether someone interrupted the frame.
&optional escaped))
(:copier nil))
;; This indicates whether someone interrupted the frame.
(print-unreadable-object (obj str :type t)
(format str
"~S~:[~;, interrupted~]"
(print-unreadable-object (obj str :type t)
(format str
"~S~:[~;, interrupted~]"
- (debug-function-name (frame-debug-function obj))
+ (debug-fun-name (frame-debug-fun obj))
(compiled-frame-escaped obj))))
\f
(compiled-frame-escaped obj))))
\f
;;; These exist for caching data stored in packed binary form in
;;; These exist for caching data stored in packed binary form in
-;;; compiler debug-functions. *COMPILED-DEBUG-FUNCTIONS* maps a
-;;; SB!C::DEBUG-FUNCTION to a DEBUG-FUNCTION. There should only be one
-;;; DEBUG-FUNCTION in existence for any function; that is, all
-;;; 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 (:constructor nil)
- (:copier nil))
+;;; compiler DEBUG-FUNs. *COMPILED-DEBUG-FUNS* maps a SB!C::DEBUG-FUN
+;;; to a DEBUG-FUN. There should only be one DEBUG-FUN in existence
+;;; for any function; that is, all CODE-LOCATIONs and other objects
+;;; that reference DEBUG-FUNs point to unique objects. This is
+;;; due to the overhead in cached information.
+(defstruct (debug-fun (:constructor nil)
+ (:copier nil))
;; some representation of the function arguments. See
;; some representation of the function arguments. See
- ;; DEBUG-FUNCTION-LAMBDA-LIST.
+ ;; DEBUG-FUN-LAMBDA-LIST.
;; NOTE: must parse vars before parsing arg list stuff.
(%lambda-list :unparsed)
;; cached DEBUG-VARS information (unexported).
;; NOTE: must parse vars before parsing arg list stuff.
(%lambda-list :unparsed)
;; cached DEBUG-VARS information (unexported).
(blocks :unparsed :type (or simple-vector null (member :unparsed)))
;; the actual function if available
(%function :unparsed :type (or null function (member :unparsed))))
(blocks :unparsed :type (or simple-vector null (member :unparsed)))
;; the actual function if available
(%function :unparsed :type (or null function (member :unparsed))))
-(def!method print-object ((obj debug-function) stream)
+(def!method print-object ((obj debug-fun) stream)
(print-unreadable-object (obj stream :type t)
(print-unreadable-object (obj stream :type t)
- (prin1 (debug-function-name obj) stream)))
+ (prin1 (debug-fun-name obj) stream)))
-(defstruct (compiled-debug-function
- (:include debug-function)
- (:constructor %make-compiled-debug-function
+(defstruct (compiled-debug-fun
+ (:include debug-fun)
+ (:constructor %make-compiled-debug-fun
(compiler-debug-fun component))
(:copier nil))
(compiler-debug-fun component))
(:copier nil))
- ;; compiler's dumped debug-function information (unexported)
- (compiler-debug-fun nil :type sb!c::compiled-debug-function)
+ ;; compiler's dumped DEBUG-FUN information (unexported)
+ (compiler-debug-fun nil :type sb!c::compiled-debug-fun)
;; code object (unexported).
component
;; the :FUNCTION-START breakpoint (if any) used to facilitate
;; function end breakpoints
(end-starter nil :type (or null breakpoint)))
;; code object (unexported).
component
;; the :FUNCTION-START breakpoint (if any) used to facilitate
;; function end breakpoints
(end-starter nil :type (or null breakpoint)))
-;;; This maps SB!C::COMPILED-DEBUG-FUNCTIONs to
-;;; COMPILED-DEBUG-FUNCTIONs, so we can get at cached stuff and not
-;;; duplicate COMPILED-DEBUG-FUNCTION structures.
-(defvar *compiled-debug-functions* (make-hash-table :test 'eq))
+;;; This maps SB!C::COMPILED-DEBUG-FUNs to
+;;; COMPILED-DEBUG-FUNs, so we can get at cached stuff and not
+;;; duplicate COMPILED-DEBUG-FUN structures.
+(defvar *compiled-debug-funs* (make-hash-table :test 'eq))
-;;; Make a COMPILED-DEBUG-FUNCTION for a SB!C::COMPILER-DEBUG-FUNCTION
+;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN
;;; and its component. This maps the latter to the former in
;;; and its component. This maps the latter to the former in
-;;; *COMPILED-DEBUG-FUNCTIONS*. If there already is a
-;;; COMPILED-DEBUG-FUNCTION, then this returns it from
-;;; *COMPILED-DEBUG-FUNCTIONS*.
-(defun make-compiled-debug-function (compiler-debug-fun component)
- (or (gethash compiler-debug-fun *compiled-debug-functions*)
- (setf (gethash compiler-debug-fun *compiled-debug-functions*)
- (%make-compiled-debug-function compiler-debug-fun component))))
-
-(defstruct (bogus-debug-function
- (:include debug-function)
- (:constructor make-bogus-debug-function
+;;; *COMPILED-DEBUG-FUNS*. If there already is a
+;;; COMPILED-DEBUG-FUN, then this returns it from
+;;; *COMPILED-DEBUG-FUNS*.
+(defun make-compiled-debug-fun (compiler-debug-fun component)
+ (or (gethash compiler-debug-fun *compiled-debug-funs*)
+ (setf (gethash compiler-debug-fun *compiled-debug-funs*)
+ (%make-compiled-debug-fun compiler-debug-fun component))))
+
+(defstruct (bogus-debug-fun
+ (:include debug-fun)
+ (:constructor make-bogus-debug-fun
(%name &aux (%lambda-list nil) (%debug-vars nil)
(blocks nil) (%function nil)))
(:copier nil))
%name)
(%name &aux (%lambda-list nil) (%debug-vars nil)
(blocks nil) (%function nil)))
(:copier nil))
%name)
-(defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))
+(defvar *ir1-lambda-debug-fun* (make-hash-table :test 'eq))
(def!method print-object ((obj breakpoint-data) str)
(print-unreadable-object (obj str :type t)
(format str "~S at ~S"
(def!method print-object ((obj breakpoint-data) str)
(print-unreadable-object (obj str :type t)
(format str "~S at ~S"
- (debug-function-name
- (debug-function-from-pc (breakpoint-data-component obj)
- (breakpoint-data-offset obj)))
+ (debug-fun-name
+ (debug-fun-from-pc (breakpoint-data-component obj)
+ (breakpoint-data-offset obj)))
(breakpoint-data-offset obj))))
(defstruct (breakpoint (:constructor %make-breakpoint
(breakpoint-data-offset obj))))
(defstruct (breakpoint (:constructor %make-breakpoint
;; :FUNCTION-END breakpoint hook-functions also take a cookie
;; argument. See COOKIE-FUN slot.
(hook-function nil :type function)
;; :FUNCTION-END breakpoint hook-functions also take a cookie
;; argument. See COOKIE-FUN slot.
(hook-function nil :type function)
- ;; CODE-LOCATION or DEBUG-FUNCTION
- (what nil :type (or code-location debug-function))
+ ;; CODE-LOCATION or DEBUG-FUN
+ (what nil :type (or code-location debug-fun))
;; :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END for that kind
;; of breakpoint. :UNKNOWN-RETURN-PARTNER if this is the partner of
;; a :code-location breakpoint at an :UNKNOWN-RETURN code-location.
;; :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END for that kind
;; of breakpoint. :UNKNOWN-RETURN-PARTNER if this is the partner of
;; a :code-location breakpoint at an :UNKNOWN-RETURN code-location.
"~S~:[~;~:*~S~]"
(etypecase what
(code-location what)
"~S~:[~;~:*~S~]"
(etypecase what
(code-location what)
- (debug-function (debug-function-name what)))
+ (debug-fun (debug-fun-name what)))
(etypecase what
(code-location nil)
(etypecase what
(code-location nil)
- (debug-function (breakpoint-kind obj)))))))
+ (debug-fun (breakpoint-kind obj)))))))
\f
;;;; CODE-LOCATIONs
(defstruct (code-location (:constructor nil)
(:copier nil))
\f
;;;; CODE-LOCATIONs
(defstruct (code-location (:constructor nil)
(:copier nil))
- ;; This is the debug-function containing code-location.
- (debug-function nil :type debug-function)
+ ;; the DEBUG-FUN containing this CODE-LOCATION
+ (debug-fun nil :type debug-fun)
;; This is initially :UNSURE. Upon first trying to access an
;; :unparsed slot, if the data is unavailable, then this becomes t,
;; and the code-location is unknown. If the data is available, this
;; This is initially :UNSURE. Upon first trying to access an
;; :unparsed slot, if the data is unavailable, then this becomes t,
;; and the code-location is unknown. If the data is available, this
;; parsing the stack, we don't want to unpack all the variables and
;; blocks just to make frames.
(%unknown-p :unsure :type (member t nil :unsure))
;; parsing the stack, we don't want to unpack all the variables and
;; blocks just to make frames.
(%unknown-p :unsure :type (member t nil :unsure))
- ;; This is the debug-block containing code-location. Possibly toss
- ;; this out and just find it in the blocks cache in debug-function.
+ ;; the DEBUG-BLOCK containing CODE-LOCATION. XXX Possibly toss this
+ ;; out and just find it in the blocks cache in DEBUG-FUN.
(%debug-block :unparsed :type (or debug-block (member :unparsed)))
;; This is the number of forms processed by the compiler or loader
;; before the top-level form containing this code-location.
(%debug-block :unparsed :type (or debug-block (member :unparsed)))
;; This is the number of forms processed by the compiler or loader
;; before the top-level form containing this code-location.
(%form-number :unparsed :type (or sb!c::index (member :unparsed))))
(def!method print-object ((obj code-location) str)
(print-unreadable-object (obj str :type t)
(%form-number :unparsed :type (or sb!c::index (member :unparsed))))
(def!method print-object ((obj code-location) str)
(print-unreadable-object (obj str :type t)
- (prin1 (debug-function-name (code-location-debug-function obj))
+ (prin1 (debug-fun-name (code-location-debug-fun obj))
str)))
(defstruct (compiled-code-location
(:include code-location)
(:constructor make-known-code-location
str)))
(defstruct (compiled-code-location
(:include code-location)
(:constructor make-known-code-location
- (pc debug-function %tlf-offset %form-number
+ (pc debug-fun %tlf-offset %form-number
%live-set kind &aux (%unknown-p nil)))
%live-set kind &aux (%unknown-p nil)))
- (:constructor make-compiled-code-location (pc debug-function))
+ (:constructor make-compiled-code-location (pc debug-fun))
- ;; This is an index into debug-function's component slot.
+ ;; an index into DEBUG-FUN's component slot
(pc nil :type sb!c::index)
(pc nil :type sb!c::index)
- ;; This is a bit-vector indexed by a variable's position in
- ;; DEBUG-FUNCTION-DEBUG-VARS indicating whether the variable has a
+ ;; a bit-vector indexed by a variable's position in
+ ;; DEBUG-FUN-DEBUG-VARS indicating whether the variable has a
;; valid value at this code-location. (unexported).
(%live-set :unparsed :type (or simple-bit-vector (member :unparsed)))
;; (unexported) To see SB!C::LOCATION-KIND, do
;; valid value at this code-location. (unexported).
(%live-set :unparsed :type (or simple-bit-vector (member :unparsed)))
;; (unexported) To see SB!C::LOCATION-KIND, do
;; them to COMPUTE-CALLING-FRAME.
(let ((down (frame-%down frame)))
(if (eq down :unparsed)
;; them to COMPUTE-CALLING-FRAME.
(let ((down (frame-%down frame)))
(if (eq down :unparsed)
- (let ((debug-fun (frame-debug-function frame)))
+ (let ((debug-fun (frame-debug-fun frame)))
(/show0 "in DOWN :UNPARSED case")
(setf (frame-%down frame)
(etypecase debug-fun
(/show0 "in DOWN :UNPARSED case")
(setf (frame-%down frame)
(etypecase debug-fun
- (compiled-debug-function
- (let ((c-d-f (compiled-debug-function-compiler-debug-fun
+ (compiled-debug-fun
+ (let ((c-d-f (compiled-debug-fun-compiler-debug-fun
debug-fun)))
(compute-calling-frame
(descriptor-sap
(get-context-value
frame sb!vm::ocfp-save-offset
debug-fun)))
(compute-calling-frame
(descriptor-sap
(get-context-value
frame sb!vm::ocfp-save-offset
- (sb!c::compiled-debug-function-old-fp c-d-f)))
+ (sb!c::compiled-debug-fun-old-fp c-d-f)))
(get-context-value
frame sb!vm::lra-save-offset
(get-context-value
frame sb!vm::lra-save-offset
- (sb!c::compiled-debug-function-return-pc c-d-f))
+ (sb!c::compiled-debug-fun-return-pc c-d-f))
(let ((fp (frame-pointer frame)))
(when (cstack-pointer-valid-p fp)
#!+x86
(let ((fp (frame-pointer frame)))
(when (cstack-pointer-valid-p fp)
#!+x86
(compute-calling-frame caller real-lra up-frame))
(let ((d-fun (case code
(:undefined-function
(compute-calling-frame caller real-lra up-frame))
(let ((d-fun (case code
(:undefined-function
- (make-bogus-debug-function
"undefined function"))
(:foreign-function
"undefined function"))
(:foreign-function
- (make-bogus-debug-function
"foreign function call land"))
((nil)
"foreign function call land"))
((nil)
- (make-bogus-debug-function
- (debug-function-from-pc code pc-offset)))))
+ (debug-fun-from-pc code pc-offset)))))
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
escaped)
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
escaped)
(let ((d-fun (case code
(:undefined-function
(let ((d-fun (case code
(:undefined-function
- (make-bogus-debug-function
"undefined function"))
(:foreign-function
"undefined function"))
(:foreign-function
- (make-bogus-debug-function
"foreign function call land"))
((nil)
"foreign function call land"))
((nil)
- (make-bogus-debug-function
- (debug-function-from-pc code pc-offset)))))
+ (debug-fun-from-pc code pc-offset)))))
(/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
(/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
-;;; This returns a COMPILED-DEBUG-FUNCTION for code and pc. We fetch
+;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch
;;; the SB!C::DEBUG-INFO and run down its function-map to get a
;;; the SB!C::DEBUG-INFO and run down its function-map to get a
-;;; SB!C::COMPILED-DEBUG-FUNCTION from the pc. The result only needs
+;;; SB!C::COMPILED-DEBUG-FUN from the pc. The result only needs
;;; to reference the component, for function constants, and the
;;; to reference the component, for function constants, and the
-;;; SB!C::COMPILED-DEBUG-FUNCTION.
-(defun debug-function-from-pc (component pc)
+;;; SB!C::COMPILED-DEBUG-FUN.
+(defun debug-fun-from-pc (component pc)
(let ((info (%code-debug-info component)))
(cond
((not info)
(debug-signal 'no-debug-info :code-component component))
((eq info :bogus-lra)
(let ((info (%code-debug-info component)))
(cond
((not info)
(debug-signal 'no-debug-info :code-component component))
((eq info :bogus-lra)
- (make-bogus-debug-function "function end breakpoint"))
+ (make-bogus-debug-fun "function end breakpoint"))
(t
(let* ((function-map (get-debug-info-function-map info))
(len (length function-map)))
(declare (simple-vector function-map))
(if (= len 1)
(t
(let* ((function-map (get-debug-info-function-map info))
(len (length function-map)))
(declare (simple-vector function-map))
(if (= len 1)
- (make-compiled-debug-function (svref function-map 0) component)
+ (make-compiled-debug-fun (svref function-map 0) component)
- (>= pc (sb!c::compiled-debug-function-elsewhere-pc
+ (>= pc (sb!c::compiled-debug-fun-elsewhere-pc
(svref function-map 0)))))
(declare (type sb!int:index i))
(loop
(when (or (= i len)
(< pc (if elsewhere-p
(svref function-map 0)))))
(declare (type sb!int:index i))
(loop
(when (or (= i len)
(< pc (if elsewhere-p
- (sb!c::compiled-debug-function-elsewhere-pc
+ (sb!c::compiled-debug-fun-elsewhere-pc
(svref function-map (1+ i)))
(svref function-map i))))
(svref function-map (1+ i)))
(svref function-map i))))
- (return (make-compiled-debug-function
+ (return (make-compiled-debug-fun
(svref function-map (1- i))
component)))
(incf i 2)))))))))
(svref function-map (1- i))
component)))
(incf i 2)))))))))
-;;; This returns a code-location for the COMPILED-DEBUG-FUNCTION,
+;;; This returns a code-location for the COMPILED-DEBUG-FUN,
;;; DEBUG-FUN, and the pc into its code vector. If we stopped at a
;;; breakpoint, find the CODE-LOCATION for that breakpoint. Otherwise,
;;; make an :UNSURE code location, so it can be filled in when we
;;; figure out what is going on.
(defun code-location-from-pc (debug-fun pc escaped)
;;; DEBUG-FUN, and the pc into its code vector. If we stopped at a
;;; breakpoint, find the CODE-LOCATION for that breakpoint. Otherwise,
;;; make an :UNSURE code location, so it can be filled in when we
;;; figure out what is going on.
(defun code-location-from-pc (debug-fun pc escaped)
- (or (and (compiled-debug-function-p debug-fun)
+ (or (and (compiled-debug-fun-p debug-fun)
escaped
(let ((data (breakpoint-data
escaped
(let ((data (breakpoint-data
- (compiled-debug-function-component debug-fun)
+ (compiled-debug-fun-component debug-fun)
pc nil)))
(when (and data (breakpoint-data-breakpoints data))
(let ((what (breakpoint-what
pc nil)))
(when (and data (breakpoint-data-breakpoints data))
(let ((what (breakpoint-what
(sap-ref-32 catch (* sb!vm:catch-block-tag-slot
sb!vm:word-bytes)))
(make-compiled-code-location
(sap-ref-32 catch (* sb!vm:catch-block-tag-slot
sb!vm:word-bytes)))
(make-compiled-code-location
- offset (frame-debug-function frame)))
+ offset (frame-debug-fun frame)))
res)))
(setf catch
#!-alpha
res)))
(setf catch
#!-alpha
(* sb!vm:catch-block-previous-catch-slot
sb!vm:word-bytes)))))))
\f
(* sb!vm:catch-block-previous-catch-slot
sb!vm:word-bytes)))))))
\f
-;;;; operations on DEBUG-FUNCTIONs
+;;;; operations on DEBUG-FUNs
-;;; Execute the forms in a context with block-var bound to each
-;;; debug-block in debug-function successively. Result is an optional
-;;; form to execute for return values, and DO-DEBUG-FUNCTION-BLOCKS
+;;; Execute the forms in a context with BLOCK-VAR bound to each
+;;; DEBUG-BLOCK in DEBUG-FUN successively. Result is an optional
+;;; form to execute for return values, and DO-DEBUG-FUN-BLOCKS
;;; returns nil if there is no result form. This signals a
;;; returns nil if there is no result form. This signals a
-;;; no-debug-blocks condition when the debug-function lacks
-;;; debug-block information.
-(defmacro do-debug-function-blocks ((block-var debug-function &optional result)
- &body body)
+;;; NO-DEBUG-BLOCKS condition when the DEBUG-FUN lacks
+;;; DEBUG-BLOCK information.
+(defmacro do-debug-fun-blocks ((block-var debug-fun &optional result)
+ &body body)
(let ((blocks (gensym))
(i (gensym)))
(let ((blocks (gensym))
(i (gensym)))
- `(let ((,blocks (debug-function-debug-blocks ,debug-function)))
+ `(let ((,blocks (debug-fun-debug-blocks ,debug-fun)))
(declare (simple-vector ,blocks))
(dotimes (,i (length ,blocks) ,result)
(let ((,block-var (svref ,blocks ,i)))
,@body)))))
(declare (simple-vector ,blocks))
(dotimes (,i (length ,blocks) ,result)
(let ((,block-var (svref ,blocks ,i)))
,@body)))))
-;;; Execute body in a context with var bound to each debug-var in
-;;; debug-function. This returns the value of executing result (defaults to
-;;; nil). This may iterate over only some of debug-function's variables or none
-;;; depending on debug policy; for example, possibly the compilation only
-;;; preserved argument information.
-(defmacro do-debug-function-variables ((var debug-function &optional result)
+;;; Execute body in a context with VAR bound to each DEBUG-VAR in
+;;; DEBUG-FUN. This returns the value of executing result (defaults to
+;;; nil). This may iterate over only some of DEBUG-FUN's variables or
+;;; none depending on debug policy; for example, possibly the
+;;; compilation only preserved argument information.
+(defmacro do-debug-fun-variables ((var debug-fun &optional result)
&body body)
(let ((vars (gensym))
(i (gensym)))
&body body)
(let ((vars (gensym))
(i (gensym)))
- `(let ((,vars (debug-function-debug-vars ,debug-function)))
+ `(let ((,vars (debug-fun-debug-vars ,debug-fun)))
(declare (type (or null simple-vector) ,vars))
(if ,vars
(dotimes (,i (length ,vars) ,result)
(declare (type (or null simple-vector) ,vars))
(if ,vars
(dotimes (,i (length ,vars) ,result)
-;;; Return the Common Lisp function associated with the debug-function. This
-;;; returns nil if the function is unavailable or is non-existent as a user
+;;; Return the object of type FUNCTION associated with the DEBUG-FUN,
+;;; or NIL if the function is unavailable or is non-existent as a user
;;; callable function object.
;;; callable function object.
-(defun debug-function-function (debug-function)
- (let ((cached-value (debug-function-%function debug-function)))
+(defun debug-fun-fun (debug-fun)
+ (let ((cached-value (debug-fun-%function debug-fun)))
(if (eq cached-value :unparsed)
(if (eq cached-value :unparsed)
- (setf (debug-function-%function debug-function)
- (etypecase debug-function
- (compiled-debug-function
+ (setf (debug-fun-%function debug-fun)
+ (etypecase debug-fun
+ (compiled-debug-fun
- (compiled-debug-function-component debug-function))
+ (compiled-debug-fun-component debug-fun))
- (sb!c::compiled-debug-function-start-pc
- (compiled-debug-function-compiler-debug-fun
- debug-function))))
+ (sb!c::compiled-debug-fun-start-pc
+ (compiled-debug-fun-compiler-debug-fun debug-fun))))
(do ((entry (%code-entry-points component)
(%function-next entry)))
((null entry) nil)
(when (= start-pc
(do ((entry (%code-entry-points component)
(%function-next entry)))
((null entry) nil)
(when (= start-pc
- (sb!c::compiled-debug-function-start-pc
- (compiled-debug-function-compiler-debug-fun
- (function-debug-function entry))))
+ (sb!c::compiled-debug-fun-start-pc
+ (compiled-debug-fun-compiler-debug-fun
+ (fun-debug-fun entry))))
- (bogus-debug-function nil)))
+ (bogus-debug-fun nil)))
-;;; Return the name of the function represented by debug-function. This may
+;;; Return the name of the function represented by DEBUG-FUN. This may
;;; be a string or a cons; do not assume it is a symbol.
;;; be a string or a cons; do not assume it is a symbol.
-(defun debug-function-name (debug-function)
- (etypecase debug-function
- (compiled-debug-function
- (sb!c::compiled-debug-function-name
- (compiled-debug-function-compiler-debug-fun debug-function)))
- (bogus-debug-function
- (bogus-debug-function-%name debug-function))))
-
-;;; Return a debug-function that represents debug information for function.
-(defun function-debug-function (fun)
+(defun debug-fun-name (debug-fun)
+ (etypecase debug-fun
+ (compiled-debug-fun
+ (sb!c::compiled-debug-fun-name
+ (compiled-debug-fun-compiler-debug-fun debug-fun)))
+ (bogus-debug-fun
+ (bogus-debug-fun-%name debug-fun))))
+
+;;; Return a DEBUG-FUN that represents debug information for FUN.
+(defun fun-debug-fun (fun)
+ (declare (type function fun))
(ecase (get-type fun)
(#.sb!vm:closure-header-type
(ecase (get-type fun)
(#.sb!vm:closure-header-type
- (function-debug-function (%closure-function fun)))
+ (fun-debug-fun (%closure-function fun)))
(#.sb!vm:funcallable-instance-header-type
(#.sb!vm:funcallable-instance-header-type
- (function-debug-function (funcallable-instance-function fun)))
+ (fun-debug-fun (funcallable-instance-function fun)))
((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
(let* ((name (%function-name fun))
(component (function-code-header fun))
(res (find-if
(lambda (x)
((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
(let* ((name (%function-name fun))
(component (function-code-header fun))
(res (find-if
(lambda (x)
- (and (sb!c::compiled-debug-function-p x)
- (eq (sb!c::compiled-debug-function-name x) name)
- (eq (sb!c::compiled-debug-function-kind x) nil)))
+ (and (sb!c::compiled-debug-fun-p x)
+ (eq (sb!c::compiled-debug-fun-name x) name)
+ (eq (sb!c::compiled-debug-fun-kind x) nil)))
(get-debug-info-function-map
(%code-debug-info component)))))
(if res
(get-debug-info-function-map
(%code-debug-info component)))))
(if res
- (make-compiled-debug-function res component)
+ (make-compiled-debug-fun res component)
;; KLUDGE: comment from CMU CL:
;; This used to be the non-interpreted branch, but
;; William wrote it to return the debug-fun of fun's XEP
;; KLUDGE: comment from CMU CL:
;; This used to be the non-interpreted branch, but
;; William wrote it to return the debug-fun of fun's XEP
;; appropriate cases. It mostly works, and probably
;; works for all named functions anyway.
;; -- WHN 20000120
;; appropriate cases. It mostly works, and probably
;; works for all named functions anyway.
;; -- WHN 20000120
- (debug-function-from-pc component
- (* (- (function-word-offset fun)
- (get-header-data component))
- sb!vm:word-bytes)))))))
+ (debug-fun-from-pc component
+ (* (- (function-word-offset fun)
+ (get-header-data component))
+ sb!vm:word-bytes)))))))
;;; Return the kind of the function, which is one of :OPTIONAL,
;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL.
;;; Return the kind of the function, which is one of :OPTIONAL,
;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL.
-(defun debug-function-kind (debug-function)
+(defun debug-fun-kind (debug-fun)
;; FIXME: This "is one of" information should become part of the function
;; declamation, not just a doc string
;; FIXME: This "is one of" information should become part of the function
;; declamation, not just a doc string
- (etypecase debug-function
- (compiled-debug-function
- (sb!c::compiled-debug-function-kind
- (compiled-debug-function-compiler-debug-fun debug-function)))
- (bogus-debug-function
+ (etypecase debug-fun
+ (compiled-debug-fun
+ (sb!c::compiled-debug-fun-kind
+ (compiled-debug-fun-compiler-debug-fun debug-fun)))
+ (bogus-debug-fun
-;;; Is there any variable information for DEBUG-FUNCTION?
-(defun debug-var-info-available (debug-function)
- (not (not (debug-function-debug-vars debug-function))))
+;;; Is there any variable information for DEBUG-FUN?
+(defun debug-var-info-available (debug-fun)
+ (not (not (debug-fun-debug-vars debug-fun))))
-;;; Return a list of debug-vars in debug-function having the same name
-;;; and package as symbol. If symbol is uninterned, then this returns
-;;; a list of debug-vars without package names and with the same name
+;;; Return a list of DEBUG-VARs in DEBUG-FUN having the same name
+;;; and package as SYMBOL. If SYMBOL is uninterned, then this returns
+;;; a list of DEBUG-VARs without package names and with the same name
;;; as symbol. The result of this function is limited to the
;;; as symbol. The result of this function is limited to the
-;;; availability of variable information in debug-function; for
-;;; example, possibly DEBUG-FUNCTION only knows about its arguments.
-(defun debug-function-symbol-variables (debug-function symbol)
- (let ((vars (ambiguous-debug-vars debug-function (symbol-name symbol)))
+;;; availability of variable information in DEBUG-FUN; for
+;;; example, possibly DEBUG-FUN only knows about its arguments.
+(defun debug-fun-symbol-variables (debug-fun symbol)
+ (let ((vars (ambiguous-debug-vars debug-fun (symbol-name symbol)))
(package (and (symbol-package symbol)
(package-name (symbol-package symbol)))))
(delete-if (if (stringp package)
(package (and (symbol-package symbol)
(package-name (symbol-package symbol)))))
(delete-if (if (stringp package)
(stringp (debug-var-package-name var))))
vars)))
(stringp (debug-var-package-name var))))
vars)))
-;;; Return a list of debug-vars in debug-function whose names contain
-;;; name-prefix-string as an intial substring. The result of this
+;;; Return a list of DEBUG-VARs in DEBUG-FUN whose names contain
+;;; NAME-PREFIX-STRING as an initial substring. The result of this
;;; function is limited to the availability of variable information in
;;; function is limited to the availability of variable information in
-;;; debug-function; for example, possibly debug-function only knows
+;;; debug-fun; for example, possibly debug-fun only knows
-(defun ambiguous-debug-vars (debug-function name-prefix-string)
+(defun ambiguous-debug-vars (debug-fun name-prefix-string)
(declare (simple-string name-prefix-string))
(declare (simple-string name-prefix-string))
- (let ((variables (debug-function-debug-vars debug-function)))
+ (let ((variables (debug-fun-debug-vars debug-fun)))
(declare (type (or null simple-vector) variables))
(if variables
(let* ((len (length variables))
(declare (type (or null simple-vector) variables))
(if variables
(let* ((len (length variables))
(string= x y :end1 name-len :end2 name-len))))
:end (or end (length variables)))))
(string= x y :end1 name-len :end2 name-len))))
:end (or end (length variables)))))
-;;; Return a list representing the lambda-list for DEBUG-FUNCTION. The
+;;; Return a list representing the lambda-list for DEBUG-FUN. The
;;; list has the following structure:
;;; (required-var1 required-var2
;;; ...
;;; list has the following structure:
;;; (required-var1 required-var2
;;; ...
;;; ...
;;; )
;;; Each VARi is a DEBUG-VAR; however it may be the symbol :DELETED if
;;; ...
;;; )
;;; Each VARi is a DEBUG-VAR; however it may be the symbol :DELETED if
-;;; it is unreferenced in DEBUG-FUNCTION. This signals a
+;;; it is unreferenced in DEBUG-FUN. This signals a
;;; LAMBDA-LIST-UNAVAILABLE condition when there is no argument list
;;; information.
;;; LAMBDA-LIST-UNAVAILABLE condition when there is no argument list
;;; information.
-(defun debug-function-lambda-list (debug-function)
- (etypecase debug-function
- (compiled-debug-function
- (compiled-debug-function-lambda-list debug-function))
- (bogus-debug-function
- nil)))
+(defun debug-fun-lambda-list (debug-fun)
+ (etypecase debug-fun
+ (compiled-debug-fun (compiled-debug-fun-lambda-list debug-fun))
+ (bogus-debug-fun nil)))
;;; Note: If this has to compute the lambda list, it caches it in
;;; Note: If this has to compute the lambda list, it caches it in
-;;; DEBUG-FUNCTION.
-(defun compiled-debug-function-lambda-list (debug-function)
- (let ((lambda-list (debug-function-%lambda-list debug-function)))
+;;; DEBUG-FUN.
+(defun compiled-debug-fun-lambda-list (debug-fun)
+ (let ((lambda-list (debug-fun-%lambda-list debug-fun)))
(cond ((eq lambda-list :unparsed)
(multiple-value-bind (args argsp)
(cond ((eq lambda-list :unparsed)
(multiple-value-bind (args argsp)
- (parse-compiled-debug-function-lambda-list debug-function)
- (setf (debug-function-%lambda-list debug-function) args)
+ (parse-compiled-debug-fun-lambda-list debug-fun)
+ (setf (debug-fun-%lambda-list debug-fun) args)
(if argsp
args
(debug-signal 'lambda-list-unavailable
(if argsp
args
(debug-signal 'lambda-list-unavailable
- :debug-function debug-function))))
+ :debug-fun debug-fun))))
- ((bogus-debug-function-p debug-function)
+ ((bogus-debug-fun-p debug-fun)
- ((sb!c::compiled-debug-function-arguments
- (compiled-debug-function-compiler-debug-fun
- debug-function))
+ ((sb!c::compiled-debug-fun-arguments
+ (compiled-debug-fun-compiler-debug-fun debug-fun))
;; If the packed information is there (whether empty or not) as
;; opposed to being nil, then returned our cached value (nil).
nil)
;; If the packed information is there (whether empty or not) as
;; opposed to being nil, then returned our cached value (nil).
nil)
;; Our cached value is nil, and the packed lambda-list information
;; is nil, so we don't have anything available.
(debug-signal 'lambda-list-unavailable
;; Our cached value is nil, and the packed lambda-list information
;; is nil, so we don't have anything available.
(debug-signal 'lambda-list-unavailable
- :debug-function debug-function)))))
-
-;;; COMPILED-DEBUG-FUNCTION-LAMBDA-LIST calls this when a
-;;; compiled-debug-function has no lambda-list information cached. It
-;;; returns the lambda-list as the first value and whether there was
-;;; any argument information as the second value. Therefore, nil and t
-;;; means there were no arguments, but nil and nil means there was no
-;;; argument information.
-(defun parse-compiled-debug-function-lambda-list (debug-function)
- (let ((args (sb!c::compiled-debug-function-arguments
- (compiled-debug-function-compiler-debug-fun
- debug-function))))
+ :debug-fun debug-fun)))))
+
+;;; COMPILED-DEBUG-FUN-LAMBDA-LIST calls this when a
+;;; COMPILED-DEBUG-FUN has no lambda list information cached. It
+;;; returns the lambda list as the first value and whether there was
+;;; any argument information as the second value. Therefore,
+;;; (VALUES NIL T) means there were no arguments, but (VALUES NIL NIL)
+;;; means there was no argument information.
+(defun parse-compiled-debug-fun-lambda-list (debug-fun)
+ (let ((args (sb!c::compiled-debug-fun-arguments
+ (compiled-debug-fun-compiler-debug-fun debug-fun))))
(cond
((not args)
(values nil nil))
((eq args :minimal)
(cond
((not args)
(values nil nil))
((eq args :minimal)
- (values (coerce (debug-function-debug-vars debug-function) 'list)
+ (values (coerce (debug-fun-debug-vars debug-fun) 'list)
- (let ((vars (debug-function-debug-vars debug-function))
+ (let ((vars (debug-fun-debug-vars debug-fun))
(i 0)
(len (length args))
(res nil)
(i 0)
(len (length args))
(res nil)
;; element representing the keyword or optional,
;; which is the previous one.
(nconc (car res)
;; element representing the keyword or optional,
;; which is the previous one.
(nconc (car res)
- (list (compiled-debug-function-lambda-list-var
+ (list (compiled-debug-fun-lambda-list-var
args (incf i) vars))))
(sb!c::rest-arg
(push (list :rest
args (incf i) vars))))
(sb!c::rest-arg
(push (list :rest
- (compiled-debug-function-lambda-list-var
+ (compiled-debug-fun-lambda-list-var
args (incf i) vars))
res))
(sb!c::more-arg
args (incf i) vars))
res))
(sb!c::more-arg
;; &KEY arg
(push (list :keyword
ele
;; &KEY arg
(push (list :keyword
ele
- (compiled-debug-function-lambda-list-var
+ (compiled-debug-fun-lambda-list-var
args (incf i) vars))
res))))
(optionalp
args (incf i) vars))
res))))
(optionalp
(incf i))
(values (nreverse res) t))))))
(incf i))
(values (nreverse res) t))))))
-;;; This is used in COMPILED-DEBUG-FUNCTION-LAMBDA-LIST.
-(defun compiled-debug-function-lambda-list-var (args i vars)
+;;; This is used in COMPILED-DEBUG-FUN-LAMBDA-LIST.
+(defun compiled-debug-fun-lambda-list-var (args i vars)
(declare (type (simple-array * (*)) args)
(simple-vector vars))
(let ((ele (aref args i)))
(declare (type (simple-array * (*)) args)
(simple-vector vars))
(let ((ele (aref args i)))
((eq ele 'sb!c::deleted) :deleted)
(t (error "malformed arguments description")))))
((eq ele 'sb!c::deleted) :deleted)
(t (error "malformed arguments description")))))
-(defun compiled-debug-function-debug-info (debug-fun)
- (%code-debug-info (compiled-debug-function-component debug-fun)))
+(defun compiled-debug-fun-debug-info (debug-fun)
+ (%code-debug-info (compiled-debug-fun-component debug-fun)))
\f
;;;; unpacking variable and basic block data
\f
;;;; unpacking variable and basic block data
) ; EVAL-WHEN
;;; The argument is a debug internals structure. This returns the
) ; EVAL-WHEN
;;; The argument is a debug internals structure. This returns the
-;;; debug-blocks for debug-function, regardless of whether we have
-;;; unpacked them yet. It signals a no-debug-blocks condition if it
-;;; can't return the blocks.
-(defun debug-function-debug-blocks (debug-function)
- (let ((blocks (debug-function-blocks debug-function)))
+;;; DEBUG-BLOCKs for DEBUG-FUN, regardless of whether we have unpacked
+;;; them yet. It signals a NO-DEBUG-BLOCKS condition if it can't
+;;; return the blocks.
+(defun debug-fun-debug-blocks (debug-fun)
+ (let ((blocks (debug-fun-blocks debug-fun)))
(cond ((eq blocks :unparsed)
(cond ((eq blocks :unparsed)
- (setf (debug-function-blocks debug-function)
- (parse-debug-blocks debug-function))
- (unless (debug-function-blocks debug-function)
+ (setf (debug-fun-blocks debug-fun)
+ (parse-debug-blocks debug-fun))
+ (unless (debug-fun-blocks debug-fun)
(debug-signal 'no-debug-blocks
(debug-signal 'no-debug-blocks
- :debug-function debug-function))
- (debug-function-blocks debug-function))
+ :debug-fun debug-fun))
+ (debug-fun-blocks debug-fun))
(blocks)
(t
(debug-signal 'no-debug-blocks
(blocks)
(t
(debug-signal 'no-debug-blocks
- :debug-function debug-function)))))
+ :debug-fun debug-fun)))))
;;; This returns a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates
;;; there was no basic block information.
;;; This returns a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates
;;; there was no basic block information.
-(defun parse-debug-blocks (debug-function)
- (etypecase debug-function
- (compiled-debug-function
- (parse-compiled-debug-blocks debug-function))
- (bogus-debug-function
- (debug-signal 'no-debug-blocks :debug-function debug-function))))
+(defun parse-debug-blocks (debug-fun)
+ (etypecase debug-fun
+ (compiled-debug-fun
+ (parse-compiled-debug-blocks debug-fun))
+ (bogus-debug-fun
+ (debug-signal 'no-debug-blocks :debug-fun debug-fun))))
;;; This does some of the work of PARSE-DEBUG-BLOCKS.
;;; This does some of the work of PARSE-DEBUG-BLOCKS.
-(defun parse-compiled-debug-blocks (debug-function)
- (let* ((debug-fun (compiled-debug-function-compiler-debug-fun
- debug-function))
- (var-count (length (debug-function-debug-vars debug-function)))
- (blocks (sb!c::compiled-debug-function-blocks debug-fun))
+(defun parse-compiled-debug-blocks (debug-fun)
+ (let* ((debug-fun (compiled-debug-fun-compiler-debug-fun
+ debug-fun))
+ (var-count (length (debug-fun-debug-vars debug-fun)))
+ (blocks (sb!c::compiled-debug-fun-blocks debug-fun))
;; KLUDGE: 8 is a hard-wired constant in the compiler for the
;; element size of the packed binary representation of the
;; blocks data.
(live-set-len (ceiling var-count 8))
;; KLUDGE: 8 is a hard-wired constant in the compiler for the
;; element size of the packed binary representation of the
;; blocks data.
(live-set-len (ceiling var-count 8))
- (tlf-number (sb!c::compiled-debug-function-tlf-number debug-fun)))
+ (tlf-number (sb!c::compiled-debug-fun-tlf-number debug-fun)))
(unless blocks (return-from parse-compiled-debug-blocks nil))
(macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
(with-parsing-buffer (blocks-buffer locations-buffer)
(unless blocks (return-from parse-compiled-debug-blocks nil))
(macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
(with-parsing-buffer (blocks-buffer locations-buffer)
(live-set (sb!c::read-packed-bit-vector
live-set-len blocks i)))
(vector-push-extend (make-known-code-location
(live-set (sb!c::read-packed-bit-vector
live-set-len blocks i)))
(vector-push-extend (make-known-code-location
- pc debug-function tlf-offset
+ pc debug-fun tlf-offset
form-number live-set kind)
locations-buffer)
(setf last-pc pc))))
form-number live-set kind)
locations-buffer)
(setf last-pc pc))))
;;; there is no variable information. It returns an empty
;;; simple-vector if there were no locals in the function. Otherwise
;;; it returns a SIMPLE-VECTOR of DEBUG-VARs.
;;; there is no variable information. It returns an empty
;;; simple-vector if there were no locals in the function. Otherwise
;;; it returns a SIMPLE-VECTOR of DEBUG-VARs.
-(defun debug-function-debug-vars (debug-function)
- (let ((vars (debug-function-%debug-vars debug-function)))
+(defun debug-fun-debug-vars (debug-fun)
+ (let ((vars (debug-fun-%debug-vars debug-fun)))
- (setf (debug-function-%debug-vars debug-function)
- (etypecase debug-function
- (compiled-debug-function
- (parse-compiled-debug-vars debug-function))
- (bogus-debug-function nil)))
+ (setf (debug-fun-%debug-vars debug-fun)
+ (etypecase debug-fun
+ (compiled-debug-fun
+ (parse-compiled-debug-vars debug-fun))
+ (bogus-debug-fun nil)))
vars)))
;;; VARS is the parsed variables for a minimal debug function. We need
vars)))
;;; VARS is the parsed variables for a minimal debug function. We need
(find-package "SB!DEBUG")))))))
;;; Parse the packed representation of DEBUG-VARs from
(find-package "SB!DEBUG")))))))
;;; Parse the packed representation of DEBUG-VARs from
-;;; DEBUG-FUNCTION's SB!C::COMPILED-DEBUG-FUNCTION, returning a vector
+;;; DEBUG-FUN's SB!C::COMPILED-DEBUG-FUN, returning a vector
;;; of DEBUG-VARs, or NIL if there was no information to parse.
;;; of DEBUG-VARs, or NIL if there was no information to parse.
-(defun parse-compiled-debug-vars (debug-function)
- (let* ((cdebug-fun (compiled-debug-function-compiler-debug-fun
- debug-function))
- (packed-vars (sb!c::compiled-debug-function-variables cdebug-fun))
- (args-minimal (eq (sb!c::compiled-debug-function-arguments cdebug-fun)
+(defun parse-compiled-debug-vars (debug-fun)
+ (let* ((cdebug-fun (compiled-debug-fun-compiler-debug-fun
+ debug-fun))
+ (packed-vars (sb!c::compiled-debug-fun-variables cdebug-fun))
+ (args-minimal (eq (sb!c::compiled-debug-fun-arguments cdebug-fun)
:minimal)))
(when packed-vars
(do ((i 0)
:minimal)))
(when packed-vars
(do ((i 0)
;;; sleazoid "macro" to keep our indentation sane in UNCOMPACT-FUNCTION-MAP
(sb!xc:defmacro make-uncompacted-debug-fun ()
;;; sleazoid "macro" to keep our indentation sane in UNCOMPACT-FUNCTION-MAP
(sb!xc:defmacro make-uncompacted-debug-fun ()
- '(sb!c::make-compiled-debug-function
+ '(sb!c::make-compiled-debug-fun
- (let ((base (ecase (ldb sb!c::minimal-debug-function-name-style-byte
+ (let ((base (ecase (ldb sb!c::minimal-debug-fun-name-style-byte
- (#.sb!c::minimal-debug-function-name-symbol
+ (#.sb!c::minimal-debug-fun-name-symbol
(intern (sb!c::read-var-string map i)
(sb!c::compiled-debug-info-package info)))
(intern (sb!c::read-var-string map i)
(sb!c::compiled-debug-info-package info)))
- (#.sb!c::minimal-debug-function-name-packaged
+ (#.sb!c::minimal-debug-fun-name-packaged
(let ((pkg (sb!c::read-var-string map i)))
(intern (sb!c::read-var-string map i) pkg)))
(let ((pkg (sb!c::read-var-string map i)))
(intern (sb!c::read-var-string map i) pkg)))
- (#.sb!c::minimal-debug-function-name-uninterned
+ (#.sb!c::minimal-debug-fun-name-uninterned
(make-symbol (sb!c::read-var-string map i)))
(make-symbol (sb!c::read-var-string map i)))
- (#.sb!c::minimal-debug-function-name-component
+ (#.sb!c::minimal-debug-fun-name-component
(sb!c::compiled-debug-info-name info)))))
(sb!c::compiled-debug-info-name info)))))
- (if (logtest flags sb!c::minimal-debug-function-setf-bit)
+ (if (logtest flags sb!c::minimal-debug-fun-setf-bit)
- :kind (svref sb!c::*minimal-debug-function-kinds*
- (ldb sb!c::minimal-debug-function-kind-byte options))
+ :kind (svref sb!c::*minimal-debug-fun-kinds*
+ (ldb sb!c::minimal-debug-fun-kind-byte options))
:variables
(when vars-p
(let ((len (sb!c::read-var-integer map i)))
:variables
(when vars-p
(let ((len (sb!c::read-var-integer map i)))
(incf i len))))
:arguments (when vars-p :minimal)
:returns
(incf i len))))
:arguments (when vars-p :minimal)
:returns
- (ecase (ldb sb!c::minimal-debug-function-returns-byte options)
- (#.sb!c::minimal-debug-function-returns-standard
+ (ecase (ldb sb!c::minimal-debug-fun-returns-byte options)
+ (#.sb!c::minimal-debug-fun-returns-standard
- (#.sb!c::minimal-debug-function-returns-fixed
+ (#.sb!c::minimal-debug-fun-returns-fixed
- (#.sb!c::minimal-debug-function-returns-specified
+ (#.sb!c::minimal-debug-fun-returns-specified
(with-parsing-buffer (buf)
(dotimes (idx (sb!c::read-var-integer map i))
(vector-push-extend (sb!c::read-var-integer map i) buf))
(result buf))))
:return-pc (sb!c::read-var-integer map i)
:old-fp (sb!c::read-var-integer map i)
(with-parsing-buffer (buf)
(dotimes (idx (sb!c::read-var-integer map i))
(vector-push-extend (sb!c::read-var-integer map i) buf))
(result buf))))
:return-pc (sb!c::read-var-integer map i)
:old-fp (sb!c::read-var-integer map i)
- :nfp (when (logtest flags sb!c::minimal-debug-function-nfp-bit)
+ :nfp (when (logtest flags sb!c::minimal-debug-fun-nfp-bit)
(sb!c::read-var-integer map i))
:start-pc
(progn
(sb!c::read-var-integer map i))
:start-pc
(progn
) ; EVAL-WHEN
;;; Return a normal function map derived from a minimal debug info
) ; EVAL-WHEN
;;; Return a normal function map derived from a minimal debug info
-;;; function map. This involves looping parsing
-;;; minimal-debug-functions and then building a vector out of them.
+;;; function map. This involves looping parsing MINIMAL-DEBUG-FUNs and
+;;; then building a vector out of them.
;;;
;;; FIXME: This and its helper macro just above become dead code now
;;; that we no longer use compacted function maps.
;;;
;;; FIXME: This and its helper macro just above become dead code now
;;; that we no longer use compacted function maps.
(let* ((options (prog1 (aref map i) (incf i)))
(flags (prog1 (aref map i) (incf i)))
(vars-p (logtest flags
(let* ((options (prog1 (aref map i) (incf i)))
(flags (prog1 (aref map i) (incf i)))
(vars-p (logtest flags
- sb!c::minimal-debug-function-variables-bit))
+ sb!c::minimal-debug-fun-variables-bit))
(dfun (make-uncompacted-debug-fun)))
(res code-start-pc)
(res dfun)))
(dfun (make-uncompacted-debug-fun)))
(res code-start-pc)
(res dfun)))
;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
;;; the info is minimal, and has not been parsed, then parse it.
;;;
;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
;;; the info is minimal, and has not been parsed, then parse it.
;;;
-;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUNCTION
+;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUN
;;; representation, calls to this function can be replaced by calls to
;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
;;; and this function and everything it calls become dead code which
;;; representation, calls to this function can be replaced by calls to
;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
;;; and this function and everything it calls become dead code which
;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
;;; the correct one using the code-location's pc. We use
;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
;;; the correct one using the code-location's pc. We use
-;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
+;;; DEBUG-FUN-DEBUG-BLOCKS to return the cached block information
;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by
;;; their first code-location's pc, in ascending order. Therefore, as
;;; soon as we find a block that starts with a pc greater than
;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by
;;; their first code-location's pc, in ascending order. Therefore, as
;;; soon as we find a block that starts with a pc greater than
;;; code first in order to see how to compare the code-location's pc.
(defun compute-compiled-code-location-debug-block (basic-code-location)
(let* ((pc (compiled-code-location-pc basic-code-location))
;;; code first in order to see how to compare the code-location's pc.
(defun compute-compiled-code-location-debug-block (basic-code-location)
(let* ((pc (compiled-code-location-pc basic-code-location))
- (debug-function (code-location-debug-function
+ (debug-fun (code-location-debug-fun
- (blocks (debug-function-debug-blocks debug-function))
+ (blocks (debug-fun-debug-blocks debug-fun))
(len (length blocks)))
(declare (simple-vector blocks))
(setf (code-location-%debug-block basic-code-location)
(len (length blocks)))
(declare (simple-vector blocks))
(setf (code-location-%debug-block basic-code-location)
(cond
((debug-block-elsewhere-p last)
(if (< pc
(cond
((debug-block-elsewhere-p last)
(if (< pc
- (sb!c::compiled-debug-function-elsewhere-pc
- (compiled-debug-function-compiler-debug-fun
- debug-function)))
+ (sb!c::compiled-debug-fun-elsewhere-pc
+ (compiled-debug-fun-compiler-debug-fun
+ debug-fun)))
(svref blocks (1- end))
last))
((< pc
(svref blocks (1- end))
last))
((< pc
(defun code-location-debug-source (code-location)
(etypecase code-location
(compiled-code-location
(defun code-location-debug-source (code-location)
(etypecase code-location
(compiled-code-location
- (let* ((info (compiled-debug-function-debug-info
- (code-location-debug-function code-location)))
+ (let* ((info (compiled-debug-fun-debug-info
+ (code-location-debug-fun code-location)))
(sources (sb!c::compiled-debug-info-source info))
(len (length sources)))
(declare (list sources))
(when (zerop len)
(sources (sb!c::compiled-debug-info-source info))
(len (length sources)))
(declare (list sources))
(when (zerop len)
- (debug-signal 'no-debug-blocks :debug-function
- (code-location-debug-function code-location)))
+ (debug-signal 'no-debug-blocks :debug-fun
+ (code-location-debug-fun code-location)))
(if (= len 1)
(car sources)
(do ((prev sources src)
(if (= len 1)
(car sources)
(do ((prev sources src)
(compiled-code-location
(etypecase obj2
(compiled-code-location
(compiled-code-location
(etypecase obj2
(compiled-code-location
- (and (eq (code-location-debug-function obj1)
- (code-location-debug-function obj2))
+ (and (eq (code-location-debug-fun obj1)
+ (code-location-debug-fun obj2))
(sub-compiled-code-location= obj1 obj2)))
;; (There used to be more cases back before sbcl-0.7.0,,
;; when we did special tricks to debug the IR1
(sub-compiled-code-location= obj1 obj2)))
;; (There used to be more cases back before sbcl-0.7.0,,
;; when we did special tricks to debug the IR1
;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL
;;; depending on whether the code-location was known in its
;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL
;;; depending on whether the code-location was known in its
-;;; debug-function's debug-block information. This may signal a
-;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
+;;; DEBUG-FUN's debug-block information. This may signal a
+;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUN-DEBUG-BLOCKS, and
;;; it assumes the %UNKNOWN-P slot is already set or going to be set.
(defun fill-in-code-location (code-location)
(declare (type compiled-code-location code-location))
;;; it assumes the %UNKNOWN-P slot is already set or going to be set.
(defun fill-in-code-location (code-location)
(declare (type compiled-code-location code-location))
- (let* ((debug-function (code-location-debug-function code-location))
- (blocks (debug-function-debug-blocks debug-function)))
+ (let* ((debug-fun (code-location-debug-fun code-location))
+ (blocks (debug-fun-debug-blocks debug-fun)))
(declare (simple-vector blocks))
(dotimes (i (length blocks) nil)
(let* ((block (svref blocks i))
(declare (simple-vector blocks))
(dotimes (i (length blocks) nil)
(let* ((block (svref blocks i))
(let ((,code-var (svref ,code-locations ,i)))
,@body)))))
(let ((,code-var (svref ,code-locations ,i)))
,@body)))))
-;;; Return the name of the function represented by DEBUG-FUNCTION.
+;;; Return the name of the function represented by DEBUG-FUN.
;;; This may be a string or a cons; do not assume it is a symbol.
(defun debug-block-function-name (debug-block)
(etypecase debug-block
;;; This may be a string or a cons; do not assume it is a symbol.
(defun debug-block-function-name (debug-block)
(etypecase debug-block
(declare (simple-vector code-locs))
(if (zerop (length code-locs))
"??? Can't get name of debug-block's function."
(declare (simple-vector code-locs))
(if (zerop (length code-locs))
"??? Can't get name of debug-block's function."
- (debug-function-name
- (code-location-debug-function (svref code-locs 0))))))
+ (debug-fun-name
+ (code-location-debug-fun (svref code-locs 0))))))
;; (There used to be more cases back before sbcl-0.7.0, when we
;; did special tricks to debug the IR1 interpreter.)
))
;; (There used to be more cases back before sbcl-0.7.0, when we
;; did special tricks to debug the IR1 interpreter.)
))
(defun compiled-debug-var-validity (debug-var basic-code-location)
(declare (type compiled-code-location basic-code-location))
(cond ((debug-var-alive-p debug-var)
(defun compiled-debug-var-validity (debug-var basic-code-location)
(declare (type compiled-code-location basic-code-location))
(cond ((debug-var-alive-p debug-var)
- (let ((debug-fun (code-location-debug-function basic-code-location)))
+ (let ((debug-fun (code-location-debug-fun basic-code-location)))
(if (>= (compiled-code-location-pc basic-code-location)
(if (>= (compiled-code-location-pc basic-code-location)
- (sb!c::compiled-debug-function-start-pc
- (compiled-debug-function-compiler-debug-fun debug-fun)))
+ (sb!c::compiled-debug-fun-start-pc
+ (compiled-debug-fun-compiler-debug-fun debug-fun)))
:valid
:invalid)))
((code-location-unknown-p basic-code-location) :unknown)
(t
(let ((pos (position debug-var
:valid
:invalid)))
((code-location-unknown-p basic-code-location) :unknown)
(t
(let ((pos (position debug-var
- (debug-function-debug-vars
- (code-location-debug-function
+ (debug-fun-debug-vars
+ (code-location-debug-fun
basic-code-location)))))
(unless pos
(error 'unknown-debug-var
:debug-var debug-var
basic-code-location)))))
(unless pos
(error 'unknown-debug-var
:debug-var debug-var
- :debug-function
- (code-location-debug-function basic-code-location)))
+ :debug-fun
+ (code-location-debug-fun basic-code-location)))
;; There must be live-set info since basic-code-location is known.
(if (zerop (sbit (compiled-code-location-live-set
basic-code-location)
;; There must be live-set info since basic-code-location is known.
(if (zerop (sbit (compiled-code-location-live-set
basic-code-location)
;;; Return a function of one argument that evaluates form in the
;;; lexical context of the BASIC-CODE-LOCATION LOC, or signal a
;;; Return a function of one argument that evaluates form in the
;;; lexical context of the BASIC-CODE-LOCATION LOC, or signal a
-;;; NO-DEBUG-VARS condition when the LOC's DEBUG-FUNCTION has no
+;;; NO-DEBUG-VARS condition when the LOC's DEBUG-FUN has no
;;; DEBUG-VAR information available.
;;;
;;; The returned function takes the frame to get values from as its
;;; argument, and it returns the values of FORM. The returned function
;;; can signal the following conditions: INVALID-VALUE,
;;; DEBUG-VAR information available.
;;;
;;; The returned function takes the frame to get values from as its
;;; argument, and it returns the values of FORM. The returned function
;;; can signal the following conditions: INVALID-VALUE,
-;;; AMBIGUOUS-VARIABLE-NAME, and FRAME-FUNCTION-MISMATCH.
+;;; AMBIGUOUS-VARIABLE-NAME, and FRAME-FUN-MISMATCH.
(defun preprocess-for-eval (form loc)
(declare (type code-location loc))
(let ((n-frame (gensym))
(defun preprocess-for-eval (form loc)
(declare (type code-location loc))
(let ((n-frame (gensym))
- (fun (code-location-debug-function loc)))
+ (fun (code-location-debug-fun loc)))
(unless (debug-var-info-available fun)
(unless (debug-var-info-available fun)
- (debug-signal 'no-debug-vars :debug-function fun))
+ (debug-signal 'no-debug-vars :debug-fun fun))
(sb!int:collect ((binds)
(specs))
(sb!int:collect ((binds)
(specs))
- (do-debug-function-variables (var fun)
+ (do-debug-fun-variables (var fun)
(let ((validity (debug-var-validity var loc)))
(unless (eq validity :invalid)
(let* ((sym (debug-var-symbol var))
(let ((validity (debug-var-validity var loc)))
(unless (eq validity :invalid)
(let* ((sym (debug-var-symbol var))
;; This prevents these functions from being used in any
;; location other than a function return location, so
;; maybe this should only check whether frame's
;; This prevents these functions from being used in any
;; location other than a function return location, so
;; maybe this should only check whether frame's
- ;; debug-function is the same as loc's.
+ ;; DEBUG-FUN is the same as loc's.
(unless (code-location= (frame-code-location frame) loc)
(unless (code-location= (frame-code-location frame) loc)
- (debug-signal 'frame-function-mismatch
+ (debug-signal 'frame-fun-mismatch
:code-location loc :form form :frame frame))
(funcall res frame))))))
\f
:code-location loc :form form :frame frame))
(funcall res frame))))))
\f
;;; breakpoint object.
;;;
;;; WHAT and KIND determine where in a function the system invokes
;;; breakpoint object.
;;;
;;; WHAT and KIND determine where in a function the system invokes
-;;; HOOK-FUNCTION. WHAT is either a code-location or a debug-function.
+;;; HOOK-FUNCTION. WHAT is either a code-location or a DEBUG-FUN.
;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
;;; Since the starts and ends of functions may not have code-locations
;;; representing them, designate these places by supplying WHAT as a
;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
;;; Since the starts and ends of functions may not have code-locations
;;; representing them, designate these places by supplying WHAT as a
-;;; debug-function and KIND indicating the :FUNCTION-START or
-;;; :FUNCTION-END. When WHAT is a debug-function and kind is
+;;; DEBUG-FUN and KIND indicating the :FUNCTION-START or
+;;; :FUNCTION-END. When WHAT is a DEBUG-FUN and kind is
;;; :FUNCTION-END, then hook-function must take two additional
;;; arguments, a list of values returned by the function and a
;;; FUNCTION-END-COOKIE.
;;; :FUNCTION-END, then hook-function must take two additional
;;; arguments, a list of values returned by the function and a
;;; FUNCTION-END-COOKIE.
- (compiled-debug-function
(ecase kind
(:function-start
(%make-breakpoint hook-function what kind info))
(:function-end
(ecase kind
(:function-start
(%make-breakpoint hook-function what kind info))
(:function-end
- (unless (eq (sb!c::compiled-debug-function-returns
- (compiled-debug-function-compiler-debug-fun what))
+ (unless (eq (sb!c::compiled-debug-fun-returns
+ (compiled-debug-fun-compiler-debug-fun what))
:standard)
(error ":FUNCTION-END breakpoints are currently unsupported ~
for the known return convention."))
(let* ((bpt (%make-breakpoint hook-function what kind info))
:standard)
(error ":FUNCTION-END breakpoints are currently unsupported ~
for the known return convention."))
(let* ((bpt (%make-breakpoint hook-function what kind info))
- (starter (compiled-debug-function-end-starter what)))
+ (starter (compiled-debug-fun-end-starter what)))
(unless starter
(setf starter (%make-breakpoint #'list what :function-start nil))
(setf (breakpoint-hook-function starter)
(function-end-starter-hook starter what))
(unless starter
(setf starter (%make-breakpoint #'list what :function-start nil))
(setf (breakpoint-hook-function starter)
(function-end-starter-hook starter what))
- (setf (compiled-debug-function-end-starter what) starter))
+ (setf (compiled-debug-fun-end-starter what) starter))
(setf (breakpoint-start-helper bpt) starter)
(push bpt (breakpoint-%info starter))
(setf (breakpoint-cookie-fun bpt) function-end-cookie)
(setf (breakpoint-start-helper bpt) starter)
(push bpt (breakpoint-%info starter))
(setf (breakpoint-cookie-fun bpt) function-end-cookie)
(:copier nil))
;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints
bogus-lra
(:copier nil))
;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints
bogus-lra
- ;; the debug-function associated with the cookie
+ ;; the DEBUG-FUN associated with this cookie
debug-fun)
;;; This maps bogus-lra-components to cookies, so that
debug-fun)
;;; This maps bogus-lra-components to cookies, so that
;;; function, we must establish breakpoint-data about FUN-END-BPT.
(defun function-end-starter-hook (starter-bpt debug-fun)
(declare (type breakpoint starter-bpt)
;;; function, we must establish breakpoint-data about FUN-END-BPT.
(defun function-end-starter-hook (starter-bpt debug-fun)
(declare (type breakpoint starter-bpt)
- (type compiled-debug-function debug-fun))
+ (type compiled-debug-fun debug-fun))
#'(lambda (frame breakpoint)
(declare (ignore breakpoint)
(type frame frame))
(let ((lra-sc-offset
#'(lambda (frame breakpoint)
(declare (ignore breakpoint)
(type frame frame))
(let ((lra-sc-offset
- (sb!c::compiled-debug-function-return-pc
- (compiled-debug-function-compiler-debug-fun debug-fun))))
+ (sb!c::compiled-debug-fun-return-pc
+ (compiled-debug-fun-compiler-debug-fun debug-fun))))
(multiple-value-bind (lra component offset)
(make-bogus-lra
(get-context-value frame
(multiple-value-bind (lra component offset)
(make-bogus-lra
(get-context-value frame
;;; series of cookies is valid.
(defun function-end-cookie-valid-p (frame cookie)
(let ((lra (function-end-cookie-bogus-lra cookie))
;;; series of cookies is valid.
(defun function-end-cookie-valid-p (frame cookie)
(let ((lra (function-end-cookie-bogus-lra cookie))
- (lra-sc-offset (sb!c::compiled-debug-function-return-pc
- (compiled-debug-function-compiler-debug-fun
+ (lra-sc-offset (sb!c::compiled-debug-fun-return-pc
+ (compiled-debug-fun-compiler-debug-fun
(function-end-cookie-debug-fun cookie)))))
(do ((frame frame (frame-down frame)))
((not frame) nil)
(function-end-cookie-debug-fun cookie)))))
(do ((frame frame (frame-down frame)))
((not frame) nil)
)))
(:function-start
(etypecase (breakpoint-what breakpoint)
)))
(:function-start
(etypecase (breakpoint-what breakpoint)
- (compiled-debug-function
(activate-compiled-function-start-breakpoint breakpoint))
;; (There used to be more cases back before sbcl-0.7.0, when
;; we did special tricks to debug the IR1 interpreter.)
))
(:function-end
(etypecase (breakpoint-what breakpoint)
(activate-compiled-function-start-breakpoint breakpoint))
;; (There used to be more cases back before sbcl-0.7.0, when
;; we did special tricks to debug the IR1 interpreter.)
))
(:function-end
(etypecase (breakpoint-what breakpoint)
- (compiled-debug-function
(let ((starter (breakpoint-start-helper breakpoint)))
(unless (eq (breakpoint-status starter) :active)
;; may already be active by some other :FUNCTION-END breakpoint
(let ((starter (breakpoint-start-helper breakpoint)))
(unless (eq (breakpoint-status starter) :active)
;; may already be active by some other :FUNCTION-END breakpoint
(declare (type compiled-code-location loc))
(sub-activate-breakpoint
breakpoint
(declare (type compiled-code-location loc))
(sub-activate-breakpoint
breakpoint
- (breakpoint-data (compiled-debug-function-component
- (code-location-debug-function loc))
+ (breakpoint-data (compiled-debug-fun-component
+ (code-location-debug-fun loc))
(+ (compiled-code-location-pc loc)
(if (or (eq (breakpoint-kind breakpoint)
:unknown-return-partner)
(+ (compiled-code-location-pc loc)
(if (or (eq (breakpoint-kind breakpoint)
:unknown-return-partner)
(let ((debug-fun (breakpoint-what breakpoint)))
(sub-activate-breakpoint
breakpoint
(let ((debug-fun (breakpoint-what breakpoint)))
(sub-activate-breakpoint
breakpoint
- (breakpoint-data (compiled-debug-function-component debug-fun)
- (sb!c::compiled-debug-function-start-pc
- (compiled-debug-function-compiler-debug-fun
+ (breakpoint-data (compiled-debug-fun-component debug-fun)
+ (sb!c::compiled-debug-fun-start-pc
+ (compiled-debug-fun-compiler-debug-fun
debug-fun))))))
(defun sub-activate-breakpoint (breakpoint data)
debug-fun))))))
(defun sub-activate-breakpoint (breakpoint data)
(without-interrupts
(let ((loc (breakpoint-what breakpoint)))
(etypecase loc
(without-interrupts
(let ((loc (breakpoint-what breakpoint)))
(etypecase loc
- ((or compiled-code-location compiled-debug-function)
+ ((or compiled-code-location compiled-debug-fun)
(deactivate-compiled-breakpoint breakpoint)
(let ((other (breakpoint-unknown-return-partner breakpoint)))
(when other
(deactivate-compiled-breakpoint breakpoint)
(let ((other (breakpoint-unknown-return-partner breakpoint)))
(when other
(setf (breakpoint-info starter) breakpoints)
(unless breakpoints
(delete-breakpoint starter)
(setf (breakpoint-info starter) breakpoints)
(unless breakpoints
(delete-breakpoint starter)
- (setf (compiled-debug-function-end-starter
+ (setf (compiled-debug-fun-end-starter
(breakpoint-what breakpoint))
nil))))))
breakpoint)
(breakpoint-what breakpoint))
nil))))))
breakpoint)
(let ((data (breakpoint-data component offset nil)))
(unless data
(error "unknown breakpoint in ~S at offset ~S"
(let ((data (breakpoint-data component offset nil)))
(unless data
(error "unknown breakpoint in ~S at offset ~S"
- (debug-function-name (debug-function-from-pc component offset))
+ (debug-fun-name (debug-fun-from-pc component offset))
offset))
(let ((breakpoints (breakpoint-data-breakpoints data)))
(if (or (null breakpoints)
offset))
(let ((breakpoints (breakpoint-data-breakpoints data)))
(if (or (null breakpoints)
;;; invocation.
(defvar *executing-breakpoint-hooks* nil)
;;; invocation.
(defvar *executing-breakpoint-hooks* nil)
-;;; This handles code-location and debug-function :FUNCTION-START
+;;; This handles code-location and DEBUG-FUN :FUNCTION-START
;;; breakpoints.
(defun handle-breakpoint-aux (breakpoints data offset component signal-context)
(/show0 "entering HANDLE-BREAKPOINT-AUX")
;;; breakpoints.
(defun handle-breakpoint-aux (breakpoints data offset component signal-context)
(/show0 "entering HANDLE-BREAKPOINT-AUX")
(error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
(defun invoke-breakpoint-hooks (breakpoints component offset)
(error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
(defun invoke-breakpoint-hooks (breakpoints component offset)
- (let* ((debug-fun (debug-function-from-pc component offset))
+ (let* ((debug-fun (debug-fun-from-pc component offset))
(frame (do ((f (top-frame) (frame-down f)))
(frame (do ((f (top-frame) (frame-down f)))
- ((eq debug-fun (frame-debug-function f)) f))))
+ ((eq debug-fun (frame-debug-fun f)) f))))
(dolist (bpt breakpoints)
(funcall (breakpoint-hook-function bpt)
frame
(dolist (bpt breakpoints)
(funcall (breakpoint-hook-function bpt)
frame
(let ((data (breakpoint-data component offset nil)))
(unless data
(error "unknown breakpoint in ~S at offset ~S"
(let ((data (breakpoint-data component offset nil)))
(unless data
(error "unknown breakpoint in ~S at offset ~S"
- (debug-function-name (debug-function-from-pc component offset))
+ (debug-fun-name (debug-fun-from-pc component offset))
offset))
(let ((breakpoints (breakpoint-data-breakpoints data)))
(when breakpoints
offset))
(let ((breakpoints (breakpoint-data-breakpoints data)))
(when breakpoints
-;;; This appears here because it cannot go with the DEBUG-FUNCTION
+;;; This appears here because it cannot go with the DEBUG-FUN
;;; interface since DO-DEBUG-BLOCK-LOCATIONS isn't defined until after
;;; interface since DO-DEBUG-BLOCK-LOCATIONS isn't defined until after
-;;; the DEBUG-FUNCTION routines.
+;;; the DEBUG-FUN routines.
;;; Return a code-location before the body of a function and after all
;;; the arguments are in place; or if that location can't be
;;; determined due to a lack of debug information, return NIL.
;;; Return a code-location before the body of a function and after all
;;; the arguments are in place; or if that location can't be
;;; determined due to a lack of debug information, return NIL.
-(defun debug-function-start-location (debug-fun)
+(defun debug-fun-start-location (debug-fun)
- (compiled-debug-function
(code-location-from-pc debug-fun
(code-location-from-pc debug-fun
- (sb!c::compiled-debug-function-start-pc
- (compiled-debug-function-compiler-debug-fun
+ (sb!c::compiled-debug-fun-start-pc
+ (compiled-debug-fun-compiler-debug-fun
debug-fun))
nil))
;; (There used to be more cases back before sbcl-0.7.0, when
debug-fun))
nil))
;; (There used to be more cases back before sbcl-0.7.0, when
))
(defun print-code-locations (function)
))
(defun print-code-locations (function)
- (let ((debug-fun (function-debug-function function)))
- (do-debug-function-blocks (block debug-fun)
+ (let ((debug-fun (fun-debug-fun function)))
+ (do-debug-fun-blocks (block debug-fun)
(do-debug-block-locations (loc block)
(fill-in-code-location loc)
(format t "~S code location at ~D"
(do-debug-block-locations (loc block)
(fill-in-code-location loc)
(format t "~S code location at ~D"
(declaim (type integer *number-of-steps*))
;;; This is used when listing and setting breakpoints.
(declaim (type integer *number-of-steps*))
;;; This is used when listing and setting breakpoints.
-(defvar *default-breakpoint-debug-function* nil)
-(declaim (type (or list sb!di:debug-function) *default-breakpoint-debug-function*))
+(defvar *default-breakpoint-debug-fun* nil)
+(declaim (type (or list sb!di:debug-fun) *default-breakpoint-debug-fun*))
\f
;;;; code location utilities
\f
;;;; code location utilities
(setf next-list (next-code-locations (first next-list))))
next-list)))
(setf next-list (next-code-locations (first next-list))))
next-list)))
-;;; Return a list of code-locations of the possible breakpoints of the
-;;; debug-function passed.
-(defun possible-breakpoints (debug-function)
+;;; Return a list of code-locations of the possible breakpoints of DEBUG-FUN.
+(defun possible-breakpoints (debug-fun)
(let ((possible-breakpoints nil))
(let ((possible-breakpoints nil))
- (sb!di:do-debug-function-blocks (debug-block debug-function)
+ (sb!di:do-debug-fun-blocks (debug-block debug-fun)
(unless (sb!di:debug-block-elsewhere-p debug-block)
(if *only-block-start-locations*
(push (first-code-location debug-block) possible-breakpoints)
(unless (sb!di:debug-block-elsewhere-p debug-block)
(if *only-block-start-locations*
(push (first-code-location debug-block) possible-breakpoints)
(push code-location possible-breakpoints))))))
(nreverse possible-breakpoints)))
(push code-location possible-breakpoints))))))
(nreverse possible-breakpoints)))
-;;; Search the info-list for the item passed (code-location,
-;;; debug-function, or breakpoint-info). If the item passed is a debug
+;;; Search the info-list for the item passed (CODE-LOCATION,
+;;; DEBUG-FUN, or BREAKPOINT-INFO). If the item passed is a debug
;;; function then kind will be compared if it was specified. The kind
;;; if also compared if a breakpoint-info is passed since it's in the
;;; breakpoint. The info structure is returned if found.
;;; function then kind will be compared if it was specified. The kind
;;; if also compared if a breakpoint-info is passed since it's in the
;;; breakpoint. The info structure is returned if found.
(sb!di:code-location= x y)))))
(t
(find place info-list
(sb!di:code-location= x y)))))
(t
(find place info-list
- :test #'(lambda (x-debug-function y-info)
+ :test #'(lambda (x-debug-fun y-info)
(let ((y-place (breakpoint-info-place y-info))
(y-breakpoint (breakpoint-info-breakpoint
y-info)))
(let ((y-place (breakpoint-info-place y-info))
(y-breakpoint (breakpoint-info-breakpoint
y-info)))
- (and (sb!di:debug-function-p y-place)
- (eq x-debug-function y-place)
+ (and (sb!di:debug-fun-p y-place)
+ (eq x-debug-fun y-place)
(or (not kind)
(eq kind (sb!di:breakpoint-kind
y-breakpoint))))))))))
(or (not kind)
(eq kind (sb!di:breakpoint-kind
y-breakpoint))))))))))
(defstruct (breakpoint-info (:copier nil))
;; where we are going to stop
(place (required-argument)
(defstruct (breakpoint-info (:copier nil))
;; where we are going to stop
(place (required-argument)
- :type (or sb!di:code-location sb!di:debug-function))
+ :type (or sb!di:code-location sb!di:debug-fun))
;; the breakpoint returned by sb!di:make-breakpoint
(breakpoint (required-argument) :type sb!di:breakpoint)
;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
;; the breakpoint returned by sb!di:make-breakpoint
(breakpoint (required-argument) :type sb!di:breakpoint)
;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
"~&~S: ~S in ~S"
bp-number
loc-number
"~&~S: ~S in ~S"
bp-number
loc-number
- (sb!di:debug-function-name (sb!di:code-location-debug-function
- place))))
+ (sb!di:debug-fun-name (sb!di:code-location-debug-fun
+ place))))
(:function-start
(format t "~&~S: FUNCTION-START in ~S" bp-number
(:function-start
(format t "~&~S: FUNCTION-START in ~S" bp-number
- (sb!di:debug-function-name place)))
+ (sb!di:debug-fun-name place)))
(:function-end
(format t "~&~S: FUNCTION-END in ~S" bp-number
(:function-end
(format t "~&~S: FUNCTION-END in ~S" bp-number
- (sb!di:debug-function-name place))))))
+ (sb!di:debug-fun-name place))))))
\f
;;;; MAIN-HOOK-FUNCTION for steps and breakpoints
\f
;;;; MAIN-HOOK-FUNCTION for steps and breakpoints
;;; STEP breakpoints are.
(defun main-hook-function (current-frame breakpoint &optional return-vals
function-end-cookie)
;;; STEP breakpoints are.
(defun main-hook-function (current-frame breakpoint &optional return-vals
function-end-cookie)
- (setf *default-breakpoint-debug-function*
- (sb!di:frame-debug-function current-frame))
+ (setf *default-breakpoint-debug-fun*
+ (sb!di:frame-debug-fun current-frame))
(dolist (step-info *step-breakpoints*)
(sb!di:delete-breakpoint (breakpoint-info-breakpoint step-info))
(let ((bp-info (location-in-list step-info *breakpoints*)))
(dolist (step-info *step-breakpoints*)
(sb!di:delete-breakpoint (breakpoint-info-breakpoint step-info))
(let ((bp-info (location-in-list step-info *breakpoints*)))
(push (create-breakpoint-info code-location bp 0)
*step-breakpoints*))))
(t
(push (create-breakpoint-info code-location bp 0)
*step-breakpoints*))))
(t
- (let* ((debug-function (sb!di:frame-debug-function *current-frame*))
- (bp (sb!di:make-breakpoint #'main-hook-function debug-function
+ (let* ((debug-fun (sb!di:frame-debug-fun *current-frame*))
+ (bp (sb!di:make-breakpoint #'main-hook-function debug-fun
:kind :function-end)))
(sb!di:activate-breakpoint bp)
:kind :function-end)))
(sb!di:activate-breakpoint bp)
- (push (create-breakpoint-info debug-function bp 0)
+ (push (create-breakpoint-info debug-fun bp 0)
*step-breakpoints*))))))))
\f
;;;; STEP
*step-breakpoints*))))))))
\f
;;;; STEP
;;; lambda-list variables since any other arguments will be in the
;;; &REST arg's list of values.
(defun print-frame-call-1 (frame)
;;; lambda-list variables since any other arguments will be in the
;;; &REST arg's list of values.
(defun print-frame-call-1 (frame)
- (let* ((d-fun (sb!di:frame-debug-function frame))
+ (let* ((d-fun (sb!di:frame-debug-fun frame))
(loc (sb!di:frame-code-location frame))
(loc (sb!di:frame-code-location frame))
- (results (list (sb!di:debug-function-name d-fun))))
+ (results (list (sb!di:debug-fun-name d-fun))))
- (dolist (ele (sb!di:debug-function-lambda-list d-fun))
+ (dolist (ele (sb!di:debug-fun-lambda-list d-fun))
(lambda-list-element-dispatch ele
:required ((push (frame-call-arg ele loc frame) results))
:optional ((push (frame-call-arg (second ele) loc frame) results))
(lambda-list-element-dispatch ele
:required ((push (frame-call-arg ele loc frame) results))
:optional ((push (frame-call-arg (second ele) loc frame) results))
(pprint-logical-block (*standard-output* nil)
(let ((x (nreverse (mapcar #'ensure-printable-object results))))
(format t "(~@<~S~{ ~_~S~}~:>)" (first x) (rest x))))
(pprint-logical-block (*standard-output* nil)
(let ((x (nreverse (mapcar #'ensure-printable-object results))))
(format t "(~@<~S~{ ~_~S~}~:>)" (first x) (rest x))))
- (when (sb!di:debug-function-kind d-fun)
+ (when (sb!di:debug-fun-kind d-fun)
- (prin1 (sb!di:debug-function-kind d-fun))
+ (prin1 (sb!di:debug-fun-kind d-fun))
(write-char #\]))))
(defun ensure-printable-object (object)
(write-char #\]))))
(defun ensure-printable-object (object)
;;; Prints a representation of the function call causing FRAME to
;;; exist. VERBOSITY indicates the level of information to output;
;;; Prints a representation of the function call causing FRAME to
;;; exist. VERBOSITY indicates the level of information to output;
-;;; zero indicates just printing the debug-function's name, and one
+;;; zero indicates just printing the DEBUG-FUN's name, and one
;;; indicates displaying call-like, one-liner format with argument
;;; values.
(defun print-frame-call (frame &key (verbosity 1) (number nil))
;;; indicates displaying call-like, one-liner format with argument
;;; values.
(defun print-frame-call (frame &key (verbosity 1) (number nil))
(sb!xc:defmacro define-var-operation (ref-or-set &optional value-var)
`(let* ((temp (etypecase name
(sb!xc:defmacro define-var-operation (ref-or-set &optional value-var)
`(let* ((temp (etypecase name
- (symbol (sb!di:debug-function-symbol-variables
- (sb!di:frame-debug-function *current-frame*)
+ (symbol (sb!di:debug-fun-symbol-variables
+ (sb!di:frame-debug-fun *current-frame*)
name))
(simple-string (sb!di:ambiguous-debug-vars
name))
(simple-string (sb!di:ambiguous-debug-vars
- (sb!di:frame-debug-function *current-frame*)
+ (sb!di:frame-debug-fun *current-frame*)
name))))
(location (sb!di:frame-code-location *current-frame*))
;; Let's only deal with valid variables.
name))))
(location (sb!di:frame-code-location *current-frame*))
;; Let's only deal with valid variables.
(define-var-operation :set value))
;;; This returns the COUNT'th arg as the user sees it from args, the
(define-var-operation :set value))
;;; This returns the COUNT'th arg as the user sees it from args, the
-;;; result of SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a
+;;; result of SB!DI:DEBUG-FUN-LAMBDA-LIST. If this returns a
;;; potential DEBUG-VAR from the lambda-list, then the second value is
;;; T. If this returns a keyword symbol or a value from a rest arg,
;;; then the second value is NIL.
;;; potential DEBUG-VAR from the lambda-list, then the second value is
;;; T. If this returns a keyword symbol or a value from a rest arg,
;;; then the second value is NIL.
argument in a frame's default printed representation. Count keyword/value
pairs as separate arguments."
(multiple-value-bind (var lambda-var-p)
argument in a frame's default printed representation. Count keyword/value
pairs as separate arguments."
(multiple-value-bind (var lambda-var-p)
- (nth-arg n (handler-case (sb!di:debug-function-lambda-list
- (sb!di:frame-debug-function *current-frame*))
+ (nth-arg n (handler-case (sb!di:debug-fun-lambda-list
+ (sb!di:frame-debug-fun *current-frame*))
(sb!di:lambda-list-unavailable ()
(error "No argument values are available."))))
(if lambda-var-p
(sb!di:lambda-list-unavailable ()
(error "No argument values are available."))))
(if lambda-var-p
(!def-debug-command-alias "P" "PRINT")
(!def-debug-command "LIST-LOCALS" ()
(!def-debug-command-alias "P" "PRINT")
(!def-debug-command "LIST-LOCALS" ()
- (let ((d-fun (sb!di:frame-debug-function *current-frame*)))
+ (let ((d-fun (sb!di:frame-debug-fun *current-frame*)))
(if (sb!di:debug-var-info-available d-fun)
(let ((*standard-output* *debug-io*)
(location (sb!di:frame-code-location *current-frame*))
(if (sb!di:debug-var-info-available d-fun)
(let ((*standard-output* *debug-io*)
(location (sb!di:frame-code-location *current-frame*))
;;; *POSSIBLE-BREAKPOINTS* to the code-locations which can then be
;;; used by sbreakpoint.
(!def-debug-command "LIST-LOCATIONS" ()
;;; *POSSIBLE-BREAKPOINTS* to the code-locations which can then be
;;; used by sbreakpoint.
(!def-debug-command "LIST-LOCATIONS" ()
- (let ((df (read-if-available *default-breakpoint-debug-function*)))
+ (let ((df (read-if-available *default-breakpoint-debug-fun*)))
- (setf df (sb!di:function-debug-function (eval df)))
- (setf *default-breakpoint-debug-function* df))
+ (setf df (sb!di:fun-debug-fun (eval df)))
+ (setf *default-breakpoint-debug-fun* df))
- (not *default-breakpoint-debug-function*))
- (setf df (sb!di:frame-debug-function *current-frame*))
- (setf *default-breakpoint-debug-function* df)))
+ (not *default-breakpoint-debug-fun*))
+ (setf df (sb!di:frame-debug-fun *current-frame*))
+ (setf *default-breakpoint-debug-fun* df)))
(setf *possible-breakpoints* (possible-breakpoints df)))
(let ((continue-at (sb!di:frame-code-location *current-frame*)))
(setf *possible-breakpoints* (possible-breakpoints df)))
(let ((continue-at (sb!di:frame-code-location *current-frame*)))
- (let ((active (location-in-list *default-breakpoint-debug-function*
+ (let ((active (location-in-list *default-breakpoint-debug-fun*
*breakpoints* :function-start))
(here (sb!di:code-location=
*breakpoints* :function-start))
(here (sb!di:code-location=
- (sb!di:debug-function-start-location
- *default-breakpoint-debug-function*) continue-at)))
+ (sb!di:debug-fun-start-location
+ *default-breakpoint-debug-fun*) continue-at)))
(when (or active here)
(format t "::FUNCTION-START ")
(when active (format t " *Active*"))
(when (or active here)
(format t "::FUNCTION-START ")
(when active (format t " *Active*"))
- (when (location-in-list *default-breakpoint-debug-function*
+ (when (location-in-list *default-breakpoint-debug-fun*
*breakpoints*
:function-end)
(format t "~&::FUNCTION-END *Active* "))))
*breakpoints*
:function-end)
(format t "~&::FUNCTION-END *Active* "))))
(print-functions nil)
(function nil)
(bp)
(print-functions nil)
(function nil)
(bp)
- (place *default-breakpoint-debug-function*))
+ (place *default-breakpoint-debug-fun*))
(flet ((get-command-line ()
(let ((command-line nil)
(unique '(nil)))
(flet ((get-command-line ()
(let ((command-line nil)
(unique '(nil)))
(:break (setf break (pop command-line)))
(:function
(setf function (eval (pop command-line)))
(:break (setf break (pop command-line)))
(:function
(setf function (eval (pop command-line)))
- (setf *default-breakpoint-debug-function*
- (sb!di:function-debug-function function))
- (setf place *default-breakpoint-debug-function*)
+ (setf *default-breakpoint-debug-fun*
+ (sb!di:fun-debug-fun function))
+ (setf place *default-breakpoint-debug-fun*)
(setf *possible-breakpoints*
(possible-breakpoints
(setf *possible-breakpoints*
(possible-breakpoints
- *default-breakpoint-debug-function*))))))
+ *default-breakpoint-debug-fun*))))))
- (let ((code-loc (sb!di:debug-function-start-location place)))
+ (let ((code-loc (sb!di:debug-fun-start-location place)))
(setf bp (sb!di:make-breakpoint #'main-hook-function
place
:kind :function-start))
(setf bp (sb!di:make-breakpoint #'main-hook-function
place
:kind :function-start))
(!def-debug-command "DESCRIBE" ()
(let* ((curloc (sb!di:frame-code-location *current-frame*))
(!def-debug-command "DESCRIBE" ()
(let* ((curloc (sb!di:frame-code-location *current-frame*))
- (debug-fun (sb!di:code-location-debug-function curloc))
- (function (sb!di:debug-function-function debug-fun)))
+ (debug-fun (sb!di:code-location-debug-fun curloc))
+ (function (sb!di:debug-fun-fun debug-fun)))
(if function
(describe function)
(format t "can't figure out the function for this frame"))))
(if function
(describe function)
(format t "can't figure out the function for this frame"))))
-;;; Except for atoms, we always call GET-SETF-EXPANSION, since it has some
-;;; non-trivial semantics. But when there is a setf inverse, and G-S-E uses
-;;; it, then we return a call to the inverse, rather than returning a hairy let
-;;; form. This is probably important mainly as a convenience in allowing the
-;;; use of SETF inverses without the full interpreter.
+;;; Except for atoms, we always call GET-SETF-EXPANSION, since it has
+;;; some non-trivial semantics. But when there is a setf inverse, and
+;;; G-S-E uses it, then we return a call to the inverse, rather than
+;;; returning a hairy LET form. This is probably important mainly as a
+;;; convenience in allowing the use of SETF inverses without the full
+;;; interpreter.
(defmacro-mundanely setf (&rest args &environment env)
#!+sb-doc
"Takes pairs of arguments like SETQ. The first is a place and the second
(defmacro-mundanely setf (&rest args &environment env)
#!+sb-doc
"Takes pairs of arguments like SETQ. The first is a place and the second
(handler-case
(let* ((*finding-name* t)
(frame (sb!di:frame-down (sb!di:frame-down (sb!di:top-frame))))
(handler-case
(let* ((*finding-name* t)
(frame (sb!di:frame-down (sb!di:frame-down (sb!di:top-frame))))
- (name (sb!di:debug-function-name
- (sb!di:frame-debug-function frame))))
+ (name (sb!di:debug-fun-name
+ (sb!di:frame-debug-fun frame))))
(sb!di:flush-frames-above frame)
(values name frame))
(error ()
(sb!di:flush-frames-above frame)
(values name frame))
(error ()
(sb!di::compiled-frame-escaped frame))
(sb!di:flush-frames-above frame)
(/show0 "returning from within DO loop")
(sb!di::compiled-frame-escaped frame))
(sb!di:flush-frames-above frame)
(/show0 "returning from within DO loop")
- (return (values (sb!di:debug-function-name
- (sb!di:frame-debug-function frame))
+ (return (values (sb!di:debug-fun-name
+ (sb!di:frame-debug-fun frame))
frame)))))
(error ()
(/show0 "trapped ERROR")
frame)))))
(error ()
(/show0 "trapped ERROR")
(defun trace-wherein-p (frame names)
(do ((frame (sb-di:frame-down frame) (sb-di:frame-down frame)))
((not frame) nil)
(defun trace-wherein-p (frame names)
(do ((frame (sb-di:frame-down frame) (sb-di:frame-down frame)))
((not frame) nil)
- (when (member (sb-di:debug-function-name (sb-di:frame-debug-function
- frame))
+ (when (member (sb-di:debug-fun-name (sb-di:frame-debug-fun frame))
names
:test #'equal)
(return t))))
names
:test #'equal)
(return t))))
(warn "~S is already TRACE'd, untracing it." function-or-name)
(untrace-1 fun))
(warn "~S is already TRACE'd, untracing it." function-or-name)
(untrace-1 fun))
- (let* ((debug-fun (sb-di:function-debug-function fun))
+ (let* ((debug-fun (sb-di:fun-debug-fun fun))
(encapsulated
(if (eq (trace-info-encapsulated info) :default)
(ecase kind
(:compiled nil)
(:compiled-closure
(unless (functionp function-or-name)
(encapsulated
(if (eq (trace-info-encapsulated info) :default)
(ecase kind
(:compiled nil)
(:compiled-closure
(unless (functionp function-or-name)
- (warn "Tracing shared code for ~S:~% ~S"
+ (warn "tracing shared code for ~S:~% ~S"
function-or-name
fun))
nil)
function-or-name
fun))
nil)
(trace-info-encapsulated info)))
(loc (if encapsulated
:encapsulated
(trace-info-encapsulated info)))
(loc (if encapsulated
:encapsulated
- (sb-di:debug-function-start-location debug-fun)))
+ (sb-di:debug-fun-start-location debug-fun)))
(info (make-trace-info
:what function-or-name
:named named
(info (make-trace-info
:what function-or-name
:named named
(values))
;;; Return a vector and an integer (or null) suitable for use as the
(values))
;;; Return a vector and an integer (or null) suitable for use as the
-;;; BLOCKS and TLF-NUMBER in FUN's debug-function. This requires two
+;;; BLOCKS and TLF-NUMBER in FUN's DEBUG-FUN. This requires two
;;; passes to compute:
;;; -- Scan all blocks, dumping the header and successors followed
;;; by all the non-elsewhere locations.
;;; passes to compute:
;;; -- Scan all blocks, dumping the header and successors followed
;;; by all the non-elsewhere locations.
(vector-push-extend (tn-sc-offset save-tn) buffer)))
(values))
(vector-push-extend (tn-sc-offset save-tn) buffer)))
(values))
-;;; Return a vector suitable for use as the DEBUG-FUNCTION-VARIABLES
+;;; Return a vector suitable for use as the DEBUG-FUN-VARIABLES
;;; of FUN. LEVEL is the current DEBUG-INFO quality. VAR-LOCS is a
;;; hashtable in which we enter the translation from LAMBDA-VARS to
;;; the relative position of that variable's location in the resulting
;;; of FUN. LEVEL is the current DEBUG-INFO quality. VAR-LOCS is a
;;; hashtable in which we enter the translation from LAMBDA-VARS to
;;; the relative position of that variable's location in the resulting
(incf i))
(coerce buffer 'simple-vector))))
(incf i))
(coerce buffer 'simple-vector))))
-;;; Return a vector suitable for use as the DEBUG-FUNCTION-VARIABLES of
+;;; Return a vector suitable for use as the DEBUG-FUN-VARIABLES of
;;; FUN, representing the arguments to FUN in minimal variable format.
(defun compute-minimal-variables (fun)
(declare (type clambda fun))
;;; FUN, representing the arguments to FUN in minimal variable format.
(defun compute-minimal-variables (fun)
(declare (type clambda fun))
;;;; arguments/returns
;;; Return a vector to be used as the
;;;; arguments/returns
;;; Return a vector to be used as the
-;;; COMPILED-DEBUG-FUNCTION-ARGUMENTS for Fun. If fun is the
+;;; COMPILED-DEBUG-FUN-ARGUMENTS for Fun. If fun is the
;;; MAIN-ENTRY for an optional dispatch, then look at the ARGLIST to
;;; determine the syntax, otherwise pretend all arguments are fixed.
;;;
;;; MAIN-ENTRY for an optional dispatch, then look at the ARGLIST to
;;; determine the syntax, otherwise pretend all arguments are fixed.
;;;
(dispatch (lambda-optional-dispatch fun))
(main-p (and dispatch
(eq fun (optional-dispatch-main-entry dispatch)))))
(dispatch (lambda-optional-dispatch fun))
(main-p (and dispatch
(eq fun (optional-dispatch-main-entry dispatch)))))
- (make-compiled-debug-function
+ (make-compiled-debug-fun
:name (cond ((leaf-name fun))
((let ((ef (functional-entry-function fun)))
(and ef (leaf-name ef))))
:name (cond ((leaf-name fun))
((let ((ef (functional-entry-function fun)))
(and ef (leaf-name ef))))
:start-pc (label-position (ir2-physenv-environment-start 2env))
:elsewhere-pc (label-position (ir2-physenv-elsewhere-start 2env)))))
:start-pc (label-position (ir2-physenv-environment-start 2env))
:elsewhere-pc (label-position (ir2-physenv-elsewhere-start 2env)))))
-;;; Return a complete C-D-F structure for Fun. This involves
+;;; Return a complete C-D-F structure for FUN. This involves
;;; determining the DEBUG-INFO level and filling in optional slots as
;;; appropriate.
;;; determining the DEBUG-INFO level and filling in optional slots as
;;; appropriate.
-(defun compute-1-debug-function (fun var-locs)
+(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))
(declare (type clambda fun) (type hash-table var-locs))
(let* ((dfun (dfun-from-fun fun))
(actual-level (policy (lambda-bind fun) debug))
(let ((od (lambda-optional-dispatch fun)))
(or (not od)
(not (eq (optional-dispatch-main-entry od) fun)))))
(let ((od (lambda-optional-dispatch fun)))
(or (not od)
(not (eq (optional-dispatch-main-entry od) fun)))))
- (setf (compiled-debug-function-variables dfun)
+ (setf (compiled-debug-fun-variables dfun)
(compute-minimal-variables fun))
(compute-minimal-variables fun))
- (setf (compiled-debug-function-arguments dfun) :minimal))
+ (setf (compiled-debug-fun-arguments dfun) :minimal))
- (setf (compiled-debug-function-variables dfun)
+ (setf (compiled-debug-fun-variables dfun)
(compute-variables fun level var-locs))
(compute-variables fun level var-locs))
- (setf (compiled-debug-function-arguments dfun)
+ (setf (compiled-debug-fun-arguments dfun)
(compute-arguments fun var-locs))))
(when (>= level 2)
(multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
(compute-arguments fun var-locs))))
(when (>= level 2)
(multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
- (setf (compiled-debug-function-tlf-number dfun) tlf-num)
- (setf (compiled-debug-function-blocks dfun) blocks)))
+ (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
+ (setf (compiled-debug-fun-blocks dfun) blocks)))
(if (external-entry-point-p fun)
(if (external-entry-point-p fun)
- (setf (compiled-debug-function-returns dfun) :standard)
+ (setf (compiled-debug-fun-returns dfun) :standard)
(let ((info (tail-set-info (lambda-tail-set fun))))
(when info
(cond ((eq (return-info-kind info) :unknown)
(let ((info (tail-set-info (lambda-tail-set fun))))
(when info
(cond ((eq (return-info-kind info) :unknown)
- (setf (compiled-debug-function-returns dfun)
+ (setf (compiled-debug-fun-returns dfun)
:standard))
((/= level 0)
:standard))
((/= level 0)
- (setf (compiled-debug-function-returns dfun)
+ (setf (compiled-debug-fun-returns dfun)
(compute-debug-returns fun)))))))
dfun))
\f
(compute-debug-returns fun)))))))
dfun))
\f
-;;;; minimal debug functions
-;;; Return true if DFUN can be represented as a minimal debug
-;;; function. DFUN is a cons (<start offset> . C-D-F).
-(defun debug-function-minimal-p (dfun)
+;;; Return true if DFUN can be represented as a MINIMAL-DEBUG-FUN.
+;;; DFUN is a cons (<start offset> . C-D-F).
+(defun debug-fun-minimal-p (dfun)
(declare (type cons dfun))
(let ((dfun (cdr dfun)))
(declare (type cons dfun))
(let ((dfun (cdr dfun)))
- (and (member (compiled-debug-function-arguments dfun) '(:minimal nil))
- (null (compiled-debug-function-blocks dfun)))))
+ (and (member (compiled-debug-fun-arguments dfun) '(:minimal nil))
+ (null (compiled-debug-fun-blocks dfun)))))
;;; Dump a packed binary representation of a DFUN into *BYTE-BUFFER*.
;;; PREV-START and START are the byte offsets in the code where the
;;; previous function started and where this one starts.
;;; PREV-ELSEWHERE is the previous function's elsewhere PC.
(defun dump-1-minimal-dfun (dfun prev-start start prev-elsewhere)
;;; Dump a packed binary representation of a DFUN into *BYTE-BUFFER*.
;;; PREV-START and START are the byte offsets in the code where the
;;; previous function started and where this one starts.
;;; PREV-ELSEWHERE is the previous function's elsewhere PC.
(defun dump-1-minimal-dfun (dfun prev-start start prev-elsewhere)
- (declare (type compiled-debug-function dfun)
+ (declare (type compiled-debug-fun dfun)
(type index prev-start start prev-elsewhere))
(type index prev-start start prev-elsewhere))
- (let* ((name (compiled-debug-function-name dfun))
+ (let* ((name (compiled-debug-fun-name dfun))
(setf-p (and (consp name) (eq (car name) 'setf)
(consp (cdr name)) (symbolp (cadr name))))
(base-name (if setf-p (cadr name) name))
(setf-p (and (consp name) (eq (car name) 'setf)
(consp (cdr name)) (symbolp (cadr name))))
(base-name (if setf-p (cadr name) name))
(symbol-package base-name)))
(name-rep
(cond ((stringp base-name)
(symbol-package base-name)))
(name-rep
(cond ((stringp base-name)
- minimal-debug-function-name-component)
+ minimal-debug-fun-name-component)
- minimal-debug-function-name-uninterned)
+ minimal-debug-fun-name-uninterned)
- minimal-debug-function-name-symbol)
+ minimal-debug-fun-name-symbol)
- minimal-debug-function-name-packaged))))
+ minimal-debug-fun-name-packaged))))
(aver (or (atom name) setf-p))
(let ((options 0))
(aver (or (atom name) setf-p))
(let ((options 0))
- (setf (ldb minimal-debug-function-name-style-byte options) name-rep)
- (setf (ldb minimal-debug-function-kind-byte options)
- (position-or-lose (compiled-debug-function-kind dfun)
- *minimal-debug-function-kinds*))
- (setf (ldb minimal-debug-function-returns-byte options)
- (etypecase (compiled-debug-function-returns dfun)
- ((member :standard) minimal-debug-function-returns-standard)
- ((member :fixed) minimal-debug-function-returns-fixed)
- (vector minimal-debug-function-returns-specified)))
+ (setf (ldb minimal-debug-fun-name-style-byte options) name-rep)
+ (setf (ldb minimal-debug-fun-kind-byte options)
+ (position-or-lose (compiled-debug-fun-kind dfun)
+ *minimal-debug-fun-kinds*))
+ (setf (ldb minimal-debug-fun-returns-byte options)
+ (etypecase (compiled-debug-fun-returns dfun)
+ ((member :standard) minimal-debug-fun-returns-standard)
+ ((member :fixed) minimal-debug-fun-returns-fixed)
+ (vector minimal-debug-fun-returns-specified)))
(vector-push-extend options *byte-buffer*))
(let ((flags 0))
(when setf-p
(vector-push-extend options *byte-buffer*))
(let ((flags 0))
(when setf-p
- (setq flags (logior flags minimal-debug-function-setf-bit)))
- (when (compiled-debug-function-nfp dfun)
- (setq flags (logior flags minimal-debug-function-nfp-bit)))
- (when (compiled-debug-function-variables dfun)
- (setq flags (logior flags minimal-debug-function-variables-bit)))
+ (setq flags (logior flags minimal-debug-fun-setf-bit)))
+ (when (compiled-debug-fun-nfp dfun)
+ (setq flags (logior flags minimal-debug-fun-nfp-bit)))
+ (when (compiled-debug-fun-variables dfun)
+ (setq flags (logior flags minimal-debug-fun-variables-bit)))
(vector-push-extend flags *byte-buffer*))
(vector-push-extend flags *byte-buffer*))
- (when (eql name-rep minimal-debug-function-name-packaged)
+ (when (eql name-rep minimal-debug-fun-name-packaged)
(write-var-string (package-name pkg) *byte-buffer*))
(unless (stringp base-name)
(write-var-string (symbol-name base-name) *byte-buffer*))
(write-var-string (package-name pkg) *byte-buffer*))
(unless (stringp base-name)
(write-var-string (symbol-name base-name) *byte-buffer*))
- (let ((vars (compiled-debug-function-variables dfun)))
+ (let ((vars (compiled-debug-fun-variables dfun)))
(when vars
(let ((len (length vars)))
(write-var-integer len *byte-buffer*)
(dotimes (i len)
(vector-push-extend (aref vars i) *byte-buffer*)))))
(when vars
(let ((len (length vars)))
(write-var-integer len *byte-buffer*)
(dotimes (i len)
(vector-push-extend (aref vars i) *byte-buffer*)))))
- (let ((returns (compiled-debug-function-returns dfun)))
+ (let ((returns (compiled-debug-fun-returns dfun)))
(when (vectorp returns)
(let ((len (length returns)))
(write-var-integer len *byte-buffer*)
(dotimes (i len)
(write-var-integer (aref returns i) *byte-buffer*)))))
(when (vectorp returns)
(let ((len (length returns)))
(write-var-integer len *byte-buffer*)
(dotimes (i len)
(write-var-integer (aref returns i) *byte-buffer*)))))
- (write-var-integer (compiled-debug-function-return-pc dfun)
+ (write-var-integer (compiled-debug-fun-return-pc dfun)
- (write-var-integer (compiled-debug-function-old-fp dfun)
+ (write-var-integer (compiled-debug-fun-old-fp dfun)
- (when (compiled-debug-function-nfp dfun)
- (write-var-integer (compiled-debug-function-nfp dfun)
+ (when (compiled-debug-fun-nfp dfun)
+ (write-var-integer (compiled-debug-fun-nfp dfun)
*byte-buffer*))
(write-var-integer (- start prev-start) *byte-buffer*)
*byte-buffer*))
(write-var-integer (- start prev-start) *byte-buffer*)
- (write-var-integer (- (compiled-debug-function-start-pc dfun) start)
+ (write-var-integer (- (compiled-debug-fun-start-pc dfun) start)
- (write-var-integer (- (compiled-debug-function-elsewhere-pc dfun)
+ (write-var-integer (- (compiled-debug-fun-elsewhere-pc dfun)
prev-elsewhere)
*byte-buffer*)))
;;; Return a byte-vector holding all the debug functions for a
prev-elsewhere)
*byte-buffer*)))
;;; Return a byte-vector holding all the debug functions for a
-;;; component in the packed binary minimal-debug-function format.
-(defun compute-minimal-debug-functions (dfuns)
+;;; component in the packed binary MINIMAL-DEBUG-FUN format.
+(defun compute-minimal-debug-funs (dfuns)
(declare (list dfuns))
(setf (fill-pointer *byte-buffer*) 0)
(let ((prev-start 0)
(prev-elsewhere 0))
(dolist (dfun dfuns)
(let ((start (car dfun))
(declare (list dfuns))
(setf (fill-pointer *byte-buffer*) 0)
(let ((prev-start 0)
(prev-elsewhere 0))
(dolist (dfun dfuns)
(let ((start (car dfun))
- (elsewhere (compiled-debug-function-elsewhere-pc (cdr dfun))))
+ (elsewhere (compiled-debug-fun-elsewhere-pc (cdr dfun))))
(dump-1-minimal-dfun (cdr dfun) prev-start start prev-elsewhere)
(setq prev-start start prev-elsewhere elsewhere))))
(copy-seq *byte-buffer*))
(dump-1-minimal-dfun (cdr dfun) prev-start start prev-elsewhere)
(setq prev-start start prev-elsewhere elsewhere))))
(copy-seq *byte-buffer*))
;;;; full component dumping
;;; Compute the full form (simple-vector) function map.
;;;; full component dumping
;;; Compute the full form (simple-vector) function map.
-(defun compute-debug-function-map (sorted)
+(defun compute-debug-fun-map (sorted)
(declare (list sorted))
(let* ((len (1- (* (length sorted) 2)))
(funs-vec (make-array len)))
(declare (list sorted))
(let* ((len (1- (* (length sorted) 2)))
(funs-vec (make-array len)))
(collect ((dfuns))
(let ((var-locs (make-hash-table :test 'eq))
;; FIXME: What is *BYTE-BUFFER* for? Has it become dead code
(collect ((dfuns))
(let ((var-locs (make-hash-table :test 'eq))
;; FIXME: What is *BYTE-BUFFER* for? Has it become dead code
- ;; now that we no longer use minimal-debug-function
+ ;; now that we no longer use MINIMAL-DEBUG-FUN
;; representation?
(*byte-buffer* (make-array 10
:element-type '(unsigned-byte 8)
;; representation?
(*byte-buffer* (make-array 10
:element-type '(unsigned-byte 8)
(clrhash var-locs)
(dfuns (cons (label-position
(block-label (node-block (lambda-bind fun))))
(clrhash var-locs)
(dfuns (cons (label-position
(block-label (node-block (lambda-bind fun))))
- (compute-1-debug-function fun var-locs))))
+ (compute-1-debug-fun fun var-locs))))
(let* ((sorted (sort (dfuns) #'< :key #'car))
;; FIXME: CMU CL had
(let* ((sorted (sort (dfuns) #'< :key #'car))
;; FIXME: CMU CL had
- ;; (IF (EVERY #'DEBUG-FUNCTION-MINIMAL-P SORTED)
- ;; (COMPUTE-MINIMAL-DEBUG-FUNCTIONS SORTED)
- ;; (COMPUTE-DEBUG-FUNCTION-MAP SORTED))
- ;; here. We've gotten rid of the minimal-debug-function
+ ;; (IF (EVERY #'DEBUG-FUN-MINIMAL-P SORTED)
+ ;; (COMPUTE-MINIMAL-DEBUG-FUNS SORTED)
+ ;; (COMPUTE-DEBUG-FUN-MAP SORTED))
+ ;; here. We've gotten rid of the MINIMAL-DEBUG-FUN
;; case in SBCL because the minimal representation
;; couldn't be made to transform properly under package
;; renaming. Now that that case is gone, a lot of code is
;; dead, and once everything is known to work, the dead
;; code should be deleted.
;; case in SBCL because the minimal representation
;; couldn't be made to transform properly under package
;; renaming. Now that that case is gone, a lot of code is
;; dead, and once everything is known to work, the dead
;; code should be deleted.
- (function-map (compute-debug-function-map sorted)))
+ (function-map (compute-debug-fun-map sorted)))
(make-compiled-debug-info :name (component-name component)
:function-map function-map)))))
\f
(make-compiled-debug-info :name (component-name component)
:function-map function-map)))))
\f
(eq (transform-when x) when)))
(function-info-transforms info))))
(if old
(eq (transform-when x) when)))
(function-info-transforms info))))
(if old
- (setf (transform-function old) fun (transform-note old) note)
+ (setf (transform-function old) fun
+ (transform-note old) note)
(push (make-transform :type ctype :function fun :note note
:important important :when when)
(function-info-transforms info)))
(push (make-transform :type ctype :function fun :note note
:important important :when when)
(function-info-transforms info)))
;;; SAP-MAKER and LENGTH bytes long in the disassem-state object DSTATE.
;;;
;;; &KEY arguments include :VIRTUAL-LOCATION (by default the same as
;;; SAP-MAKER and LENGTH bytes long in the disassem-state object DSTATE.
;;;
;;; &KEY arguments include :VIRTUAL-LOCATION (by default the same as
-;;; the address), :DEBUG-FUNCTION, :SOURCE-FORM-CACHE (a
+;;; the address), :DEBUG-FUN, :SOURCE-FORM-CACHE (a
;;; SOURCE-FORM-CACHE object), and :HOOKS (a list of OFFS-HOOK
;;; objects).
(defun make-segment (sap-maker length
&key
code virtual-location
;;; SOURCE-FORM-CACHE object), and :HOOKS (a list of OFFS-HOOK
;;; objects).
(defun make-segment (sap-maker length
&key
code virtual-location
- debug-function source-form-cache
+ debug-fun source-form-cache
hooks)
(declare (type (function () sb!sys:system-area-pointer) sap-maker)
(type length length)
(type (or null address) virtual-location)
hooks)
(declare (type (function () sb!sys:system-area-pointer) sap-maker)
(type length length)
(type (or null address) virtual-location)
- (type (or null sb!di:debug-function) debug-function)
+ (type (or null sb!di:debug-fun) debug-fun)
(type (or null source-form-cache) source-form-cache))
(let* ((segment
(%make-segment
(type (or null source-form-cache) source-form-cache))
(let* ((segment
(%make-segment
(sb!sys:sap-int (funcall sap-maker)))
:hooks hooks
:code code)))
(sb!sys:sap-int (funcall sap-maker)))
:hooks hooks
:code code)))
- (add-debugging-hooks segment debug-function source-form-cache)
+ (add-debugging-hooks segment debug-fun source-form-cache)
(add-fun-header-hooks segment)
segment))
(add-fun-header-hooks segment)
segment))
new))
;;; Return a STORAGE-INFO struction describing the object-to-source
new))
;;; Return a STORAGE-INFO struction describing the object-to-source
-;;; variable mappings from DEBUG-FUNCTION.
-(defun storage-info-for-debug-function (debug-function)
- (declare (type sb!di:debug-function debug-function))
+;;; variable mappings from DEBUG-FUN.
+(defun storage-info-for-debug-fun (debug-fun)
+ (declare (type sb!di:debug-fun debug-fun))
(let ((sc-vec sb!c::*backend-sc-numbers*)
(groups nil)
(let ((sc-vec sb!c::*backend-sc-numbers*)
(groups nil)
- (debug-vars (sb!di::debug-function-debug-vars
- debug-function)))
+ (debug-vars (sb!di::debug-fun-debug-vars
+ debug-fun)))
(and debug-vars
(dotimes (debug-var-offset
(length debug-vars)
(and debug-vars
(dotimes (debug-var-offset
(length debug-vars)
-(defun source-available-p (debug-function)
+(defun source-available-p (debug-fun)
- (sb!di:do-debug-function-blocks (block debug-function)
+ (sb!di:do-debug-fun-blocks (block debug-fun)
(declare (ignore block))
(return t))
(sb!di:no-debug-blocks () nil)))
(declare (ignore block))
(return t))
(sb!di:no-debug-blocks () nil)))
;;; disassembly. SFCACHE can be either NIL or it can be a
;;; SOURCE-FORM-CACHE structure, in which case it is used to cache
;;; forms from files.
;;; disassembly. SFCACHE can be either NIL or it can be a
;;; SOURCE-FORM-CACHE structure, in which case it is used to cache
;;; forms from files.
-(defun add-source-tracking-hooks (segment debug-function &optional sfcache)
+(defun add-source-tracking-hooks (segment debug-fun &optional sfcache)
(declare (type segment segment)
(declare (type segment segment)
- (type (or null sb!di:debug-function) debug-function)
+ (type (or null sb!di:debug-fun) debug-fun)
(type (or null source-form-cache) sfcache))
(let ((last-block-pc -1))
(flet ((add-hook (pc fun &optional before-address)
(type (or null source-form-cache) sfcache))
(let ((last-block-pc -1))
(flet ((add-hook (pc fun &optional before-address)
:before-address before-address)
(seg-hooks segment))))
(handler-case
:before-address before-address)
(seg-hooks segment))))
(handler-case
- (sb!di:do-debug-function-blocks (block debug-function)
+ (sb!di:do-debug-fun-blocks (block debug-fun)
(let ((first-location-in-block-p t))
(sb!di:do-debug-block-locations (loc block)
(let ((pc (sb!di::compiled-code-location-pc loc)))
(let ((first-location-in-block-p t))
(sb!di:do-debug-block-locations (loc block)
(let ((pc (sb!di::compiled-code-location-pc loc)))
))))
(sb!di:no-debug-blocks () nil)))))
))))
(sb!di:no-debug-blocks () nil)))))
-(defun add-debugging-hooks (segment debug-function &optional sfcache)
- (when debug-function
+(defun add-debugging-hooks (segment debug-fun &optional sfcache)
+ (when debug-fun
(setf (seg-storage-info segment)
(setf (seg-storage-info segment)
- (storage-info-for-debug-function debug-function))
- (add-source-tracking-hooks segment debug-function sfcache)
- (let ((kind (sb!di:debug-function-kind debug-function)))
+ (storage-info-for-debug-fun debug-fun))
+ (add-source-tracking-hooks segment debug-fun sfcache)
+ (let ((kind (sb!di:debug-fun-kind debug-fun)))
(flet ((anh (n)
(push (make-offs-hook
:offset 0
(flet ((anh (n)
(push (make-offs-hook
:offset 0
(let ((first-block-seen-p nil)
(nil-block-seen-p nil)
(last-offset 0)
(let ((first-block-seen-p nil)
(nil-block-seen-p nil)
(last-offset 0)
- (last-debug-function nil)
(segments nil))
(flet ((add-seg (offs len df)
(when (> len 0)
(push (make-code-segment code offs len
(segments nil))
(flet ((add-seg (offs len df)
(when (> len 0)
(push (make-code-segment code offs len
:source-form-cache sfcache)
segments))))
(dotimes (fmap-index (length function-map))
:source-form-cache sfcache)
segments))))
(dotimes (fmap-index (length function-map))
(when first-block-seen-p
(add-seg last-offset
(- fmap-entry last-offset)
(when first-block-seen-p
(add-seg last-offset
(- fmap-entry last-offset)
- last-debug-function)
- (setf last-debug-function nil))
+ last-debug-fun)
+ (setf last-debug-fun nil))
(setf last-offset fmap-entry))
(setf last-offset fmap-entry))
- (sb!c::compiled-debug-function
- (let ((name (sb!c::compiled-debug-function-name fmap-entry))
- (kind (sb!c::compiled-debug-function-kind fmap-entry)))
+ (sb!c::compiled-debug-fun
+ (let ((name (sb!c::compiled-debug-fun-name fmap-entry))
+ (kind (sb!c::compiled-debug-fun-kind fmap-entry)))
#+nil
(format t ";;; SAW ~S ~S ~S,~S ~D,~D~%"
name kind first-block-seen-p nil-block-seen-p
last-offset
#+nil
(format t ";;; SAW ~S ~S ~S,~S ~D,~D~%"
name kind first-block-seen-p nil-block-seen-p
last-offset
- (sb!c::compiled-debug-function-start-pc fmap-entry))
+ (sb!c::compiled-debug-fun-start-pc fmap-entry))
(cond (#+nil (eq last-offset fun-offset)
(and (equal name fname) (not first-block-seen-p))
(setf first-block-seen-p t))
(cond (#+nil (eq last-offset fun-offset)
(and (equal name fname) (not first-block-seen-p))
(setf first-block-seen-p t))
(return))
(when first-block-seen-p
(setf nil-block-seen-p t))))
(return))
(when first-block-seen-p
(setf nil-block-seen-p t))))
- (setf last-debug-function
- (sb!di::make-compiled-debug-function fmap-entry code))
+ (setf last-debug-fun
+ (sb!di::make-compiled-debug-fun fmap-entry code))
)))))
(let ((max-offset (code-inst-area-length code)))
)))))
(let ((max-offset (code-inst-area-length code)))
- (when (and first-block-seen-p last-debug-function)
+ (when (and first-block-seen-p last-debug-fun)
(add-seg last-offset
(- max-offset last-offset)
(add-seg last-offset
(- max-offset last-offset)
(if (null segments)
(let ((offs (fun-insts-offset function)))
(make-code-segment code offs (- max-offset offs)))
(if (null segments)
(let ((offs (fun-insts-offset function)))
(make-code-segment code offs (- max-offset offs)))
(let ((function-map (code-function-map code))
(sfcache (make-source-form-cache)))
(let ((last-offset 0)
(let ((function-map (code-function-map code))
(sfcache (make-source-form-cache)))
(let ((last-offset 0)
- (last-debug-function nil))
(flet ((add-seg (offs len df)
(let* ((restricted-offs
(min (max start-offset offs)
(flet ((add-seg (offs len df)
(let* ((restricted-offs
(min (max start-offset offs)
(when (> restricted-len 0)
(push (make-code-segment code
restricted-offs restricted-len
(when (> restricted-len 0)
(push (make-code-segment code
restricted-offs restricted-len
:source-form-cache sfcache)
segments)))))
(dotimes (fmap-index (length function-map))
:source-form-cache sfcache)
segments)))))
(dotimes (fmap-index (length function-map))
(etypecase fmap-entry
(integer
(add-seg last-offset (- fmap-entry last-offset)
(etypecase fmap-entry
(integer
(add-seg last-offset (- fmap-entry last-offset)
- last-debug-function)
- (setf last-debug-function nil)
+ last-debug-fun)
+ (setf last-debug-fun nil)
(setf last-offset fmap-entry))
(setf last-offset fmap-entry))
- (sb!c::compiled-debug-function
- (setf last-debug-function
- (sb!di::make-compiled-debug-function fmap-entry
+ (sb!c::compiled-debug-fun
+ (setf last-debug-fun
+ (sb!di::make-compiled-debug-fun fmap-entry
- (when last-debug-function
(add-seg last-offset
(- (code-inst-area-length code) last-offset)
(add-seg last-offset
(- (code-inst-area-length code) last-offset)
- last-debug-function))))))
(if (null segments)
(make-code-segment code start-offset length)
(nreverse segments))))
(if (null segments)
(make-code-segment code start-offset length)
(nreverse segments))))
; from "code/pathname"
("src/code/sharpm" :not-host) ; uses stuff from "code/reader"
; from "code/pathname"
("src/code/sharpm" :not-host) ; uses stuff from "code/reader"
- ;; defines SB!DI:DO-DEBUG-FUNCTION-BLOCKS, needed by target-disassem.lisp
+ ;; defines SB!DI:DO-DEBUG-FUN-BLOCKS, needed by target-disassem.lisp
("src/code/debug-int" :not-host)
;; target-only assemblerish stuff
("src/code/debug-int" :not-host)
;; target-only assemblerish stuff
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)