From 7d79b30c2914ee669c95c48ee10585aac45cefd4 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Thu, 29 Jul 2004 11:52:24 +0000
Subject: [PATCH] (defun foo () (zot)) when compiled and run gave a silly
 message about #C(0d0 0d0) failing a typecase.  Then doing a backtrace gave
 another error about some negative number not being a positive fixnum.

The former error is caused by a bad definition of undefined_tramp.
The latter error is caused by the debugger not being able to compute
the offset correctly.

(Fixes ported from sbcl.)
---
 code/debug-int.lisp | 29 ++++++++++++++++++++++++++++-
 code/ppc-vm.lisp    |  7 ++++++-
 lisp/ppc-assem.S    | 11 +++++++++--
 3 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index 6dae2e5ee..fe46a7d05 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -5,7 +5,7 @@
 ;;; 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.109 2004/06/01 23:09:27 cwang Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.110 2004/07/29 11:52:24 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1343,6 +1343,7 @@
 	       #+(or pmax sgi) ; pmax only
 	       (when (logbitp 31 (alien:slot scp 'mips::sc-cause))
 		 (incf pc-offset vm:word-bytes))
+	       #+nil
 	       (unless (<= 0 pc-offset
 			   (* (kernel:code-header-ref code
 						      vm:code-code-size-slot)
@@ -1353,6 +1354,17 @@
 		       (- (vm:sigcontext-register scp vm::lra-offset)
 			  (kernel:get-lisp-obj-address code)
 			  code-header-len)))
+	       (let ((code-size (* (kernel:code-header-ref code
+							   vm:code-code-size-slot)
+				   vm:word-bytes)))
+		 (unless (<= 0 pc-offset code-size)
+		   ;; We were in an assembly routine.
+		   (multiple-value-bind (new-pc-offset computed-return)
+		       (find-pc-from-assembly-fun code scp)
+		     (setf pc-offset new-pc-offset)
+		     (unless (<= 0 pc-offset code-size)
+		       ;; Message here?
+		       (setf pc-offset 0)))))
 	       (return
 		(if (eq (kernel:%code-debug-info code) :bogus-lra)
 		    (let ((real-lra (kernel:code-header-ref code
@@ -1397,6 +1409,21 @@
 	       (return
 		(values code pc-offset scp))))))))))
 
+(defun find-pc-from-assembly-fun (code scp)
+  "find the PC"
+  (let ((return-machine-address
+	 #-ppc
+	  (- (vm:sigcontext-register scp vm::lra-offset)
+	     vm:other-pointer-type)
+	  #+ppc
+	  (vm::sigcontext-lr scp))
+	(code-header-len (* (kernel:get-header-data code) vm:word-bytes)))
+    (values (- return-machine-address
+	       (- (get-lisp-obj-address code)
+		  vm:other-pointer-type)
+	       code-header-len)
+	    return-machine-address)))
+
 ;;; CODE-OBJECT-FROM-BITS  --  internal.
 ;;;
 ;;; Find the code object corresponding to the object represented by bits and
diff --git a/code/ppc-vm.lisp b/code/ppc-vm.lisp
index df1676e6c..fb3c6c715 100644
--- a/code/ppc-vm.lisp
+++ b/code/ppc-vm.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/ppc-vm.lisp,v 1.2 2004/07/25 19:32:38 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.3 2004/07/29 11:52:24 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -234,6 +234,11 @@
 
 (defsetf sigcontext-register %set-sigcontext-register)
 
+;; Extract the LR register from the sigcontext.
+(defun sigcontext-lr (scp)
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext)) scp)
+    (deref (slot (slot scp 'sc-regs) 'lr) 0)))
 
 ;;; SIGCONTEXT-FLOAT-REGISTER  --  Interface
 ;;;
diff --git a/lisp/ppc-assem.S b/lisp/ppc-assem.S
index ce2b5c1fa..3836cfad1 100644
--- a/lisp/ppc-assem.S
+++ b/lisp/ppc-assem.S
@@ -399,14 +399,18 @@ lra:
 
 	.byte 18<<2
 _undefined_tramp:	
-	.byte 0,0,24
+	.byte 0,0,48
 	.long _undefined_tramp
 	.long NIL
 	.long NIL
 	.long NIL
 	.long NIL
 	twllei reg_ZERO,trap_Cerror
-	.byte 4, 23, 254, 140, 2
+	.byte 4
+	.byte UNDEFINED_SYMBOL_ERROR
+	.byte 254
+	.byte sc_DescriptorReg+0x40
+	.byte 1
 	.align 2
 #ifdef PPC_FUN_HACK_MAYBE
 1:	lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_CNAME)
@@ -416,6 +420,9 @@ _undefined_tramp:
 	la reg_LIP,FUNCTION_CODE_OFFSET(reg_CODE)
 	mtctr reg_LIP
 	bctr
+
+	mr reg_CSP, reg_CFP
+	b 1b
 	
 	SET_SIZE(xundefined_tramp)
 
-- 
GitLab