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.

diff --git a/src/code/error.lisp b/src/code/error.lisp
index e9092b9..1cf2c8e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"