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