diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 73b4bfac9f9242fe7cfa885cdde47c1bfefc11ea..927f2d9bd9d18cd4443ba35dc0258848b5d9ada3 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.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/lispinit.lisp,v 1.68 2003/03/23 21:23:42 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.69 2003/05/29 22:03:01 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -506,7 +506,7 @@ ;;; Scrub-control-stack. ;;; #-x86 -(defun scrub-control-stack () +(defun %scrub-control-stack () "Zero the unused portion of the control stack so that old objects are not kept alive because of uninitialized stack variables." (declare (optimize (speed 3) (safety 0)) @@ -545,7 +545,6 @@ ;;; On the x86 port the stack grows downwards, and to support grow on ;;; demand stacks the stack must be decreased as it is scrubbed. ;;; -#+x86 (defun scrub-control-stack () "Zero the unused portion of the control stack so that old objects are not kept alive because of uninitialized stack variables." diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp index 792e94b82eeb9722f9b39e8c9186df66a7188c2e..eab6d1e50086c48d38c642fc1c986f69c03b4bd8 100644 --- a/compiler/sparc/parms.lisp +++ b/compiler/sparc/parms.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/compiler/sparc/parms.lisp,v 1.40 2003/04/30 16:16:50 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.41 2003/05/29 22:03:01 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -261,6 +261,8 @@ lisp::%initial-function lisp::maybe-gc kernel::internal-error + #+stack-checking kernel::yellow-zone-hit + #+stack-checking kernel::red-zone-hit di::handle-breakpoint lisp::fdefinition-object @@ -286,7 +288,10 @@ ;; lisp::*cmucl-lib* lisp::*cmucl-core-path* - ;; + + ;; Some spare static symbols. Useful for adding another static + ;; symbol without having to do a cross-compile. Just rename one + ;; of these to the desired name. spare-9 spare-8 spare-7 diff --git a/lisp/interrupt.c b/lisp/interrupt.c index 7395b96471db133cb4a757145f0a7cf6430fc47e..2463a5377e8b449acf3b2282ac670cc94ef31ce9 100644 --- a/lisp/interrupt.c +++ b/lisp/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.27 2003/03/23 21:23:41 gerd Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.28 2003/05/29 22:03:01 toy Exp $ */ /* Interrupt handing magic. */ @@ -56,6 +56,49 @@ static boolean maybe_gc_pending = FALSE; * Utility routines used by various signal handlers. * \****************************************************************/ +void +build_fake_control_stack_frame(struct sigcontext *context) +{ +#ifndef i386 + lispobj oldcont; + + /* Build a fake stack frame */ + current_control_frame_pointer = (lispobj *)SC_REG(context, reg_CSP); + if ((lispobj *)SC_REG(context, reg_CFP)==current_control_frame_pointer) { + /* There is a small window during call where the callee's frame */ + /* isn't built yet. */ + if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) { + /* We have called, but not built the new frame, so + build it for them. */ + current_control_frame_pointer[0] = SC_REG(context, reg_OCFP); + current_control_frame_pointer[1] = SC_REG(context, reg_LRA); + current_control_frame_pointer += 8; + /* Build our frame on top of it. */ + oldcont = (lispobj)SC_REG(context, reg_CFP); + } + else { + /* We haven't yet called, build our frame as if the + partial frame wasn't there. */ + oldcont = (lispobj)SC_REG(context, reg_OCFP); + } + } + /* ### We can't tell if we are still in the caller if it had to + reg_ALLOCate the stack frame due to stack arguments. */ + /* ### Can anything strange happen during return? */ + else { + + /* Normal case. */ + oldcont = (lispobj)SC_REG(context, reg_CFP); + } + + current_control_stack_pointer = current_control_frame_pointer + 8; + + current_control_frame_pointer[0] = oldcont; + current_control_frame_pointer[1] = NIL; + current_control_frame_pointer[2] = (lispobj)SC_REG(context, reg_CODE); +#endif +} + void fake_foreign_function_call(struct sigcontext *context) { @@ -78,7 +121,7 @@ fake_foreign_function_call(struct sigcontext *context) current_binding_stack_pointer = (lispobj *)SC_REG(context, reg_BSP); #endif -#ifndef i386 +#if !defined(i386) && 0 /* Build a fake stack frame */ current_control_frame_pointer = (lispobj *)SC_REG(context, reg_CSP); if ((lispobj *)SC_REG(context, reg_CFP)==current_control_frame_pointer) { @@ -111,7 +154,10 @@ fake_foreign_function_call(struct sigcontext *context) current_control_frame_pointer[0] = oldcont; current_control_frame_pointer[1] = NIL; current_control_frame_pointer[2] = (lispobj)SC_REG(context, reg_CODE); +#else + build_fake_control_stack_frame(context); #endif + /* Do dynamic binding of the active interrupt context index and save the context in the context array. */ @@ -516,7 +562,10 @@ interrupt_install_low_level_handler (int signal, void handler (HANDLER_ARGS)) because, when we get that signal because of hitting a control stack guard zone, it's not a good idea to use more of the control stack for handling the signal. */ -#ifdef RED_ZONE_HIT + /* But we only need this on x86 since the Lisp control stack and the + C control stack are the same. For others, they're separate so + the C stack can still be used. */ +#if defined(RED_ZONE_HIT) && defined(x86) if (signal == PROTECTION_VIOLATION_SIGNAL) { stack_t sigstack; diff --git a/lisp/os-common.c b/lisp/os-common.c index 8b9a5ef7f09ac206657acc89334c4c5be151bcc8..2b362ae1bd23b13028722cad0d61244d1f33ea9c 100644 --- a/lisp/os-common.c +++ b/lisp/os-common.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.9 2003/03/23 21:23:41 gerd Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.10 2003/05/29 22:03:01 toy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -14,6 +14,8 @@ #include "internals.h" #include "validate.h" #include "lisp.h" +#include "lispregs.h" +#include "globals.h" /* Except for os_zero, these routines are only called by Lisp code. These routines may also be replaced by os-dependent versions instead. See @@ -291,7 +293,7 @@ os_stack_grows_down (void) +----------+ | | yellow zone +----------+ - | | red zove + | | red zone +----------+ CONTROL_STACK_START Both the yellow zone and the red zone are write-protected. @@ -317,6 +319,7 @@ os_stack_grows_down (void) static void guard_zones (char **yellow_start, char **red_start) { +#ifdef x86 if (os_stack_grows_down ()) { char *end = (char *) CONTROL_STACK_START; @@ -329,6 +332,17 @@ guard_zones (char **yellow_start, char **red_start) *red_start = end - RED_ZONE_SIZE; *yellow_start = *red_start - YELLOW_ZONE_SIZE; } +#else + /* + * On Solaris/sparc, the C stack grows down, but the Lisp control + * stack grows up. The stack zones begin just before the end of the + * control stack area. + */ + + char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; + *red_start = end - RED_ZONE_SIZE; + *yellow_start = *red_start - YELLOW_ZONE_SIZE; +#endif } /* Return the guard zone FAULT_ADDR is in or 0 if not in a guard @@ -383,19 +397,24 @@ os_guard_control_stack (int zone, int guard) int os_control_stack_overflow (void *fault_addr, struct sigcontext *context) { - int zone; + enum stack_zone_t zone; zone = control_stack_zone (fault_addr); - + if (zone == YELLOW_ZONE || zone == RED_ZONE) { lispobj error; +#if 0 + fprintf(stderr, "hit end of control stack in zone %s\n", + (zone == YELLOW_ZONE) ? "YELLOW" : (zone == RED_ZONE) ? "RED" : "BOTH"); +#endif /* Unprotect the stack, giving us some room on the stack for error handling in Lisp. Fake a stack frame for this interruption. */ os_guard_control_stack (zone, 0); - fake_foreign_function_call (context); + + build_fake_control_stack_frame (context); /* The protection violation signal is delivered on a signal stack different from the normal stack, so that we don't @@ -414,9 +433,19 @@ os_control_stack_overflow (void *fault_addr, struct sigcontext *context) context->sc_eip = (int) ((struct function *) PTR (error))->code; context->sc_ecx = 0; #else +#ifdef sparc + /* This part should be common to all non-x86 ports */ + SC_PC(context) = (long) ((struct function *) PTR (error))->code; + SC_NPC(context) = SC_PC(context) + 4; + SC_REG(context, reg_NARGS) = 0; + SC_REG(context, reg_LIP) = (long) ((struct function *) PTR (error))->code; + SC_REG(context, reg_CFP) = (long) current_control_frame_pointer; + /* This is sparc specific */ + SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer; +#else #error os_control_stack_overflow not implemented for this system #endif - +#endif return 1; } diff --git a/lisp/os.h b/lisp/os.h index d6459852bb38f1c8be2d22e5db67e177f9eb7c31..b0091152e2c162cdea91a90c65a7e1f0fbd8bec1 100644 --- a/lisp/os.h +++ b/lisp/os.h @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.11 2003/03/23 21:23:41 gerd Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.12 2003/05/29 22:03:01 toy Exp $ * * Common interface for os-dependent functions. * @@ -105,7 +105,7 @@ extern boolean valid_addr(os_vm_address_t test); extern void os_foreign_linkage_init(void); extern void *os_dlsym (const char *sym_name, lispobj lib_list); -enum {BOTH_ZONES, YELLOW_ZONE, RED_ZONE}; +enum stack_zone_t {BOTH_ZONES, YELLOW_ZONE, RED_ZONE}; extern int os_stack_grows_down (void); extern void os_guard_control_stack (int zone, int guard); extern int os_control_stack_overflow (void *, struct sigcontext *); diff --git a/lisp/solaris-os.c b/lisp/solaris-os.c index 1a50136282c99b6c2342298b45c49bc22a176274..78d8a8f188059e3cc6d08c4f99054910c19f3310 100644 --- a/lisp/solaris-os.c +++ b/lisp/solaris-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.6 2002/11/13 13:10:22 toy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.7 2003/05/29 22:03:01 toy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -203,8 +203,13 @@ segv_handler(HANDLER_ARGS) caddr_t addr = code->si_addr; SAVE_CONTEXT(); - - if(!interrupt_maybe_gc(signal, code, context)) { + +#ifdef RED_ZONE_HIT + if (os_control_stack_overflow (addr, context)) + return; +#endif + + if (!interrupt_maybe_gc(signal, code, context)) { /* a *real* protection fault */ fprintf(stderr, "segv_handler: Real protection violation: 0x%08x\n", addr); diff --git a/lisp/sunos-os.h b/lisp/sunos-os.h index 61d49d52cd04e18ceeb739666cff364d82a085fa..24206e738cd2eaa3747afaa7b11b57066943e0db 100644 --- a/lisp/sunos-os.h +++ b/lisp/sunos-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.h,v 1.3 1994/10/27 17:13:54 ram Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.h,v 1.4 2003/05/29 22:03:01 toy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -55,3 +55,5 @@ typedef int os_vm_prot_t; #define bcopy(a,b,n) memmove(b,a,n) #define bzero(a,n) memset(a,0,n) #endif /* SOLARIS */ + +#define PROTECTION_VIOLATION_SIGNAL SIGSEGV