1 ;;;; trace tables (from codegen.lisp in CMU CL sources)
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 (defun trace-table-entry (state)
15 (declare (special *trace-table-info
*))
16 (let ((label (gen-label)))
18 (push (cons label state
) *trace-table-info
*))
21 (def!constant tt-bits-per-state
3)
22 (def!constant tt-bytes-per-entry
2)
23 (def!constant tt-bits-per-entry
(* tt-bytes-per-entry sb
!vm
:n-byte-bits
))
24 (def!constant tt-bits-per-offset
(- tt-bits-per-entry tt-bits-per-state
))
25 (def!constant tt-max-offset
(1- (ash 1 tt-bits-per-offset
)))
28 `(unsigned-byte ,tt-bits-per-state
))
30 `(unsigned-byte ,tt-bits-per-entry
))
32 `(unsigned-byte ,tt-bits-per-offset
))
34 ;;; Convert the list of (LABEL . STATE) entries into an ivector.
35 (declaim (ftype (function (list) (simple-array tt-entry
1)) pack-trace-table
))
36 (defun pack-trace-table (entries)
37 (declare (list entries
))
38 (declare (ignore entries
))
39 ;; (This was interesting under the old CMU CL generational garbage
40 ;; collector (GENGC) but is trivial under the GC implementations
42 (make-array 0 :element-type
'tt-entry
))