diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index d9d753a6d767a85d1ccb5f556a82ccd5ceceedf0..0274b12f20c35222af581f32a2c5060411c8e866 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -1,11 +1,11 @@
-;;; -*- Mode: completion; Log: code.log; Package: DI -*-
+;;; -*- Mode: Lisp; Log: code.log; Package: DI -*-
 ;;;
 ;;; **********************************************************************
 ;;; This code was written as part of the CMU Common Lisp project at
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.76 1997/11/18 10:47:56 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.77 1997/11/25 16:18:44 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -14,7 +14,7 @@
 ;;;
 ;;; Written by Bill Chiles and Rob Maclachlan.
 ;;;
-;;; Enhancements/debugging for the x86 port by Douglas Crosher 1996, 1997.
+;;; X86 support by Douglas Crosher 1996,1997.
 
 (in-package "DEBUG-INTERNALS")
 
@@ -837,10 +837,8 @@
 (defun kernel:function-word-offset (fun) (kernel:function-word-offset fun))
 ;;;
 (defsetf kernel:stack-ref kernel:%set-stack-ref)
-
+
 (proclaim '(inline cstack-pointer-valid-p))
-;;; This must come before any use (of course) else the cross compiler
-;;; uses it's own version which is WRONG for x86!!!
 (defun cstack-pointer-valid-p (x)
   (declare (type system:system-area-pointer x))
   #-:x86
@@ -857,181 +855,121 @@
 		      x)
        (zerop (logand (system:sap-int x) #b11))))
 
-;;;; X86 support. Don't have lra objects so will search back for code header.
-
-(eval-when (compile eval)
-  (defmacro c-var-frob (lisp-fun c-var-name)
-    `(progn
-       (declaim (inline ,lisp-fun))
-       (defun ,lisp-fun ()
-	 (alien:extern-alien ,c-var-name (alien:unsigned 32))))))
-
-(c-var-frob static-space-start "static_space")
-(c-var-frob read-only-space-start "read_only_space")
-
-(defun compiled-function-from-pc (pc &optional (limit 50000))
-  ;;; x86 hack around not having lra objects.
-  (declare (type system-area-pointer pc)
-	   (fixnum limit))
-  (let ((base (int-sap (kernel:32bit-logical-and
-			(sap-int pc)
-			(kernel:32bit-logical-not vm:lowtag-mask)))))
-    (declare (type system-area-pointer base))
-    (do ((hdrp (- (sap-int base) vm:word-bytes)
-	       (- hdrp vm:word-bytes))
-	 (times limit (1- times)))
-	((or (zerop times)
-	     (> (read-only-space-start) hdrp))
-	 nil)
-      (declare (type (unsigned-byte 32) hdrp)
-	       (fixnum times))
-      (let ((hdrval (sap-ref-32 (int-sap hdrp) 0)))
-	(declare (type (unsigned-byte 32) hdrval))
-	#+nil (format t "~&~x ~x~%" hdrp hdrval)
-	(when (and (= (kernel:32bit-logical-and hdrval vm:type-mask)
-		      vm:function-header-type)
-		   (= (sap-ref-32 (int-sap hdrp)
-				  (* vm:function-self-slot vm:word-bytes))
-		      (+ hdrp (* vm:function-code-offset vm:word-bytes))))
-	  (let ((maybe-fcn (kernel:make-lisp-obj
-			    (+ hdrp vm:function-pointer-type))))
-	    (when (and (functionp maybe-fcn) (compiled-function-p maybe-fcn))
-	      (return maybe-fcn))))))))
+#+(or gengc x86)
+(alien:def-alien-routine component-ptr-from-pc (system:system-area-pointer)
+  (pc system:system-area-pointer))
 
+#+(or gengc x86)
+(defun component-from-component-ptr (component-ptr)
+  (declare (type system:system-area-pointer component-ptr))
+  (kernel:make-lisp-obj
+   (logior (system:sap-int component-ptr)
+	   vm:other-pointer-type)))
 
+;;;; X86 support.
 
+#+x86
 (defun compute-lra-data-from-pc(pc)
-  ;; pc is offset from dualword aligned function header
   (declare (type system-area-pointer pc))
-  (let ((function (compiled-function-from-pc pc)))
-    (when function
-      (let* ((code (kernel:function-code-header function))
-	     (code-header-len (* (kernel:get-header-data code)
-				 vm:word-bytes))
-	     (pc-offset
-	      (- (sap-int pc)
-		 (- (kernel:get-lisp-obj-address code)
-		    vm:other-pointer-type)
-		 code-header-len)))
-;	(format t "c-lra-fpc ~a ~a ~a~%" pc code pc-offset)
-	(values pc-offset code)))))
-
-#+x86
-(defun stack-ref-32 (stack offset)
-  (declare (type sys:system-area-pointer stack)
-	   (type fixnum offset)
-	   (optimize (speed 3) (safety 0)))
-  (kernel::get-lisp-obj-address (stack-ref stack offset)))
-
-;;; maybe these should be generalized in xxx-vm.lisp
-;;;(proclaim '(inline old-frame-pointer lisp-return-pc))
-(defun old-frame-pointer(scp)
-  (declare (type (alien:alien (* unix:sigcontext)) scp))
-  (let* #+x86 ((cfp (vm:sigcontext-register scp vm::ebp-offset))
-	       (ofp (stack-ref-32 (int-sap cfp) vm::ocfp-save-offset)))
-	#-x86 ((ofp (vm:sigcontext-register scp vm::ocfp-offset)))
-	(declare (type (unsigned-byte 32) #+x86 cfp ofp))
-	(int-sap ofp)))
+  (let ((component-ptr (component-ptr-from-pc pc)))
+    (unless (sap= component-ptr (int-sap #x0))
+       (let* ((code (component-from-component-ptr component-ptr))
+	      (code-header-len (* (kernel:get-header-data code) vm:word-bytes))
+	      (pc-offset (- (sap-int pc)
+			    (- (kernel:get-lisp-obj-address code)
+			       vm:other-pointer-type)
+			    code-header-len)))
+;	 (format t "c-lra-fpc ~a ~a ~a~%" pc code pc-offset)
+	 (values pc-offset code)))))
 
 
 #+x86
-(defun lisp-return-pc(scp)
-  ;;; return a value that can be used in computation
-  (declare (type (alien:alien (* unix:sigcontext)) scp))
-  (let* ((cfp (vm:sigcontext-register scp vm::ebp-offset))
-	 (lra (stack-ref-32 (int-sap cfp) vm::return-pc-save-offset)))
-    lra))
-#-x86
-(defun lisp-return-pc(scp)
-  (declare (type (alien:alien (* unix:sigcontext)) scp))
-  (vm:sigcontext-register scp vm::lra-offset))
+(defconstant vm::nargs-offset #.vm::ecx-offset)
 
+;;; Check for a valid return address - it could be any valid C/Lisp
+;;; address.
+;;;
+;;; XX Could be a little smarter.
 #+x86
-(defconstant vm::nargs-offset #.vm::ecx-offset)
+(proclaim '(inline cstack-pointer-valid-p))
 #+x86
-(progn
-(defun lisp-return-pc-valid-p(loc)
-  (declare (type system-area-pointer loc))
-  (let ((code-beg (int-sap (static-space-start)))
-	(code-end (int-sap (* lisp::*static-space-free-pointer*
-			      vm:word-bytes))))
-    (and (sap< code-beg loc)
-	 (sap< loc code-end))))
-
-(declaim (inline make-fixnum))
-(defun make-fixnum (sap)
-  (kernel:make-lisp-obj (ash (sap-int sap) 2)))
-
-;; These return hopefully correct ofp ret values at a call site
-(defun maybe-lisp-from-c(fp)
-  (declare (type system-area-pointer fp))
-  (let ((s0 (stack-ref-32 fp vm::ocfp-save-offset))
-	(s1 (stack-ref-32 fp vm::return-pc-save-offset)))
-    (when (and (kernel:make-lisp-obj s0)(kernel:make-lisp-obj s1))
-      (let ((lisp-ofp (int-sap s0))
-	    (lisp-lra (int-sap s1)))
-	;;(format t "~&cf? ~a ~a~%" lisp-ofp lisp-lra)
-	;; Check  this logic now that C calls with lra.
-	(when (sap= lisp-ofp lisp-lra)	; Can't happen via Lisp
-	  (let ((cfp (sap-ref-sap fp (* 0 vm:word-bytes)))
-		(cra (sap-ref-sap fp (* 1 vm:word-bytes))))
-	    ;;(format t "~&cf! ~a ~a~%" cfp cra)
-	    (list (make-fixnum cra) cfp)))))))
-
-(defun maybe-lisp-from-lisp(fp)
-    (declare (type system-area-pointer fp))
-    (when (cstack-pointer-valid-p fp)
-      (let ((s0 (stack-ref-32 fp vm::ocfp-save-offset))
-	    (s1 (stack-ref-32 fp vm::return-pc-save-offset)))
-	(when (and (kernel:make-lisp-obj s0)
-		   (kernel:make-lisp-obj s1))
-	  (let ((ofp (int-sap s0))
-		(lra (int-sap s1)))
-	    ;;(format t "~&mlf ~a ~a~%" ofp lra)
-	    (and (cstack-pointer-valid-p ofp)
-		 (lisp-return-pc-valid-p lra)
-		 (list (kernel:make-lisp-obj s1) ofp)))))))
-
-(defun maybe-c-from-c(fp)
-  (declare (type system-area-pointer fp))
-  (let ((cfp (sap-ref-sap fp (* 0 vm:word-bytes)))
-	(cra (sap-ref-sap fp (* 1 vm:word-bytes)))
-	(end (int-sap (* lisp::*static-space-free-pointer* vm:word-bytes))))
-    ;;(format t "~&cfc? ~a ~a" cfp cra)
-    (when (cstack-pointer-valid-p cfp)
-      (cond ((sap< cra (int-sap (static-space-start)))
-	     ;;(format t "~&cfc!~%")
-	     (list (make-fixnum cra) cfp))
-	  ;; sigtrap handler from interrupt
-	  ((sap> cra end)
-	   ;;(format t "~&INT~%")
-	   (list nil cfp))))))
-
-;;; ^C a running program and get C call semantics with Lisp return address.
-(defun maybe-c-from-lisp(fp)
-  (declare (type system-area-pointer fp))
-  (let ((cfp (sap-ref-sap fp (* 0 vm:word-bytes)))
-	(cra (sap-ref-sap fp (* 1 vm:word-bytes)))
-	(end (int-sap (* lisp::*static-space-free-pointer* vm:word-bytes))))
-    ;;(format t "~&cfl? ~a ~a" cfp cra)
-    (when (cstack-pointer-valid-p cfp)
-      (cond ((sap< cra end)
-	     ;;(format t "~&cfl!~%")
-	     (list (make-fixnum cra) cfp))))))
-
-(defun x86-call-context(fp)
-  (declare (type system-area-pointer fp))
-  (let ((pair (cond ((maybe-lisp-from-lisp fp))
-		    ((maybe-lisp-from-c fp))
-		    ((maybe-c-from-c fp))
-		    ((maybe-c-from-lisp fp)))))
-    (if pair
-      (apply #'values pair)
-      (error "Debug can't resolve frame ~a" fp))))
-)
-;;; end of x86 hacks
-
+(defun ra-pointer-valid-p (ra)
+  (declare (type system:system-area-pointer ra))
+  ;; Not a Lisp stack pointer.
+  (or (system:sap< ra (kernel:current-sp))
+      (system:sap> ra (alien:alien-sap
+		       (alien:extern-alien "control_stack_end" (* t))))))
 
+;;; Try to find a valid previous stack. This is complex on the x86 as
+;;; it can jump between C and Lisp frames. To help find a valid frame
+;;; it searches backwards.
+;;;
+;;; XX Should probably check if it has reached the bottom of the
+;;; stack.
+;;;
+;;; XX Should handle interrupted frames, both Lisp and C. A present it
+;;; manages to find a fp trail, see linux hack below.
+;;;
+#+x86
+(defun x86-call-context (fp &key (depth 8))
+  (declare (type system-area-pointer fp)
+	   (fixnum depth))
+;  (format t "*CC ~s ~s~%" fp depth)
+  (cond
+   ((not (cstack-pointer-valid-p fp))
+    (format t "Debug invalid fp ~s~%" fp)
+    nil)
+   (t
+    ;; Check the two possible frame pointers.
+    (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ vm::ocfp-save-offset) 4))))
+	  (lisp-ra (sap-ref-sap fp (- (* (1+ vm::return-pc-save-offset) 4))))
+	  (c-ocfp (sap-ref-sap fp (* 0 vm:word-bytes)))
+	  (c-ra (sap-ref-sap fp (* 1 vm:word-bytes))))
+      (cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
+		  (ra-pointer-valid-p lisp-ra)
+		  (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
+		  (ra-pointer-valid-p c-ra))
+;	     (format t "*C Both valid ~s ~s ~s ~s~%"
+;		     lisp-ocfp lisp-ra c-ocfp c-ra)
+	     ;; Look forward another step to check their validity.
+	     (let ((lisp-path-fp (x86-call-context lisp-ocfp
+						   :depth (- depth 1)))
+		   (c-path-fp (x86-call-context c-ocfp :depth (- depth 1))))
+	       (cond ((and lisp-path-fp c-path-fp)
+		      ;; Both still seem valid - choose the smallest.
+		      (format t "Debug: Both still valid ~s ~s ~s ~s~%"
+			      lisp-ocfp lisp-ra c-ocfp c-ra)
+		      (if (sap< lisp-ocfp c-ocfp)
+			  (values lisp-ra lisp-ocfp)
+			(values c-ra c-ocfp)))
+		     (lisp-path-fp
+		      ;; The lisp convention is looking good.
+;		      (format t "*C lisp-ocfp ~s ~s~%" lisp-ocfp lisp-ra)
+		      (values lisp-ra lisp-ocfp))
+		     (c-path-fp
+		      ;; The C convention is looking good.
+;		      (format t "*C c-ocfp ~s ~s~%" c-ocfp c-ra)
+		      (values c-ra c-ocfp))
+		     (t
+		      ;; Neither seems right?
+;		      (format t "Debug: no valid2 fp found ~s ~s~%"
+;			      lisp-ocfp c-ocfp)
+		      nil))))
+	    ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
+		  (ra-pointer-valid-p lisp-ra))
+	     ;; The lisp convention is looking good.
+;	     (format t "*C lisp-ocfp ~s ~s~%" lisp-ocfp lisp-ra)
+	     (values lisp-ra lisp-ocfp))
+	    ((and (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
+		  #-linux (ra-pointer-valid-p c-ra))
+	     ;; The C convention is looking good.
+;	     (format t "*C c-ocfp ~s ~s~%" c-ocfp c-ra)
+	     (values c-ra c-ocfp))
+	    (t
+;	     (format t "Debug: no valid fp found ~s ~s~%" lisp-ocfp c-ocfp)
+	     nil))))))
+
+
 ;;; DESCRIPTOR-SAP -- internal
 ;;;
 ;;; Convert the descriptor into a SAP.  The bits all stay the same, we just
@@ -1050,7 +988,8 @@
 		       (kernel:%caller-frame-and-pc)
     (possibly-an-interpreted-frame
      (compute-calling-frame (descriptor-sap fp)
-			    #-gengc pc #+gengc (descriptor-sap pc)
+			    #-(or gengc x86) pc
+			    #+(or gengc x86) (descriptor-sap pc)
 			    nil)
      nil)))
 
@@ -1084,7 +1023,7 @@
 				 debug-fun)))
 		     (possibly-an-interpreted-frame
 		      (compute-calling-frame
-		       ( #-x86 descriptor-sap #+x86 int-sap
+		       (descriptor-sap
 			(get-context-value
 			 real vm::ocfp-save-offset
 			 (c::compiled-debug-function-old-fp c-d-f)))
@@ -1147,18 +1086,37 @@
 	(escaped (compiled-frame-escaped frame)))
     (if escaped
 	(ecase stack-slot
-	  (#.vm::ocfp-save-offset
-	   (sub-access-debug-var-slot pointer loc escaped))
-	  (#.vm::lra-save-offset
-	   (kernel:make-lisp-obj
-	    (sub-access-debug-var-slot pointer loc escaped))))
-	(ecase stack-slot
-	  (#.vm::ocfp-save-offset
-	   (stack-ref-32 pointer stack-slot))
-	  (#.vm::lra-save-offset
-	   (kernel:stack-ref pointer stack-slot))))))
+	       (#.vm::ocfp-save-offset
+		(sub-access-debug-var-slot pointer loc escaped))
+	       (#.vm::lra-save-offset
+;		(format t "escaped ra: pointer=~s loc=~s (~s ~s)~%"
+;			pointer loc
+;			(c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		(case (c::sc-offset-scn loc)
+		      ((#.vm:any-reg-sc-number #.vm:descriptor-reg-sc-number)
+		       (format t "escaped ra: pointer=~s loc=~s (~s ~s)~%"
+			       pointer loc
+			       (c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		       ;; Translate to sap-reg at the same offset.
+		       (setf loc (c::make-sc-offset vm:sap-reg-sc-number
+						    (c:sc-offset-scn loc))))
+		      (#.vm:control-stack-sc-number
+		       ;; Translate to sap-stack at the same offset.
+		       (setf loc (c::make-sc-offset vm:sap-stack-sc-number
+						    (c:sc-offset-offset loc))))
+		      (t
+		       (format t "unexpected RA sc location?~%")))
+;		(format t " translated to loc=~s (~s ~s)~%" loc
+;			(c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		(sub-access-debug-var-slot pointer loc escaped)))
+      (ecase stack-slot
+	     (#.vm::ocfp-save-offset
+	      (kernel:stack-ref pointer stack-slot))
+	     (#.vm::lra-save-offset
+	      (sap-ref-sap pointer (- (* (1+ stack-slot) 4))))))))
 
 ;;;
+#-x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
 	   (type c::sc-offset loc))
@@ -1168,6 +1126,43 @@
 	(sub-set-debug-var-slot pointer loc value escaped)
 	(setf (kernel:stack-ref pointer stack-slot) value))))
 
+#+x86
+(defun (setf get-context-value) (value frame stack-slot loc)
+  (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
+	   (type c::sc-offset loc))
+  (let ((pointer (frame-pointer frame))
+	(escaped (compiled-frame-escaped frame)))
+    (if escaped
+	(ecase stack-slot
+	       (#.vm::ocfp-save-offset
+		(sub-set-debug-var-slot pointer loc value escaped))
+	       (#.vm::lra-save-offset
+;		(format t "escaped ra: pointer=~s loc=~s (~s ~s)~%"
+;			pointer loc
+;			(c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		(case (c::sc-offset-scn loc)
+		      ((#.vm:any-reg-sc-number #.vm:descriptor-reg-sc-number)
+		       (format t "escaped ra: pointer=~s loc=~s (~s ~s)~%"
+			       pointer loc
+			       (c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		       ;; Translate to sap-reg at the same offset.
+		       (setf loc (c::make-sc-offset vm:sap-reg-sc-number
+						    (c:sc-offset-scn loc))))
+		      (#.vm:control-stack-sc-number
+		       ;; Translate to sap-stack at the same offset.
+		       (setf loc (c::make-sc-offset vm:sap-stack-sc-number
+						    (c:sc-offset-offset loc))))
+		      (t
+		       (format t "unexpected RA sc location?~%")))
+;		(format t " translated to loc=~s (~s ~s)~%" loc
+;			(c:sc-offset-scn loc) (c::sc-offset-offset loc))
+		(sub-set-debug-var-slot pointer loc value escaped)))
+      (ecase stack-slot
+	     (#.vm::ocfp-save-offset
+	      (setf (kernel:stack-ref pointer stack-slot) value))
+	     (#.vm::lra-save-offset
+	      (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
+
 
 (defvar *debugging-interpreter* nil
   "When set, the debugger foregoes making interpreted-frames, so you can
@@ -1233,35 +1228,22 @@
 ;;; into C.  In this case, the code object is stored on the stack after the
 ;;; LRA, and the LRA is the word offset.
 ;;;
-;;;; x86 note. The non-lra version has not been tested with the
-;;;; recent changes. I'm probably going to move to just using lra
-;;;; and remove the x86-lra feature at some point.
-#-gengc
+#-(or gengc x86)
 (defun compute-calling-frame (caller lra up-frame)
   (declare (type system:system-area-pointer caller))
-  ;;(format t "ccf: ~x ~a ~a~%" (sap-int caller) lra up-frame)
   (when (cstack-pointer-valid-p caller)
     (multiple-value-bind
 	(code pc-offset escaped)
 	(if lra
 	    (multiple-value-bind
-		  (word-offset code)
+		(word-offset code)
 		(if (ext:fixnump lra)
 		    (let ((fp (frame-pointer up-frame)))
-		      #+x86 (declare (ignore fp))
-		      (values
-		       lra
-		       #-x86 ;; fake-foreign-fcn sticks CODE pointer here
-		       (kernel:stack-ref fp (1+ vm::lra-save-offset))))
-		    #+(or x86-lra (not x86))
+		      (values lra
+			      (kernel:stack-ref fp (1+ vm::lra-save-offset))))
 		    (values (kernel:get-header-data lra)
-			    (kernel:lra-code-header lra))
-		    #+(and x86 (not x86-lra))
-		    (compute-lra-data-from-pc (int-sap lra)))
-			
+			    (kernel:lra-code-header lra)))
 	      (if code
-		  #+(and x86 (not x86-lra))(values code word-offset nil)
-		  #+(or x86-lra (not x86))
 		  (values code
 			  (* (1+ (- word-offset (kernel:get-header-data code)))
 			     vm:word-bytes)
@@ -1292,6 +1274,57 @@
 				 (if up-frame (1+ (frame-number up-frame)) 0)
 				 escaped))))))
 
+#+x86
+(defun compute-calling-frame (caller ra up-frame)
+  (declare (type system:system-area-pointer caller ra))
+;  (format t "ccf: ~a ~a ~a~%" caller ra up-frame)
+  (when (cstack-pointer-valid-p caller)
+;    (format t "ccf2~%")
+    ;; First check for an escaped frame.
+    (multiple-value-bind
+	(code pc-offset escaped)
+	(find-escaped-frame caller)
+	(cond (code
+	       ;; If it's escaped it may be a function end breakpoint
+	       ;; trap.
+;	       (format t "ccf2: escaped ~s ~s~%" code pc-offset)
+	       (when (and (kernel:code-component-p code)
+			  (eq (kernel:%code-debug-info code) :bogus-lra))
+		     ;; If :bogus-lra grab the real lra.
+		     (let ((real-ra
+			    (kernel:code-header-ref code real-lra-slot)))
+		       (multiple-value-setq (pc-offset code)
+			 (compute-lra-data-from-pc real-ra))
+;		       (format t "ccf3 :bogus-lra ~s ~s~%" code pc-offset)
+		       (assert code))))
+	      (t
+	       ;; Not escaped
+	       (multiple-value-setq (pc-offset code)
+		 (compute-lra-data-from-pc ra))
+;	       (format t "ccf4 ~s ~s~%" code pc-offset)
+	       (unless code
+		       (setf code :foreign-function
+			     pc-offset 0
+			     escaped nil))))
+
+	(let ((d-fun (case code
+			   (:undefined-function
+			    (make-bogus-debug-function
+			     "The Undefined Function"))
+			   (:foreign-function
+			    (make-bogus-debug-function
+			     "Foreign function call land"))
+			   ((nil)
+			    (make-bogus-debug-function
+			     "Bogus stack frame"))
+			   (t
+			    (debug-function-from-pc code pc-offset)))))
+	  (make-compiled-frame caller up-frame d-fun
+			       (code-location-from-pc d-fun pc-offset
+						      escaped)
+			       (if up-frame (1+ (frame-number up-frame)) 0)
+			       escaped)))))
+
 #-(or gengc x86)
 (defun find-escaped-frame (frame-pointer)
   (declare (type system:system-area-pointer frame-pointer))
@@ -1325,7 +1358,7 @@
 		 ;; We were in an assembly routine.  Therefore, use the LRA as
 		 ;; the pc.
 		 (setf pc-offset
-		       (- (lisp-return-pc scp)
+		       (- (vm:sigcontext-register scp vm::lra-offset)
 			  (kernel:get-lisp-obj-address code)
 			  code-header-len)))
 	       (return
@@ -1343,22 +1376,34 @@
     (alien:with-alien
 	((lisp-interrupt-contexts (array (* unix:sigcontext) nil) :extern))
       (let ((scp (alien:deref lisp-interrupt-contexts index)))
-	(when (sap= frame-pointer
-		    (int-sap (vm:sigcontext-register scp vm::cfp-offset)))
+	(when (= (system:sap-int frame-pointer)
+		 (vm:sigcontext-register scp vm::cfp-offset))
 	  (system:without-gcing
-	   (multiple-value-bind
-		 (pc-offset code)
-	       (compute-lra-data-from-pc (vm:sigcontext-program-counter scp))
-	     (when (symbolp code)
+	   (let* ((component-ptr
+		   (component-ptr-from-pc (vm:sigcontext-program-counter scp)))
+		  (code (if (sap= component-ptr (int-sap #x0))
+			    nil
+			  (component-from-component-ptr component-ptr))))
+	     (when (null code)
 	       (return (values code 0 scp)))
-	     (return
-	       (if (eq (kernel:%code-debug-info code) :bogus-lra)
-		   (let ((real-lra (kernel:code-header-ref
-				    code real-lra-slot)))
-		     (values (kernel:lra-code-header real-lra)
-			     (kernel:get-header-data real-lra)
-			     nil))
-		   (values code pc-offset scp))))))))))
+	     (let* ((code-header-len (* (kernel:get-header-data code)
+					vm:word-bytes))
+		    (pc-offset
+		     (- (system:sap-int
+			 (vm:sigcontext-program-counter scp))
+			(- (kernel:get-lisp-obj-address code)
+			   vm:other-pointer-type)
+			code-header-len)))
+	       (unless (<= 0 pc-offset
+			   (* (kernel:code-header-ref code
+						      vm:code-code-size-slot)
+			      vm:word-bytes))
+		 ;; We were in an assembly routine.  Therefore, use the LRA as
+		 ;; the pc.
+		 (format t "** pc-offset ~s not in code obj ~s?~%"
+			 pc-offset code))
+	       (return
+		(values code pc-offset scp))))))))))
 
 ;;; CODE-OBJECT-FROM-BITS  --  internal.
 ;;;
@@ -1389,17 +1434,6 @@
 #+gengc
 (declaim (special kernel::*saved-state-chain*))
 
-#+gengc
-(alien:def-alien-routine component-ptr-from-pc (system:system-area-pointer)
-  (pc system:system-area-pointer))
-
-#+gengc
-(defun component-from-component-ptr (component-ptr)
-  (declare (type system:system-area-pointer component-ptr))
-  (kernel:make-lisp-obj
-   (logior (system:sap-int component-ptr)
-	   vm:other-pointer-type)))
-
 #+gengc
 (defun lookup-trace-table-entry (component pc)
   (declare (type code-component component)
@@ -1491,7 +1525,8 @@
 		;; ### Need to do something real.
 		(values (make-bogus-debug-function "Assembler routine.")
 			0
-			(old-frame-pointer state)))
+			(system:int-sap
+			 (vm:sigcontext-register state vm::ocfp-offset))))
 	       (#.vm:trace-table-function-prologue
 		(values (make-bogus-debug-function
 			 "Function-Prologue in an assembler routine?")
@@ -1516,7 +1551,8 @@
 	       (#.vm:trace-table-call-site
 		(values (debug-function-from-pc component pc-offset)
 			pc-offset
-			(old-frame-pointer state)))
+			(system:int-sap
+			 (vm:sigcontext-register state vm::ocfp-offset))))
 	       (#.vm:trace-table-function-prologue
 		#+nil ;; ### Need to do something real.
 		(let* ((ra (system:int-sap
@@ -1606,8 +1642,6 @@
 ;;; the component, for function constants, and the c::compiled-debug-function.
 ;;;
 (defun debug-function-from-pc (component pc)
-  #+x86 ;; until no more bugs at least.
-  (declare (optimize (safety 1)(debug .5)))
   (let ((info (kernel:%code-debug-info component)))
     (cond
      ((not info)
@@ -1679,23 +1713,38 @@
 		   (system:sap-ref-32 catch
 				      (* vm:catch-block-current-cont-slot
 					 vm:word-bytes))))
-	(let* (#-gengc
+	(let* (#-(or gengc x86)
 	       (lra (kernel:stack-ref catch vm:catch-block-entry-pc-slot))
-	       #+gengc
+	       #+(or gengc x86)
 	       (ra (system:sap-ref-sap
 		    catch (* vm:catch-block-entry-pc-slot vm:word-bytes)))
+	       #-x86
 	       (component
 		(kernel:stack-ref catch vm:catch-block-current-code-slot))
+	       #+x86
+	       (component (component-from-component-ptr 
+			   (component-ptr-from-pc ra)))
 	       (offset
-		#-gengc (* (- (1+ (kernel:get-header-data lra))
-			      (kernel:get-header-data component))
-			   vm:word-bytes)
+		#-(or gengc x86)
+		(* (- (1+ (kernel:get-header-data lra))
+		      (kernel:get-header-data component))
+		   vm:word-bytes)
 		#+gengc
 		(+ (- (system:sap-int ra)
 		      (kernel:get-lisp-obj-address component)
 		      (kernel:get-header-data component))
-		   vm:other-pointer-type)))
-	  (push (cons (kernel:stack-ref catch vm:catch-block-tag-slot)
+		   vm:other-pointer-type)
+		#+x86
+		(- (system:sap-int ra)
+		   (- (kernel:get-lisp-obj-address component)
+		      vm:other-pointer-type)
+		   (* (kernel:get-header-data component) vm:word-bytes))))
+	  (push (cons #-x86
+		      (kernel:stack-ref catch vm:catch-block-tag-slot)
+		      #+x86
+		      (kernel:make-lisp-obj
+		       (system:sap-ref-32 catch (* vm:catch-block-tag-slot
+						   vm:word-bytes)))
 		      (make-compiled-code-location
 		       offset (frame-debug-function frame)))
 		res)))
@@ -4049,18 +4098,6 @@
 ;;; handle breaks for internal errors.
 ;;;
 (defun handle-breakpoint (offset component signal-context)
-#+x86
-  (multiple-value-bind (byte-offset code)
-      (let* ((pc (vm:sigcontext-program-counter
-		  (alien:sap-alien signal-context (* unix:sigcontext))))
-	     (fn (compiled-function-from-pc pc)))
-	(values (- (sap-int pc)
-		   (- (kernel:get-lisp-obj-address fn)
-		      vm:function-pointer-type))
-		(kernel:function-code-header fn)))
-    (setq offset byte-offset
-	  component code))
-
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "Unknown breakpoint in ~S at offset ~S."
@@ -4108,7 +4145,7 @@
       (breakpoint-do-displaced-inst signal-context
 				    (breakpoint-data-instruction data))
       ; Under HPUX we can't sigreturn so bp-do-disp-i has to return.
-      #-(or hpux irix)
+      #-(or hpux irix x86)
       (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
 
 (defun invoke-breakpoint-hooks (breakpoints component offset)
@@ -4164,17 +4201,20 @@
 	       cookie))))
 
 (defun get-function-end-breakpoint-values (scp)
-  (let ((ocfp (old-frame-pointer scp))
+  (let (#-x86
+	(ocfp (system:int-sap (vm:sigcontext-register scp vm::ocfp-offset)))
+	#+x86
+	(ocfp (system:int-sap (vm:sigcontext-register scp vm::ebx-offset)))
 	(nargs (kernel:make-lisp-obj
 		(vm:sigcontext-register scp vm::nargs-offset)))
-	(reg-arg-offsets '#.vm::register-arg-offsets)
+ 	(reg-arg-offsets '#.vm::register-arg-offsets)
 	(results nil))
     (system:without-gcing
      (dotimes (arg-num nargs)
        (push (if reg-arg-offsets
 		 (kernel:make-lisp-obj
 		  (vm:sigcontext-register scp (pop reg-arg-offsets)))
-		 (kernel:stack-ref ocfp arg-num))
+	       (kernel:stack-ref ocfp arg-num))
 	     results)))
     (nreverse results)))
 
@@ -4200,7 +4240,7 @@
 	  (trap-loc (system:foreign-symbol-address
 		     "function_end_breakpoint_trap"))
 	  (length (system:sap- src-end src-start))
-	  (code-object (system:%primitive c:allocate-code-object
+	  (code-object (system:%primitive #-x86 c:allocate-code-object #+x86 c::allocate-dynamic-code-object
 					  (1+ bogus-lra-constants)
 					  length))
 	  (dst-start (kernel:code-instructions code-object)))
@@ -4214,6 +4254,10 @@
      (setf (kernel:code-header-ref code-object known-return-p-slot)
 	   known-return-p)
      (kernel:system-area-copy src-start 0 dst-start 0 (* length vm:byte-bits))
+     (vm:sanctify-for-execution code-object)
+     #+x86
+     (values dst-start code-object (system:sap- trap-loc src-start))
+     #-x86
      (let ((new-lra (kernel:make-lisp-obj (+ (system:sap-int dst-start)
 					     vm:other-pointer-type))))
        (kernel:set-header-data