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   (let ((label (gen-label)))
  16     (emit-label label)
  17     (push (cons label state) *trace-table-info*))
  18   (values))
  19
  20 (defconstant tt-bits-per-state 3)
  21 (defconstant tt-bytes-per-entry 2)
  22 (defconstant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:n-byte-bits))
  23 (defconstant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state))
  24 (defconstant tt-max-offset (1- (ash 1 tt-bits-per-offset)))
  25
  26 (deftype tt-state ()
  27   `(unsigned-byte ,tt-bits-per-state))
  28 (deftype tt-entry ()
  29   `(unsigned-byte ,tt-bits-per-entry))
  30 (deftype tt-offset ()
  31   `(unsigned-byte ,tt-bits-per-offset))
  32
  33 ;;; Convert the list of (LABEL . STATE) entries into an ivector.
  34 (declaim (ftype (function (list) (simple-array tt-entry 1)) pack-trace-table))
  35 (defun pack-trace-table (entries)
  36   (declare (list entries))
  37   (declare (ignore entries))
  38   ;; (This was interesting under the old CMU CL generational garbage
  39   ;; collector (GENGC) but is trivial under the GC implementations
  40   ;; used in SBCL.)
  41   (make-array 0 :element-type 'tt-entry))