(defconstant lra-size (words-to-bytes 1))
\f
-(defstruct offs-hook
+(defstruct (offs-hook (:copier nil))
(offset 0 :type offset)
(function (required-argument) :type function)
(before-address nil :type (member t nil)))
(defstruct (segment (:conc-name seg-)
- (:constructor %make-segment))
+ (:constructor %make-segment)
+ (:copier nil))
(sap-maker (required-argument)
:type (function () sb!sys:system-area-pointer))
(length 0 :type length)
;;; information so that we can allow garbage collect during disassembly and
;;; not get tripped up by a code block being moved...
(defstruct (disassem-state (:conc-name dstate-)
- (:constructor %make-dstate))
+ (:constructor %make-dstate)
+ (:copier nil))
(cur-offs 0 :type offset) ; offset of current pos in segment
(next-offs 0 :type offset) ; offset of next position
(when (null plen)
(setf plen location-column-width)
- (set-location-printing-range dstate
- (seg-virtual-location (dstate-segment dstate))
- (seg-length (dstate-segment dstate))))
+ (let ((seg (dstate-segment dstate)))
+ (set-location-printing-range dstate
+ (seg-virtual-location seg)
+ (seg-length seg))))
(when (eq (dstate-output-state dstate) :beginning)
(setf plen location-column-width))
(fresh-line stream)
- ;; MNA: compiler message patch
(setf location-column-width (+ 2 location-column-width))
(princ "; " stream)
(with-print-restrictions
(dolist (note (dstate-notes dstate))
(format stream "~Vt; " *disassem-note-column*)
- ;; MNA: compiler message patch
(pprint-logical-block (stream nil :per-line-prefix "; ")
(etypecase note
(string
\f
;;; getting at the source code...
-(defstruct (source-form-cache (:conc-name sfcache-))
+(defstruct (source-form-cache (:conc-name sfcache-)
+ (:copier nil))
(debug-source nil :type (or null sb!di:debug-source))
(top-level-form-index -1 :type fixnum)
(top-level-form nil :type list)
(form-number-mapping-table nil :type (or null (vector list)))
(last-location-retrieved nil :type (or null sb!di:code-location))
- (last-form-retrieved -1 :type fixnum)
- )
+ (last-form-retrieved -1 :type fixnum))
(defun get-top-level-form (debug-source tlf-index)
(let ((name (sb!di:debug-source-name debug-source)))
(declare (type sb!kernel:code-component code))
(sb!di::get-debug-info-function-map (sb!kernel:%code-debug-info code)))
-(defstruct location-group
- (locations #() :type (vector (or list fixnum)))
- )
+(defstruct (location-group (:copier nil))
+ (locations #() :type (vector (or list fixnum))))
-(defstruct storage-info
+(defstruct (storage-info (:copier nil))
(groups nil :type list) ; alist of (name . location-group)
(debug-vars #() :type vector))
\f
;;; routines to find things in the Lisp environment
-(defconstant groked-symbol-slots
+;;; an alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUNCTION-NAME) for slots
+;;; in a symbol object that we know about
+(defparameter *grokked-symbol-slots*
(sort `((,sb!vm:symbol-value-slot . symbol-value)
(,sb!vm:symbol-plist-slot . symbol-plist)
(,sb!vm:symbol-name-slot . symbol-name)
(,sb!vm:symbol-package-slot . symbol-package))
#'<
- :key #'car)
- #!+sb-doc
- "An alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUNCTION-NAME) for slots in a
-symbol object that we know about.")
+ :key #'car))
+;;; Given ADDRESS, try and figure out if which slot of which symbol is
+;;; being referred to. Of course we can just give up, so it's not a
+;;; big deal... Return two values, the symbol and the name of the
+;;; access function of the slot.
(defun grok-symbol-slot-ref (address)
- #!+sb-doc
- "Given ADDRESS, try and figure out if which slot of which symbol is being
- refered to. Of course we can just give up, so it's not a big deal...
- Returns two values, the symbol and the name of the access function of the
- slot."
(declare (type address address))
(if (not (aligned-p address sb!vm:word-bytes))
(values nil nil)
- (do ((slots-tail groked-symbol-slots (cdr slots-tail)))
+ (do ((slots-tail *grokked-symbol-slots* (cdr slots-tail)))
((null slots-tail)
(values nil nil))
(let* ((field (car slots-tail))
(defvar *address-of-nil-object* (sb!kernel:get-lisp-obj-address nil))
+;;; Given a BYTE-OFFSET from NIL, try and figure out which slot of
+;;; which symbol is being referred to. Of course we can just give up,
+;;; so it's not a big deal... Return two values, the symbol and the
+;;; access function.
(defun grok-nil-indexed-symbol-slot-ref (byte-offset)
- #!+sb-doc
- "Given a BYTE-OFFSET from NIL, try and figure out if which slot of which
- symbol is being refered to. Of course we can just give up, so it's not a big
- deal... Returns two values, the symbol and the access function."
(declare (type offset byte-offset))
(grok-symbol-slot-ref (+ *address-of-nil-object* byte-offset)))
+;;; Return the Lisp object located BYTE-OFFSET from NIL.
(defun get-nil-indexed-object (byte-offset)
- #!+sb-doc
- "Returns the lisp object located BYTE-OFFSET from NIL."
(declare (type offset byte-offset))
(sb!kernel:make-lisp-obj (+ *address-of-nil-object* byte-offset)))
+;;; Return two values; the Lisp object located at BYTE-OFFSET in the
+;;; constant area of the code-object in the current segment and T, or
+;;; NIL and NIL if there is no code-object in the current segment.
(defun get-code-constant (byte-offset dstate)
#!+sb-doc
- "Returns two values; the lisp-object located at BYTE-OFFSET in the constant
- area of the code-object in the current segment and T, or NIL and NIL if
- there is no code-object in the current segment."
(declare (type offset byte-offset)
(type disassem-state dstate))
(let ((code (seg-code (dstate-segment dstate))))
(defvar *assembler-routines-by-addr* nil)
+;;; Return the name of the primitive Lisp assembler routine located at
+;;; ADDRESS, or NIL if there isn't one.
(defun find-assembler-routine (address)
- #!+sb-doc
- "Returns the name of the primitive lisp assembler routine located at
- ADDRESS, or NIL if there isn't one."
(declare (type address address))
(when (null *assembler-routines-by-addr*)
(setf *assembler-routines-by-addr* (make-hash-table))
projects / sbcl.git / blobdiff