From 5cbacefab1bd7e00876563bf736d4db82752f65b Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 28 May 1993 05:20:44 +0000
Subject: [PATCH] Moved the compiled-frame-saved-state-chain to the end of the
 struct so that we don't have to recompile other files.  Wrote trace table
 groveling stuff.

---
 code/debug-int.lisp | 37 +++++++++++++++++++++++++++----------
 1 file changed, 27 insertions(+), 10 deletions(-)

diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index b6aa62fe7..03da38fd4 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.58 1993/05/27 01:36:06 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.59 1993/05/28 05:20:44 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -356,16 +356,16 @@
 				   #+gengc saved-state-chain
 				   &optional escaped)))
   ;;
-  ;; List of saps to saved states.  Each time we unwind past an exception,
-  ;; we pop the next entry off this list.  When we get to the end of the
-  ;; list, there is nothing else on the stack.
-  #+gengc (saved-state-chain nil :type list)
-  ;;
   ;; Indicates whether someone interrupted frame.  (unexported).
   ;; If escaped, this is a pointer to the state that was saved when we were
   ;; interrupted.  On the non-gengc system, this is a sigcontext pointer.
   ;; On the gengc system, this is a state pointer from saved-state-chain.
-  escaped)
+  escaped
+  ;;
+  ;; List of saps to saved states.  Each time we unwind past an exception,
+  ;; we pop the next entry off this list.  When we get to the end of the
+  ;; list, there is nothing else on the stack.
+  #+gengc (saved-state-chain nil :type list))
 
 (defun print-compiled-frame (obj str n)
   (declare (ignore n))
@@ -1146,9 +1146,26 @@
 (defun lookup-trace-table-entry (component pc)
   (declare (type code-component component)
 	   (type unsigned-byte pc))
-  ;; ### Need to do something real.
-  (declare (ignore component pc))
-  (random 4))
+  (let ((tt (system:sap+ (kernel:code-instructions component)
+			 (kernel:code-header-ref
+			  component
+			  vm:code-trace-table-offset-slot)))
+	(end (system:sap+ (kernel:code-instructions component)
+			  (* (kernel:%code-code-size component)
+			     vm:word-bytes))))
+    (iterate repeat ((sap tt) (offset 0) (state vm:trace-table-normal))
+      (cond ((> offset pc)
+	     state)
+	    ((system:sap< sap end)
+	     (let ((entry (system:sap-ref-16 tt 0)))
+	       (repeat (system:sap+ sap 2)
+		       (+ offset
+			  (ldb (byte c::tt-bits-per-offset
+				     c::tt-bits-per-state)
+			       entry))
+		       (ldb (byte c::tt-bits-per-state 0) entry))))
+	    (t
+	     vm:trace-table-normal)))))
 
 ;;; EXTRACT-INFO-FROM-STATE -- internal.
 ;;;
-- 
GitLab