0.8.6.10
[sbcl.git] / src / compiler / trace-table.lisp
1 ;;;; trace tables (from codegen.lisp in CMU CL sources)
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!C")
13
14 (defun trace-table-entry (state)
15   (declare (special *trace-table-info*))
16   (let ((label (gen-label)))
17     (emit-label label)
18     (push (cons label state) *trace-table-info*))
19   (values))
20
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)))
26
27 (deftype tt-state ()
28   `(unsigned-byte ,tt-bits-per-state))
29 (deftype tt-entry ()
30   `(unsigned-byte ,tt-bits-per-entry))
31 (deftype tt-offset ()
32   `(unsigned-byte ,tt-bits-per-offset))
33
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
41   ;; used in SBCL.)
42   (make-array 0 :element-type 'tt-entry))