X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftrace-table.lisp;h=f006add74449a8eee72be2720a31aa0d1d1bdc01;hb=8731c1a7c1a585d190151fa881050fb5e14c0616;hp=1f93fb45730ad0ab81a6f8ddce0bf162580b7231;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/compiler/trace-table.lisp b/src/compiler/trace-table.lisp
index 1f93fb4..f006add 100644
--- a/src/compiler/trace-table.lisp
+++ b/src/compiler/trace-table.lisp
@@ -12,62 +12,31 @@
 (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))