(in-package "SB!C")
(defun trace-table-entry (state)
+ (declare (special *trace-table-info*))
(let ((label (gen-label)))
(emit-label label)
(push (cons label state) *trace-table-info*))
(values))
-;;; Convert the list of (label . state) entries into an ivector.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant tt-bits-per-state 3)
- (defconstant tt-bytes-per-entry 2)
- (defconstant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:byte-bits))
- (defconstant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state))
- (defconstant tt-max-offset (1- (ash 1 tt-bits-per-offset))))
+(def!constant tt-bits-per-state 3)
+(def!constant tt-bytes-per-entry 2)
+(def!constant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:n-byte-bits))
+(def!constant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state))
+(def!constant tt-max-offset (1- (ash 1 tt-bits-per-offset)))
+
(deftype tt-state ()
`(unsigned-byte ,tt-bits-per-state))
(deftype tt-entry ()
`(unsigned-byte ,tt-bits-per-entry))
(deftype tt-offset ()
`(unsigned-byte ,tt-bits-per-offset))
+
+;;; Convert the list of (LABEL . STATE) entries into an ivector.
(declaim (ftype (function (list) (simple-array tt-entry 1)) pack-trace-table))
(defun pack-trace-table (entries)
(declare (list entries))
- #!-gengc (declare (ignore entries))
- #!+gengc (let ((result (make-array (logandc2 (1+ (length entries)) 1)
- :element-type 'tt-entry))
- (index 0)
- (last-posn 0)
- (last-state 0))
- (declare (type index index last-posn)
- (type tt-state last-state))
- (flet ((push-entry (offset state)
- (declare (type tt-offset offset)
- (type tt-state state))
- (when (>= index (length result))
- (setf result
- (replace (make-array
- (truncate (* (length result) 5) 4)
- :element-type
- 'tt-entry)
- result)))
- (setf (aref result index)
- (logior (ash offset tt-bits-per-state) state))
- (incf index)))
- (dolist (entry entries)
- (let* ((posn (label-position (car entry)))
- (state (cdr entry)))
- (declare (type index posn) (type tt-state state))
- (assert (<= last-posn posn))
- (do ((offset (- posn last-posn) (- offset tt-max-offset)))
- ((< offset tt-max-offset)
- (push-entry offset state))
- (push-entry tt-max-offset last-state))
- (setf last-posn posn)
- (setf last-state state)))
- (when (oddp index)
- (push-entry 0 last-state)))
- (if (eql (length result) index)
- result
- (subseq result 0 index)))
- #!-gengc (make-array 0 :element-type 'tt-entry))
+ (declare (ignore entries))
+ ;; (This was interesting under the old CMU CL generational garbage
+ ;; collector (GENGC) but is trivial under the GC implementations
+ ;; used in SBCL.)
+ (make-array 0 :element-type 'tt-entry))