From d564ccae6f79c4423b3d8f8dd1af59844fea6ac2 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 5 Dec 2006 15:27:22 +0000 Subject: [PATCH] 1.0.0.20: report address of memory faults * This is pretty much a stopgap implementation: if memory faults happen in multiple threads the race is on. --- src/code/error.lisp | 6 ++---- src/code/interr.lisp | 5 ++++- src/runtime/bsd-os.c | 2 +- src/runtime/interrupt.c | 13 +++++++++++++ src/runtime/linux-os.c | 2 +- src/runtime/sunos-os.c | 3 +-- version.lisp-expr | 2 +- 7 files changed, 23 insertions(+), 10 deletions(-) diff --git a/src/code/error.lisp b/src/code/error.lisp index e9092b9..1cf2c8e 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -166,9 +166,7 @@ (print-unreadable-object (condition stream)))))) (define-condition memory-fault-error (error) - () + ((address :initarg :address :reader memory-fault-error-address)) (:report (lambda (condition stream) - (declare (ignore condition)) - (format stream "memory fault")))) - + (format stream "Memory fault in address #x~X" (memory-fault-error-address condition))))) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index d07f23d..6bfbf65 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -474,5 +474,8 @@ (defun undefined-alien-function-error () (error 'undefined-alien-function-error)) +(define-alien-variable current-memory-fault-address long) + (defun memory-fault-error () - (error 'memory-fault-error)) + (error 'memory-fault-error + :address current-memory-fault-address)) diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c index 0fda392..0fba4bb 100644 --- a/src/runtime/bsd-os.c +++ b/src/runtime/bsd-os.c @@ -207,7 +207,7 @@ memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context) if (!gencgc_handle_wp_violation(fault_addr)) if(!handle_guard_page_triggered(context,fault_addr)) { #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK - arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR)); + lisp_memory_fault_error(context, fault_addr); #else if (!interrupt_maybe_gc_int(signal, siginfo, context)) { interrupt_handle_now(signal, siginfo, context); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 48bec24..4a4ed1c 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -1391,4 +1391,17 @@ siginfo_code(siginfo_t *info) { return info->si_code; } +os_vm_address_t current_memory_fault_address; + +void +lisp_memory_fault_error(os_context_t *context, os_vm_address_t addr) +{ + /* FIXME: This is lossy: if we get another memory fault (eg. from + * another thread) before lisp has read this, we the information. + * However, since this is mostly informative, we'll live with that for + * now -- some address is better then no address in this case. + */ + current_memory_fault_address = addr; + arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR)); +} #endif diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index fbc888e..d5ae16c 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -388,7 +388,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) #endif if (!handle_guard_page_triggered(context, addr)) #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK - arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR)); + lisp_memory_fault_error(context, addr); #else interrupt_handle_now(signal, info, context); #endif diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c index 9278a72..bc4d397 100644 --- a/src/runtime/sunos-os.c +++ b/src/runtime/sunos-os.c @@ -205,8 +205,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) if (!gencgc_handle_wp_violation(fault_addr)) if(!handle_guard_page_triggered(context, fault_addr)) #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK - arrange_return_to_lisp_function(context, - SymbolFunction(MEMORY_FAULT_ERROR)); + lisp_memory_fault_error(context, fault_addr); #else interrupt_handle_now(signal, info, context); #endif diff --git a/version.lisp-expr b/version.lisp-expr index 30e54e2..bac11ad 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.0.19" +"1.0.0.20" -- 1.7.10.4