From 3e309c44e9ab7792a269c15d34930dbdd9b074c6 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Fri, 24 Oct 2003 02:57:00 +0000 Subject: [PATCH] Add support for catching heap overflows, similar to the control stack overflow checking. Enable with :heap-overflow-check. We reserve some number of pages on the heap. When the heap reaches the reserved pages, an overflow warning is signalled. The reserved pages are set 0. This allows some additional allocation to happen during debugging, if necessary. If another overflow happens, we throw to top-level. Sparc only right now. * lisp/sparc-assem.S (_do_dynamic_space_overflow_error): New function to handle a heap overflow error. (_do_dynamic_space_overflow_warning): New function to handle heap overflow warning. * lisp/sparc-arch.c (sigill_handler): Handle the two new traps caused by heap overflows. * lisp/interrupt.c (interrupt_handle_space_overflow): New function to handle interrupt caused by heap space overflows. * lisp/gencgc.c (handle_heap_overflow): New function to handle heap overflows. (gc_alloc_new_region): Use handle_heap_overflow. (gc_alloc_large): Use handle_heap_overflow * compiler/sparc/parms.lisp (static-symbols): Add new static symbols for heap overflow checking: dynamic-space-overflow-error-hit and dynamic-space-overflow-warning-hit. * compiler/generic/new-genesis.lisp (finish-symbols): Initialize the new dynamic-space-overflow-error-hit and dynamic-space-overflow-warning-hit static symbols. * code/lispinit.lisp (:heap-overflow-check): Add heap-overflow-check to *runtime-features*, if necessary. ("reserved_heap_pages"): Access to alien variable for heap overflow. (*reserved-heap-pages*): Default number of heap pages to reserve for heap overflow. (%top-level): Set reserved-heap-pages to the default. * code/interr.lisp (dynamic-space-overflow-warning-hit): Add function to handle heap overflow warnings. (dynamic-space-overflow-error-hit): Add function to handle heap overflow error. * code/error.lisp (heap-overflow): Add new condition type for heap overflow --- code/error.lisp | 11 ++++- code/interr.lisp | 20 +++++++- code/lispinit.lisp | 14 +++++- compiler/generic/new-genesis.lisp | 6 ++- compiler/sparc/parms.lisp | 16 ++++-- lisp/gencgc.c | 81 +++++++++++++++++++++---------- lisp/interrupt.c | 17 ++++++- lisp/sparc-arch.c | 16 +++++- lisp/sparc-assem.S | 22 +++++++++ 9 files changed, 166 insertions(+), 37 deletions(-) diff --git a/code/error.lisp b/code/error.lisp index 6f6f669e3..8aae03703 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.76 2003/07/20 11:02:48 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.77 2003/10/24 02:56:59 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,7 +22,7 @@ (export '(layout-invalid condition-function-name simple-control-error simple-file-error simple-program-error simple-parse-error simple-style-warning simple-undefined-function - stack-overflow)) + stack-overflow heap-overflow)) (in-package "LISP") (export '(break error warn cerror @@ -951,6 +951,13 @@ (declare (ignore condition)) (format stream "Control stack overflow")))) +#+heap-overflow-check +(define-condition heap-overflow (storage-condition) + () + (:report (lambda (condition stream) + (declare (ignore condition)) + (format stream "Heap (dynamic space) 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/interr.lisp b/code/interr.lisp index 783f196b1..6a593b962 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.42 2003/05/26 20:20:32 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.43 2003/10/24 02:56:59 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,8 @@ (in-package "KERNEL") (export '(infinite-error-protect find-caller-name *maximum-error-depth* - red-zone-hit yellow-zone-hit)) + red-zone-hit yellow-zone-hit + dynamic-space-overflow-error-hit dynamic-space-overflow-warning-hit)) @@ -657,4 +658,19 @@ Returning to Top-Level.~@:>~2%") (throw 'lisp::top-level-catcher nil)) +#+heap-overflow-check +(defun dynamic-space-overflow-warning-hit () + (let ((debug:*stack-top-hint* nil)) + ;; Don't reserve any more pages + (setf lisp::reserved-heap-pages 0) + (format *error-output* + "~2&~@<Imminent dynamic space overflow has occurred: ~ + Only a small amount of dynamic space is available now. ~ + Please note that you will be returned to the Top-Level without ~ + warning if you run out of space while debugging.~@:>~%") + (infinite-error-protect (error 'heap-overflow)))) + +#+heap-overflow-check +(defun dynamic-space-overflow-error-hit () + (throw 'lisp::top-level-catcher nil)) diff --git a/code/lispinit.lisp b/code/lispinit.lisp index e584f98e0..3f2d2fb08 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.72 2003/09/25 02:40:12 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.73 2003/10/24 02:56:59 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -38,6 +38,9 @@ #+stack-checking (sys:register-lisp-runtime-feature :stack-checking) +#+heap-overflow-check +(sys:register-lisp-runtime-feature :heap-overflow-check) + ;;; Make the error system enable interrupts. (defconstant most-positive-fixnum #.vm:target-most-positive-fixnum @@ -616,6 +619,13 @@ (defconstant eofs-before-quit 10) +(defparameter *reserved-heap-pages* 256 + "How many pages to reserve from the total heap space so we can handle +heap overflow.") + +#+heap-overflow-check +(alien:def-alien-variable "reserved_heap_pages" c-call:unsigned-long) + (defun %top-level () "Top-level READ-EVAL-PRINT loop. Do not call this." (let ((* nil) (** nil) (*** nil) @@ -631,6 +641,8 @@ (loop (scrub-control-stack) (fresh-line) + ;; Reset reserved pages in the heap + #+heap-overflow-check (setf reserved-heap-pages *reserved-heap-pages*) (princ (if (functionp *prompt*) (funcall *prompt*) *prompt*)) diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index a8db59f4d..cb6cb741b 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.62 2003/10/13 21:51:04 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.63 2003/10/24 02:56:59 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -707,6 +707,10 @@ (progn (frob kernel::yellow-zone-hit) (frob kernel::red-zone-hit)) + #+heap-overflow-check + (progn + (frob kernel::dynamic-space-overflow-error-hit) + (frob kernel::dynamic-space-overflow-warning-hit)) (frob di::handle-breakpoint) (frob di::handle-function-end-breakpoint) (frob lisp::fdefinition-object)) diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp index becd961fb..2595e54f8 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.46 2003/10/09 21:55:46 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.47 2003/10/24 02:57:00 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -210,7 +210,10 @@ (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap - after-breakpoint-trap allocation-trap pseudo-atomic-trap + after-breakpoint-trap allocation-trap + dynamic-space-overflow-error-trap + dynamic-space-overflow-warning-trap + pseudo-atomic-trap object-not-list-trap object-not-instance-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) @@ -222,7 +225,10 @@ cerror breakpoint function-end-breakpoint - after-breakpoint) + after-breakpoint + dynamic-space-overflow-warning + dynamic-space-overflow-error + ) ;; Make sure this starts AFTER the last element of the above enum! (defenum (:prefix object-not- :suffix -trap :start 16) @@ -263,6 +269,8 @@ kernel::internal-error #+stack-checking kernel::yellow-zone-hit #+stack-checking kernel::red-zone-hit + #+heap-overflow-check kernel::dynamic-space-overflow-warning-hit + #+heap-overflow-check kernel::dynamic-space-overflow-error-hit di::handle-breakpoint lisp::fdefinition-object @@ -354,7 +362,7 @@ ;;;; ;;;; This value is added to alloc-tn to indicate a pseudo-atomic ;;;; section. -(defconstant pseudo-atomic-value (ash 1 (1- vm:lowtag-bits))) +(defconstant pseudo-atomic-value (ash 1 (1- vm::lowtag-bits))) ;;;; Pseudo-atomic-interrupted-mask ;;;; diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 7ebc3e4d4..1b0e8ab02 100644 --- a/lisp/gencgc.c +++ b/lisp/gencgc.c @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997, 1998, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.45 2003/10/16 16:18:03 toy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.46 2003/10/24 02:57:00 toy Exp $ * */ @@ -270,6 +270,16 @@ volatile unsigned long long bytes_allocated_sum = 0; */ unsigned long auto_gc_trigger = 0xffffffff; +/* + * Number of pages to reserve for heap overflow. We want some space + * available on the heap when we are close to a heap overflow, so we + * can handle the overflow. But how much do we really need? I (rtoy) + * think 256 pages is probably a decent amount. (That's 1 MB for x86, + * 2 MB for sparc, which has 8K pages.) + */ + +unsigned long reserved_heap_pages = 256; + /* * The src. and dest. generations. Set before a GC starts scavenging. */ @@ -706,6 +716,43 @@ void *current_region_end_addr; /* The generation currently being allocated to. X */ static int gc_alloc_generation; +/* Handle heap overflow here, maybe. */ +static void +handle_heap_overflow(const char* msg, int size) +{ + unsigned long heap_size_mb; + + if (msg) + { + fprintf(stderr, msg, size); + } +#ifndef SPARSE_BLOCK_SIZE +#define SPARSE_BLOCK_SIZE (0) +#endif + + /* Figure out how many MB of heap we have */ + heap_size_mb = (dynamic_space_size + SPARSE_BLOCK_SIZE) >> 20; + + fprintf(stderr, " CMUCL has run out of dynamic heap space (%lu MB).\n", heap_size_mb); + /* Try to handle heap overflow somewhat gracefully if we can. */ +#if defined(trap_DynamicSpaceOverflow) || defined(FEATURE_HEAP_OVERFLOW_CHECK) + if (reserved_heap_pages == 0) + { + fprintf(stderr, "\n Returning to top-level.\n"); + do_dynamic_space_overflow_error(); + } + else + { + fprintf(stderr, " You can control heap size with the -dynamic-space-size commandline option.\n"); + do_dynamic_space_overflow_warning(); + } +#else + print_generation_stats(1); + + exit(1); +#endif +} + /* * Find a new region with room for at least the given number of bytes. * @@ -787,12 +834,8 @@ static void gc_alloc_new_region(int nbytes, int unboxed, } /* Check for a failure */ - if (first_page >= dynamic_space_pages) { - fprintf(stderr, "!!! CMUCL has run out of dynamic heap space. You can control heap size\n"); - fprintf(stderr, "!!! with the -dynamic-space-size commandline option.\n"); - fprintf(stderr, "*A2 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); - print_generation_stats(1); - exit(1); + if (first_page >= dynamic_space_pages - reserved_heap_pages) { + handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); } gc_assert(!PAGE_WRITE_PROTECTED(first_page)); @@ -835,12 +878,8 @@ static void gc_alloc_new_region(int nbytes, int unboxed, while (restart_page < dynamic_space_pages && bytes_found < nbytes); /* Check for a failure */ - if (restart_page >= dynamic_space_pages && bytes_found < nbytes) { - fprintf(stderr, "!!! CMUCL has run out of dynamic heap space. You can control heap size\n"); - fprintf(stderr, "!!! with the -dynamic-space-size commandline option.\n"); - fprintf(stderr, "*A1 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); - print_generation_stats(1); - exit(1); + if (restart_page >= (dynamic_space_pages - reserved_heap_pages) && bytes_found < nbytes) { + handle_heap_overflow("*A1 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); } #if 0 @@ -1235,12 +1274,8 @@ static void *gc_alloc_large(int nbytes, int unboxed, } /* Check for a failure */ - if (first_page >= dynamic_space_pages) { - fprintf(stderr, "!!! CMUCL has run out of dynamic heap space. You can control heap size\n"); - fprintf(stderr, "!!! with the -dynamic-space-size commandline option.\n"); - fprintf(stderr, "*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes); - print_generation_stats(1); - exit(1); + if (first_page >= dynamic_space_pages - reserved_heap_pages) { + handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes); } gc_assert(!PAGE_WRITE_PROTECTED(first_page)); @@ -1277,12 +1312,8 @@ static void *gc_alloc_large(int nbytes, int unboxed, while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes)); /* Check for a failure */ - if (restart_page >= dynamic_space_pages && bytes_found < nbytes) { - fprintf(stderr, "*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes); - fprintf(stderr, "!!! CMUCL has run out of dynamic heap space. You can control heap size\n"); - fprintf(stderr, "!!! with the -dynamic-space-size commandline option.\n"); - print_generation_stats(1); - exit(1); + if (restart_page >= (dynamic_space_pages - reserved_heap_pages) && bytes_found < nbytes) { + handle_heap_overflow("*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes); } #if 0 diff --git a/lisp/interrupt.c b/lisp/interrupt.c index 6e0a315c8..3eda3821a 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.30 2003/07/19 14:10:16 emarsden Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.31 2003/10/24 02:57:00 toy Exp $ */ /* Interrupt handing magic. */ @@ -630,6 +630,21 @@ unsigned long install_handler(int signal, } #endif +void +interrupt_handle_space_overflow(lispobj error, struct sigcontext *context) +{ + + build_fake_control_stack_frame (context); + /* 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; +} + void interrupt_init(void) { int i; diff --git a/lisp/sparc-arch.c b/lisp/sparc-arch.c index ba7607716..6a5b9f9aa 100644 --- a/lisp/sparc-arch.c +++ b/lisp/sparc-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.18 2003/10/16 16:21:59 toy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.19 2003/10/24 02:57:00 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. @@ -426,6 +426,20 @@ static void sigill_handler(HANDLER_ARGS) sizeof(unsigned long)); break; +#ifdef trap_DynamicSpaceOverflowWarning + case trap_DynamicSpaceOverflowWarning: + arch_skip_instruction(context); + interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), + context); + break; +#endif +#ifdef trap_DynamicSpaceOverflowError + case trap_DynamicSpaceOverflowError: + arch_skip_instruction(context); + interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), + context); + break; +#endif default: interrupt_handle_now(signal, code, context); break; diff --git a/lisp/sparc-assem.S b/lisp/sparc-assem.S index 3dbc6b46b..ad3b2648a 100644 --- a/lisp/sparc-assem.S +++ b/lisp/sparc-assem.S @@ -18,6 +18,8 @@ #define _call_into_c call_into_c #define _flush_icache flush_icache #define _do_pending_interrupt do_pending_interrupt +#define _do_dynamic_space_overflow_error do_dynamic_space_overflow_error +#define _do_dynamic_space_overflow_warning do_dynamic_space_overflow_warning #ifdef GENCGC /*#define _collect_garbage collect_garbage*/ #define _fpu_save fpu_save @@ -370,6 +372,26 @@ _do_pending_interrupt: nop SET_SIZE(_do_pending_interrupt) +#ifdef trap_DynamicSpaceOverflowError + .global _do_dynamic_space_overflow_error + FUNCDEF(_do_dynamic_space_overflow_error) +_do_dynamic_space_overflow_error: + unimp trap_DynamicSpaceOverflowError + retl + nop + SET_SIZE(_do_dynamic_space_overflow_error) +#endif + +#ifdef trap_DynamicSpaceOverflowWarning + .global _do_dynamic_space_overflow_warning + FUNCDEF(_do_dynamic_space_overflow_warning) +_do_dynamic_space_overflow_warning: + unimp trap_DynamicSpaceOverflowWarning + retl + nop + SET_SIZE(_do_dynamic_space_overflow_warning) +#endif + #ifdef LINKAGE_TABLE /* * Call into C code to resolve a linkage entry. -- GitLab