diff --git a/compiler/codegen.lisp b/compiler/codegen.lisp
index 81cce9f596f5029f0fce3e0a12bcd9dc5262ebfe..465c678a1ec409e36682c3ea332f579c633b9f70 100644
--- a/compiler/codegen.lisp
+++ b/compiler/codegen.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.20 1993/05/05 19:48:39 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.21 1993/05/28 05:22:19 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -249,43 +249,55 @@
 ;;; Convert the list of (label . state) entries into an ivector.
 ;;; 
 (eval-when (compile load eval)
-  (defconstant bits-per-state 3)
-  (defconstant bits-per-entry 16)
-  (defconstant bits-per-offset (- bits-per-entry bits-per-state))
-  (defconstant max-offset (ash 1 bits-per-offset)))
+  (defconstant tt-bits-per-state 3)
+  (defconstant tt-bits-per-entry 16)
+  (defconstant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state))
+  (defconstant tt-max-offset (1- (ash 1 tt-bits-per-offset))))
 ;;;
-(defun pack-trace-table (table)
-  (declare (list table))
-  #+nil
-  (let ((last-posn 0)
-	(last-state 0)
-	(result (make-array (length table)
-			    :element-type '(unsigned-byte #.bits-per-entry)))
-	(index 0))
-    (dolist (entry table)
-      (let* ((posn (label-position (car entry)))
-	     (state (cdr entry)))
+(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))
+;;;
+(defun pack-trace-table (entries)
+  (declare (list entries))
+  (if (backend-featurep :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
-				   '(unsigned-byte #.bits-per-entry))
+				   'tt-entry)
 				  result)))
 		 (setf (aref result index)
-		       (logior (ash offset bits-per-state)
-			       state))
+		       (logior (ash offset tt-bits-per-state) state))
 		 (incf index)))
-	  (do ((offset (- posn last-posn) (- offset max-offset)))
-	      ((< offset max-offset)
-	       (push-entry offset state))
+	  (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 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)))
-	(setf last-posn posn)
-	(setf last-state state)))
-    (if (eql (length result) index)
-	result
-	(subseq result 0 index)))
-  ;; ### Hack 'cause this stuff doesn't work.
-  (declare (ignore table))
-  (make-array 0 :element-type '(unsigned-byte #.bits-per-entry)))
+	(if (eql (length result) index)
+	    result
+	    (subseq result 0 index)))
+      (make-array 0 :element-type 'tt-entry)))