-;;;; unpacking minimal debug functions
-
-(eval-when (:compile-toplevel :execute)
-
-;;; sleazoid "macro" to keep our indentation sane in UNCOMPACT-FUNCTION-MAP
-(sb!xc:defmacro make-uncompacted-debug-fun ()
- '(sb!c::make-compiled-debug-function
- :name
- (let ((base (ecase (ldb sb!c::minimal-debug-function-name-style-byte
- options)
- (#.sb!c::minimal-debug-function-name-symbol
- (intern (sb!c::read-var-string map i)
- (sb!c::compiled-debug-info-package info)))
- (#.sb!c::minimal-debug-function-name-packaged
- (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
- (make-symbol (sb!c::read-var-string map i)))
- (#.sb!c::minimal-debug-function-name-component
- (sb!c::compiled-debug-info-name info)))))
- (if (logtest flags sb!c::minimal-debug-function-setf-bit)
- `(setf ,base)
- base))
- :kind (svref sb!c::*minimal-debug-function-kinds*
- (ldb sb!c::minimal-debug-function-kind-byte options))
- :variables
- (when vars-p
- (let ((len (sb!c::read-var-integer map i)))
- (prog1 (subseq map i (+ i len))
- (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
- :standard)
- (#.sb!c::minimal-debug-function-returns-fixed
- :fixed)
- (#.sb!c::minimal-debug-function-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)
- :nfp (when (logtest flags sb!c::minimal-debug-function-nfp-bit)
- (sb!c::read-var-integer map i))
- :start-pc
- (progn
- (setq code-start-pc (+ code-start-pc (sb!c::read-var-integer map i)))
- (+ code-start-pc (sb!c::read-var-integer map i)))
- :elsewhere-pc
- (setq elsewhere-pc (+ elsewhere-pc (sb!c::read-var-integer map i)))))
-
-) ; 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.
-;;;
-;;; FIXME: This and its helper macro just above become dead code now
-;;; that we no longer use compacted function maps.
-(defun uncompact-function-map (info)
- (declare (type sb!c::compiled-debug-info info))
-
- ;; (This is stubified until we solve the problem of representing
- ;; debug information in a way which plays nicely with package renaming.)
- (error "FIXME: dead code UNCOMPACT-FUNCTION-MAP (was stub)")
-
- (let* ((map (sb!c::compiled-debug-info-function-map info))
- (i 0)
- (len (length map))
- (code-start-pc 0)
- (elsewhere-pc 0))
- (declare (type (simple-array (unsigned-byte 8) (*)) map))
- (sb!int:collect ((res))
- (loop
- (when (= i len) (return))
- (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))
- (dfun (make-uncompacted-debug-fun)))
- (res code-start-pc)
- (res dfun)))
-
- (coerce (cdr (res)) 'simple-vector))))
-
-;;; a map from minimal DEBUG-INFO function maps to unpacked
-;;; versions thereof
-(defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
-
-;;; 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
-;;; 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
-;;; can be deleted.
-(defun get-debug-info-function-map (info)
- (declare (type sb!c::compiled-debug-info info))
- (let ((map (sb!c::compiled-debug-info-function-map info)))
- (if (simple-vector-p map)
- map
- (or (gethash map *uncompacted-function-maps*)
- (setf (gethash map *uncompacted-function-maps*)
- (uncompact-function-map info))))))
-\f