diff --git a/code/error.lisp b/code/error.lisp index f491815bd9dc521ed6f76354a5c9df354d4d0016..328076ab86a449dbafdab0e2d18f3b14dc2d30f6 100644 --- a/code/error.lisp +++ b/code/error.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/error.lisp,v 1.66 2003/03/22 16:15:21 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.67 2003/03/23 21:23:42 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,7 +21,8 @@ (in-package "KERNEL") (export '(layout-invalid condition-function-name simple-control-error simple-file-error simple-program-error simple-parse-error - simple-style-warning simple-undefined-function)) + simple-style-warning simple-undefined-function + stack-overflow)) (in-package "LISP") (export '(break error warn cerror @@ -861,6 +862,13 @@ (define-condition storage-condition (serious-condition) ()) +#+stack-checking +(define-condition stack-overflow (storage-condition) + () + (:report (lambda (condition stream) + (declare (ignore condition)) + (format stream "Control stack overflow")))) + (define-condition type-error (error) ((datum :reader type-error-datum :initarg :datum) (expected-type :reader type-error-expected-type :initarg :expected-type)) diff --git a/code/exports.lisp b/code/exports.lisp index d005b26298d0259120bd9b18afa7d53acc841573..387526d86dd12398327f2c9c9db64bd4196baa2d 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.203 2003/03/22 16:15:21 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.204 2003/03/23 21:23:42 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1510,6 +1510,7 @@ (:import-from "C-CALL" "VOID") (:export "%CLASS-LAYOUT" "%CLASS-STATE" "%CLASS-DIRECT-SUPERCLASSES" "%CLASS-SUBCLASSES" "%CLASS-PCL-CLASS" + "RED-ZONE-HIT" "YELLOW-ZONE-HIT" "STACK-OVERFLOW" "*ANSI-DEFSTRUCT-OPTIONS-P*" "%ACOS" "%ACOSH" "%ARRAY-AVAILABLE-ELEMENTS" "%ARRAY-DATA-VECTOR" "%ARRAY-DIMENSION" "%ARRAY-DISPLACED-P" diff --git a/code/interr.lisp b/code/interr.lisp index 653bc5dfc8d4932ab2fb07d3ad68f1b19a1fcff2..9a3cc9f761671a9c0019568cc4f01e4ed051fd40 100644 --- a/code/interr.lisp +++ b/code/interr.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/interr.lisp,v 1.39 2002/08/28 13:29:26 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.40 2003/03/23 21:23:42 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,7 +17,8 @@ (in-package "KERNEL") -(export '(infinite-error-protect find-caller-name *maximum-error-depth*)) +(export '(infinite-error-protect find-caller-name *maximum-error-depth* + red-zone-hit yellow-zone-hit)) @@ -621,3 +622,37 @@ (t (funcall handler name fp scp arguments))))))))) +;;; +;;; Called from C when the yellow control stack guard zone is hit. +;;; The yellow zone is unprotected in the C code prior to calling this +;;; function, to give some room for debugging. The red zone is still +;;; protected. +;;; +#+stack-checking +(defun yellow-zone-hit () + (let ((debug:*stack-top-hint* nil)) + (format *error-output* + "~2&~@<A control stack overflow has occurred: ~ + the program has entered the yellow control stack guard zone. ~ + Please note that you will be returned to the Top-Level if you ~ + enter the red control stack guard zone while debugging.~@:>~2%") + (infinite-error-protect (error 'stack-overflow)))) + +;;; +;;; Called from C when the red control stack guard zone is hit. We +;;; could ABORT here, which would usually take us back to the debugger +;;; or top-level, and add code to the restarts re-protecting the red +;;; zone (which can't be done here because we're still in the red +;;; zone). Using ABORT is too dangerous because users may be using +;;; abort restarts which don't do the necessary re-protecting of the +;;; red zone, and would thus render CMUCL unprotected. +;;; +#+stack-checking +(defun red-zone-hit () + (format *error-output* + "~2&~@<Fatal control stack overflow. You have entered ~ + the red control stack guard zone while debugging. ~ + Returning to Top-Level.~@:>~2%") + (throw 'lisp::top-level-catcher nil)) + + diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 2b1d30587f31a27d888e6c1d6e75ed77b85db211..73b4bfac9f9242fe7cfa885cdde47c1bfefc11ea 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.67 2002/08/23 17:08:52 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.68 2003/03/23 21:23:42 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -495,6 +495,11 @@ ;;;; SCRUB-CONTROL-STACK +#+stack-checking +(alien:def-alien-routine "os_guard_control_stack" c-call:void + (zone c-call:int) + (guardp c-call:int)) + (defconstant bytes-per-scrub-unit 2048) @@ -544,7 +549,16 @@ (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." - (scrub-control-stack)) + ;; + ;; The guard zone of the control stack is used by Lisp sometimes, + ;; so I think it should be zero'd out, too. + #+stack-checking (os-guard-control-stack 0 0) + (%scrub-control-stack) + #+stack-checking (os-guard-control-stack 0 1)) + +#+x86 +(defun %scrub-control-stack () + (%scrub-control-stack)) ;;;; TOP-LEVEL loop. diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 4aa08bfb6a851b315d1a2c4ba28a7b60232c203b..0eb26ec38d6667dc35710c56ba46e4f77c200070 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -4,7 +4,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.53 2003/03/17 22:13:50 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.54 2003/03/23 21:23:41 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -703,6 +703,10 @@ (frob lisp::%initial-function) (frob lisp::maybe-gc) (frob kernel::internal-error) + #+stack-checking + (progn + (frob kernel::yellow-zone-hit) + (frob kernel::red-zone-hit)) (frob di::handle-breakpoint) (frob di::handle-function-end-breakpoint) (frob lisp::fdefinition-object)) diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp index 88e99d75638d4ba8d65d5728d37ce07515c3001d..24c81c62659f817cab702bf5370433f9903ff648 100644 --- a/compiler/x86/parms.lisp +++ b/compiler/x86/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.23 2003/03/21 20:53:03 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.24 2003/03/23 21:23:41 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -254,6 +254,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 diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp index e25097055be4ab9162ae16e25c217b75dd5b2094..2fe3a215041b9fcf57f30abfce9fbabfd9221e74 100644 --- a/compiler/x86/system.lisp +++ b/compiler/x86/system.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.12 2003/02/25 15:54:56 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.13 2003/03/23 21:23:41 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -313,16 +313,16 @@ -(defknown sys:scrub-control-stack () (values)) +(defknown lisp::%scrub-control-stack () (values)) ;;; Scrub the control stack. ;;; ;;; On the x86 port the stack grows downwards, and to support grow on ;;; demand stacks the stack must be decreased as it is scrubbed. ;;; -(define-vop (scrub-control-stack) +(define-vop (%scrub-control-stack) (:policy :fast-safe) - (:translate sys:scrub-control-stack) + (:translate lisp::%scrub-control-stack) (:args) (:results) (:temporary (:sc unsigned-reg) count) diff --git a/lisp/FreeBSD-os.c b/lisp/FreeBSD-os.c index 82c479798ee8b1762230f1c6856bbd2b30eb5498..26c4862001c0b52d23fa6a66810cd1b56e34edab 100644 --- a/lisp/FreeBSD-os.c +++ b/lisp/FreeBSD-os.c @@ -12,7 +12,7 @@ * Much hacked by Paul Werkowski * GENCGC support by Douglas Crosher, 1996, 1997. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.c,v 1.9 2002/08/28 07:16:38 moore Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.c,v 1.10 2003/03/23 21:23:41 gerd Exp $ * */ @@ -34,9 +34,6 @@ #include <sys/proc.h> #include <dlfcn.h> #include "validate.h" -vm_size_t os_vm_page_size; - -#define DPRINTF(t,a) {if (t) fprintf a;} #if defined GENCGC #include "gencgc.h" @@ -48,13 +45,18 @@ vm_size_t os_vm_page_size; #undef errno int errno; #endif + +vm_size_t os_vm_page_size; + -void os_init(void) +void +os_init (void) { - os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; + os_vm_page_size = getpagesize (); } -int sc_reg(struct sigcontext *c, int offset) +int +sc_reg (struct sigcontext *c, int offset) { switch(offset) { @@ -67,21 +69,24 @@ int sc_reg(struct sigcontext *c, int offset) case 12: return c->sc_esi; case 14: return c->sc_edi; } + return 0; } -void os_save_context(void) +void +os_save_context (void) { - /* - * Called from interrupt handlers so C stuff knows things set in Lisp. - */ + /* Called from interrupt handlers so C stuff knows things set in + Lisp. */ } -void os_set_context(void) +void +os_set_context (void) { } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_validate (os_vm_address_t addr, os_vm_size_t len) { int flags = MAP_PRIVATE | MAP_ANONYMOUS; @@ -90,139 +95,150 @@ os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) else flags |= MAP_VARIABLE; - DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); - - addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + addr = mmap (addr, len, OS_VM_PROT_ALL, flags, -1, 0); if (addr == (os_vm_address_t) -1) { - perror("mmap"); + perror ("mmap"); return NULL; } - DPRINTF(0, (stderr, "%x\n", addr)); - return addr; } -void os_invalidate(os_vm_address_t addr, os_vm_size_t len) +void +os_invalidate (os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); - - if (munmap(addr, len) == -1) - perror("munmap"); + if (munmap (addr, len) == -1) + perror ("munmap"); } -os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_vm_address_t +os_map (int fd, int offset, os_vm_address_t addr, + os_vm_size_t len) { - addr = mmap(addr, len, - OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap (addr, len, OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, + fd, (off_t) offset); if (addr == (os_vm_address_t) -1) - perror("mmap"); + perror ("mmap"); return addr; } -void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +void +os_flush_icache (os_vm_address_t address, os_vm_size_t length) { } -void os_protect(os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +void +os_protect (os_vm_address_t address, os_vm_size_t length, + os_vm_prot_t prot) { - if (mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect (address, length, prot) == -1) + perror ("mprotect"); } -static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) +static boolean +in_range_p (os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + return adr >= beg && adr < end; } -boolean valid_addr(os_vm_address_t addr) +boolean +valid_addr (os_vm_address_t addr) { int ret; os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); - - if ( in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) - || in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE ) - || in_range_p(addr, DYNAMIC_0_SPACE_START, dynamic_space_size ) - || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size ) - || in_range_p(addr, CONTROL_STACK_START , CONTROL_STACK_SIZE ) - || in_range_p(addr, BINDING_STACK_START , BINDING_STACK_SIZE )) + newaddr = os_trunc_to_page (addr); + + if (in_range_p (addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) + || in_range_p (addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) + || in_range_p (addr, DYNAMIC_0_SPACE_START, dynamic_space_size) +#ifndef GENCGC + || in_range_p (addr, DYNAMIC_1_SPACE_START, dynamic_space_size) +#endif + || in_range_p (addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) + || in_range_p (addr, BINDING_STACK_START, BINDING_STACK_SIZE)) return TRUE; return FALSE; } -static void sigbus_handler(int signal, int code, struct sigcontext *context, - void *fault_addr) +static void +sigbus_handler (int signal, int code, struct sigcontext *context, + void *fault_addr) { -#if defined GENCGC - int page_index = find_page_index(fault_addr); - -#if SIGBUS_VERBOSE - fprintf(stderr,"Signal %d, fault_addr=%x, page_index=%d:\n", - signal, fault_addr, page_index); + int page_index; + +#ifdef RED_ZONE_HIT + if (os_control_stack_overflow (fault_addr, context)) + return; #endif + +#if defined GENCGC + page_index = find_page_index(fault_addr); /* Check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + if (page_index != -1) + { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigbus in page not marked as write protected\n"); + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED (page_index)) + fprintf (stderr, "*** Sigbus in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + os_protect (page_address (page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; + return; } -#endif +#endif /* GENCGC */ - DPRINTF(0, (stderr, "sigbus:\n")); - interrupt_handle_now(signal, code, context); + interrupt_handle_now (signal, code, context); } -static void sigsegv_handler(int signal, int code, struct sigcontext *context) +static void +sigsegv_handler (int signal, int code, struct sigcontext *context) { - DPRINTF(0, (stderr, "os_sigsegv\n")); - interrupt_handle_now(signal, code, context); + interrupt_handle_now (signal, code, context); } -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers (void) { - interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS, sigbus_handler); + interrupt_install_low_level_handler + (SIGSEGV, (void (*) (HANDLER_ARGS)) sigsegv_handler); + interrupt_install_low_level_handler + (SIGBUS, (void (*) (HANDLER_ARGS)) sigbus_handler); } -void *os_dlsym(const char *sym_name, lispobj lib_list) +void * +os_dlsym (const char *sym_name, lispobj lib_list) { - if (lib_list != NIL) { - lispobj lib_list_head; - - for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = (CONS(lib_list_head))->cdr) { - struct cons *lib_cons = CONS(CONS(lib_list_head)->car); - struct sap *dlhandle = (struct sap *)PTR(lib_cons->car); - void *sym_addr = dlsym((void *)dlhandle->pointer, sym_name); - - if (sym_addr) - return sym_addr; + if (lib_list != NIL) + { + lispobj lib_list_head; + + for (lib_list_head = lib_list; + lib_list_head != NIL; + lib_list_head = CONS (lib_list_head)->cdr) + { + struct cons *lib_cons = CONS (CONS (lib_list_head)->car); + struct sap *dlhandle = (struct sap *) PTR (lib_cons->car); + void *sym_addr = dlsym ((void *) dlhandle->pointer, sym_name); + + if (sym_addr) + return sym_addr; } } - return dlsym(RTLD_DEFAULT, sym_name); + + return dlsym (RTLD_DEFAULT, sym_name); } diff --git a/lisp/FreeBSD-os.h b/lisp/FreeBSD-os.h index 9a18619a30941790dd93a0b1d69b9c28d19b04cb..249a68f8ce821b966c5d184403f61f794c11f61d 100644 --- a/lisp/FreeBSD-os.h +++ b/lisp/FreeBSD-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.h,v 1.4 2002/08/27 22:18:30 moore Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.h,v 1.5 2003/03/23 21:23:41 gerd 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. @@ -15,34 +15,31 @@ #define MAP_ANONYMOUS MAP_ANON #define MAP_VARIABLE 0 -typedef caddr_t os_vm_address_t; +typedef caddr_t os_vm_address_t; typedef vm_size_t os_vm_size_t; -typedef off_t os_vm_offset_t; -typedef int os_vm_prot_t; +typedef off_t os_vm_offset_t; +typedef int os_vm_prot_t; -#define OS_VM_PROT_READ PROT_READ -#define OS_VM_PROT_WRITE PROT_WRITE +#define OS_VM_PROT_READ PROT_READ +#define OS_VM_PROT_WRITE PROT_WRITE #define OS_VM_PROT_EXECUTE PROT_EXEC #define OS_VM_DEFAULT_PAGESIZE 4096 -int -sc_reg(struct sigcontext*,int); -void -os_save_context(); -/* #define SAVE_CONTEXT os_save_context*/ +int sc_reg (struct sigcontext*,int); +void os_save_context (); /* I *think* this is when things became incompatible with old - signals. -*/ + signals. */ #if __FreeBSD_version > 400010 #define POSIX_SIGS /* If we used SA_SIGINFO in sigaction() the third argument to signal handlers would be a struct ucontext_t. (The manpage for sigaction(2) is wrong!) Sigcontext and ucontext_t are "compatible", but access to registers in a ucontext_t goes through - the uc_mcontext field, so we just won't bother. -*/ + the uc_mcontext field, so we just won't bother. */ #define USE_SA_SIGINFO 0 #define uc_sigmask sc_mask #endif + +#define PROTECTION_VIOLATION_SIGNAL SIGBUS diff --git a/lisp/Linux-os.c b/lisp/Linux-os.c index 9de09be7927d345a58cf8731f38d4532ee0e23f8..ba2f6ff638196e473efdf45c630f05de7c85eb92 100644 --- a/lisp/Linux-os.c +++ b/lisp/Linux-os.c @@ -15,7 +15,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Alpha support by Julian Dolby, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.15 2002/08/28 13:29:25 pmai Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.16 2003/03/23 21:23:41 gerd Exp $ * */ @@ -203,8 +203,8 @@ boolean valid_addr(os_vm_address_t addr) } - #if defined GENCGC + void sigsegv_handler(HANDLER_ARGS) { GET_CONTEXT @@ -212,7 +212,12 @@ void sigsegv_handler(HANDLER_ARGS) int fault_addr = ((struct sigcontext_struct *) (&contextstruct))->cr2; int page_index = find_page_index((void *) fault_addr); - /* Check if the fault is within the dynamic space. */ +#ifdef RED_ZONE_HIT + if (os_control_stack_overflow (fault_addr, &contextstruct)) + return; +#endif + + /* check if the fault is within the dynamic space. */ if (page_index != -1) { /* Un-protect the page */ diff --git a/lisp/Linux-os.h b/lisp/Linux-os.h index fe47ea85ebf060fb95bcf394e9d993766f3ce2a4..814f35315da18e247fedf6ea62873a819cd6e6b4 100644 --- a/lisp/Linux-os.h +++ b/lisp/Linux-os.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.13 2000/10/21 12:40:56 dtc Exp $ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.14 2003/03/23 21:23:41 gerd 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. @@ -9,6 +9,7 @@ */ #include <stdlib.h> +#include <signal.h> #include <sys/types.h> #include <sys/mman.h> #include <sys/signal.h> @@ -105,6 +106,7 @@ typedef struct sigcontext_struct sigcontext; #define sc_ebp ebp #define sc_esi esi #define sc_edi edi +#define sc_eip eip #endif /* i386 */ @@ -115,3 +117,5 @@ typedef struct sigcontext_struct sigcontext; #ifndef sa_sigaction #define sa_sigaction sa_handler #endif + +#define PROTECTION_VIOLATION_SIGNAL SIGSEGV diff --git a/lisp/interrupt.c b/lisp/interrupt.c index bb3104d558ae7f0d3c67789f622a3a39f711cb5d..7395b96471db133cb4a757145f0a7cf6430fc47e 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.26 2001/12/06 19:15:45 pmai Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.27 2003/03/23 21:23:41 gerd Exp $ */ /* Interrupt handing magic. */ @@ -501,29 +501,49 @@ boolean interrupt_maybe_gc(HANDLER_ARGS) * Noise to install handlers. * \****************************************************************/ -void interrupt_install_low_level_handler - (int signal, - void handler(HANDLER_ARGS)) +void +interrupt_install_low_level_handler (int signal, void handler (HANDLER_ARGS)) { #ifdef POSIX_SIGS - struct sigaction sa; - - sa.sa_sigaction = handler; - sigemptyset(&sa.sa_mask); - FILLBLOCKSET(&sa.sa_mask); - sa.sa_flags = SA_RESTART | USE_SA_SIGINFO; - - sigaction(signal, &sa, NULL); -#else - struct sigvec sv; + struct sigaction sa; + + sa.sa_sigaction = handler; + sigemptyset (&sa.sa_mask); + FILLBLOCKSET (&sa.sa_mask); + sa.sa_flags = SA_RESTART | USE_SA_SIGINFO; + + /* Deliver protection violations on a dedicated signal stack, + 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 + if (signal == PROTECTION_VIOLATION_SIGNAL) + { + stack_t sigstack; + sigstack.ss_sp = (void *) SIGNAL_STACK_START; + sigstack.ss_flags = 0; + sigstack.ss_size = SIGNAL_STACK_SIZE; + if (sigaltstack (&sigstack, 0) == -1) + perror ("sigaltstack"); + sa.sa_flags |= SA_ONSTACK; + } +#endif /* RED_ZONE_HIT */ - sv.sv_handler = handler; - sv.sv_mask = BLOCKABLE; - sv.sv_flags = 0; - sigvec(signal, &sv, NULL); -#endif - interrupt_low_level_handlers[signal] = - (handler == (void (*)(HANDLER_ARGS)) SIG_DFL) ? 0 : handler; + sigaction (signal, &sa, NULL); + +#else /* not POSIX_SIGNALS */ + struct sigvec sv; + + sv.sv_handler = handler; + sv.sv_mask = BLOCKABLE; + sv.sv_flags = 0; + sigvec (signal, &sv, NULL); +#endif /* not POSIX_SIGNALS */ + + if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL) + interrupt_low_level_handlers[signal] = 0; + else + interrupt_low_level_handlers[signal] = handler; } unsigned long install_handler(int signal, diff --git a/lisp/os-common.c b/lisp/os-common.c index 76e0633fac8babec02a40da41a1cb02dc5112cf8..8b9a5ef7f09ac206657acc89334c4c5be151bcc8 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.8 2002/10/24 20:41:25 toy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.9 2003/03/23 21:23:41 gerd 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. @@ -245,7 +245,7 @@ unsigned long os_link_one_symbol(long entry) undefined_foreign_symbol_trap((lispobj)data_vector->data[table_index]); } arch_make_linkage_entry(entry, target_addr, type); - return target_addr; + return (unsigned long) target_addr; #else return 0; #endif /* LINKAGE_TABLE */ @@ -262,3 +262,174 @@ unsigned long lazy_resolve_linkage(unsigned long retaddr) return 0; #endif /* LINKAGE_TABLE */ } + +static int +os_stack_grows_down_1 (int *local_var_address) +{ + int dummy; + return &dummy < local_var_address; +} + +/* Value is true if the processor stack grows down. */ + +int +os_stack_grows_down (void) +{ + int dummy; + return os_stack_grows_down_1 (&dummy); +} + + +#ifdef RED_ZONE_HIT + +/* The end of the control stack contains two guard zones: + + +----------+ stack start (stack growing down) + | | + ... + | | + +----------+ + | | yellow zone + +----------+ + | | red zove + +----------+ CONTROL_STACK_START + + Both the yellow zone and the red zone are write-protected. + + When entering the yellow zone, we unprotect the yellow zone and + make Lisp signal a control stack exhausted error, with stack + contents left intact for the debugger, which is entered. + + When hitting the red zone we arrange for calling a function that + throws back to the top-level. */ + +#ifndef YELLOW_ZONE_SIZE +#define YELLOW_ZONE_SIZE 0x8000 /* 32K */ +#endif + +#ifndef RED_ZONE_SIZE +#define RED_ZONE_SIZE YELLOW_ZONE_SIZE +#endif + +/* Return the start addresses of the yellow and red zones in + *YELLOW_START and *RED_START. */ + +static void +guard_zones (char **yellow_start, char **red_start) +{ + if (os_stack_grows_down ()) + { + char *end = (char *) CONTROL_STACK_START; + *red_start = end; + *yellow_start = *red_start + RED_ZONE_SIZE; + } + else + { + char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; + *red_start = end - RED_ZONE_SIZE; + *yellow_start = *red_start - YELLOW_ZONE_SIZE; + } +} + +/* Return the guard zone FAULT_ADDR is in or 0 if not in a guard + zone. */ + +static int +control_stack_zone (void *fault_addr) +{ + char *yellow_start, *red_start; + char *p = (char *) fault_addr; + + guard_zones (&yellow_start, &red_start); + + if (p >= yellow_start && p < yellow_start + YELLOW_ZONE_SIZE) + return YELLOW_ZONE; + else if (p >= red_start && p < red_start + RED_ZONE_SIZE) + return RED_ZONE; + else + return 0; +} + +/* Protect/unprotect the guard zone ZONE of the control stack. */ + +void +os_guard_control_stack (int zone, int guard) +{ + char *yellow_start, *red_start; + int flags; + + guard_zones (&yellow_start, &red_start); + + if (guard) + flags = OS_VM_PROT_READ | OS_VM_PROT_EXECUTE; + else + flags = OS_VM_PROT_ALL; + + if (zone == YELLOW_ZONE) + os_protect ((os_vm_address_t) yellow_start, YELLOW_ZONE_SIZE, flags); + else if (zone == RED_ZONE) + os_protect ((os_vm_address_t) red_start, RED_ZONE_SIZE, flags); + else + { + char *start = red_start < yellow_start ? red_start : yellow_start; + os_protect ((os_vm_address_t) start, RED_ZONE_SIZE + YELLOW_ZONE_SIZE, + flags); + } +} + +/* Handle a possible guard zone hit at FAULT_ADDR. Value is + non-zero if FAULT_ADDR is in a guard zone. */ + +int +os_control_stack_overflow (void *fault_addr, struct sigcontext *context) +{ + int zone; + + zone = control_stack_zone (fault_addr); + + if (zone == YELLOW_ZONE || zone == RED_ZONE) + { + lispobj error; + + /* 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); + + /* The protection violation signal is delivered on a signal + stack different from the normal stack, so that we don't + trample on the guard pages of the normal stack while handling + the signal. To get a Lisp function called when the signal + handler returns, we change the return address of the signal + context to the address of the function we want to be + called. */ + if (zone == RED_ZONE) + error = SymbolFunction (RED_ZONE_HIT); + else + error = SymbolFunction (YELLOW_ZONE_HIT); + +#ifdef i386 + /* ECX is the argument count. */ + context->sc_eip = (int) ((struct function *) PTR (error))->code; + context->sc_ecx = 0; +#else +#error os_control_stack_overflow not implemented for this system +#endif + + return 1; + } + + return 0; +} + +#else /* not RED_ZONE_HIT */ + +/* Dummy for bootstrapping. */ + +void +os_guard_control_stack (int zone, int guard) +{ +} + +#endif /* not RED_ZONE_HIT */ diff --git a/lisp/os.h b/lisp/os.h index a0a1c0cc3a378592b9aa19fb37ed9e608d9a65c3..d6459852bb38f1c8be2d22e5db67e177f9eb7c31 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.10 2002/08/27 22:18:33 moore Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.11 2003/03/23 21:23:41 gerd Exp $ * * Common interface for os-dependent functions. * @@ -105,4 +105,9 @@ 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}; +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 *); + #endif diff --git a/lisp/validate.c b/lisp/validate.c index 1985cf242c0d8e07933b3aae86fbc8497dc78ac0..857954956512ee0dee0268560223ff0582aa679b 100644 --- a/lisp/validate.c +++ b/lisp/validate.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.10 2002/08/27 22:18:33 moore Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.11 2003/03/23 21:23:41 gerd Exp $ * * Memory Validation */ @@ -10,64 +10,70 @@ #include "globals.h" #include "validate.h" -static void ensure_space(lispobj *start, unsigned long size) +static void +ensure_space(lispobj *start, size_t size) { - if(os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL){ + if (os_validate((os_vm_address_t) start, size) == NULL) { fprintf(stderr, - "ensure_space: Failed to validate %ld bytes at 0x%08X\n", - size, - (unsigned long)start); + "ensure_space: Failed to validate %ld bytes at 0x%08lx\n", + (unsigned long) size, + (unsigned long) start); exit(1); } } -void validate(void) +void +validate(void) { -#ifdef PRINTNOISE - printf("Validating memory ..."); - fflush(stdout); -#endif + /* Read-Only Space */ + read_only_space = (lispobj *) READ_ONLY_SPACE_START; + ensure_space(read_only_space, READ_ONLY_SPACE_SIZE); - /* Read-Only Space */ - read_only_space = (lispobj *) READ_ONLY_SPACE_START; - ensure_space(read_only_space, READ_ONLY_SPACE_SIZE); + /* Static Space */ + static_space = (lispobj *) STATIC_SPACE_START; + ensure_space(static_space, STATIC_SPACE_SIZE); - /* Static Space */ - static_space = (lispobj *) STATIC_SPACE_START; - ensure_space(static_space, STATIC_SPACE_SIZE); + /* Dynamic-0 Space */ + dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START; + ensure_space(dynamic_0_space, dynamic_space_size); - /* Dynamic-0 Space */ - dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START; - ensure_space(dynamic_0_space, dynamic_space_size); - - current_dynamic_space = dynamic_0_space; + current_dynamic_space = dynamic_0_space; #ifndef GENCGC - /* Dynamic-1 Space */ - dynamic_1_space = (lispobj *) DYNAMIC_1_SPACE_START; - ensure_space(dynamic_1_space, dynamic_space_size); + /* Dynamic-1 Space */ + dynamic_1_space = (lispobj *) DYNAMIC_1_SPACE_START; + ensure_space(dynamic_1_space, dynamic_space_size); #endif - /* Control Stack */ - control_stack = (lispobj *) CONTROL_STACK_START; + /* Control Stack */ + control_stack = (lispobj *) CONTROL_STACK_START; #ifdef i386 - control_stack_end = (lispobj *) (CONTROL_STACK_START - + CONTROL_STACK_SIZE); + control_stack_end = (lispobj *) (CONTROL_STACK_START + + CONTROL_STACK_SIZE); #endif - ensure_space(control_stack, CONTROL_STACK_SIZE); + ensure_space(control_stack, CONTROL_STACK_SIZE); - /* Binding Stack */ - binding_stack = (lispobj *) BINDING_STACK_START; - ensure_space(binding_stack, BINDING_STACK_SIZE); +#ifdef SIGNAL_STACK_START + ensure_space((lispobj *) SIGNAL_STACK_START, SIGNAL_STACK_SIZE); +#endif + + /* Binding Stack */ + binding_stack = (lispobj *) BINDING_STACK_START; + ensure_space(binding_stack, BINDING_STACK_SIZE); #ifdef LINKAGE_TABLE - ensure_space((lispobj *)FOREIGN_LINKAGE_SPACE_START, - FOREIGN_LINKAGE_SPACE_SIZE); + ensure_space((lispobj *)FOREIGN_LINKAGE_SPACE_START, + FOREIGN_LINKAGE_SPACE_SIZE); #endif #ifdef sparc - make_holes(); + make_holes(); #endif #ifdef PRINTNOISE - printf(" done.\n"); + printf(" done.\n"); +#endif + +#ifdef RED_ZONE_HIT + fprintf (stderr, "guard\n"); + os_guard_control_stack (0, 1); #endif } diff --git a/lisp/x86-validate.h b/lisp/x86-validate.h index e16e55b2717b9de02992e723560874a986543851..f5d5ae1f3f2eb8ff84b58907901ade6c22a81333 100644 --- a/lisp/x86-validate.h +++ b/lisp/x86-validate.h @@ -3,7 +3,7 @@ * This code was written as part of the CMU Common Lisp project at * Carnegie Mellon University, and has been placed in the public domain. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.16 2002/08/27 22:18:34 moore Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.17 2003/03/23 21:23:41 gerd Exp $ * */ @@ -54,8 +54,10 @@ #define BINDING_STACK_START (0x38000000) #define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ -#define CONTROL_STACK_START (0x40000000) -#define CONTROL_STACK_SIZE (0x08000000) /* 128MB */ +#define CONTROL_STACK_START 0x40000000 +#define CONTROL_STACK_SIZE 0x07fd8000 /* 128MB - SIGSTKSZ */ +#define SIGNAL_STACK_START 0x47fd8000 +#define SIGNAL_STACK_SIZE SIGSTKSZ #define DYNAMIC_0_SPACE_START (0x48000000) #ifdef GENCGC @@ -104,8 +106,10 @@ #define BINDING_STACK_START (0x20000000) #define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ -#define CONTROL_STACK_START (0x38000000) -#define CONTROL_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ +#define CONTROL_STACK_START 0x38000000 +#define CONTROL_STACK_SIZE (0x07fff000 - 8192) +#define SIGNAL_STACK_START CONTROL_STACK_END +#define SIGNAL_STACK_SIZE 8192 #define DYNAMIC_0_SPACE_START (0x48000000) #ifdef GENCGC