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