[Openmcl-cvs-notifications] r13879 - /trunk/source/level-1/x86-trap-support.lisp

[gb at clozure.com]

Author: gb
Date: Thu Jun 24 06:38:17 2010
New Revision: 13879

Log:
It'd help if I checked this in ...

Define *PRE-GC-NOTIFICATION-HOOK*.

Call *PRE-GC-NOTIFICATION-HOOK* if it's non-null when the CMAIN callback
gets a SIGTRAP pseudo-interrupt.

Modified:
    trunk/source/level-1/x86-trap-support.lisp

Modified: trunk/source/level-1/x86-trap-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/x86-trap-support.lisp (original)
+++ trunk/source/level-1/x86-trap-support.lisp Thu Jun 24 06:38:17 2010
@@ -357,6 +357,8 @@
       (conditional-os-constant '(os::FPE_FLTUND os::EXCEPTION_FLT_UNDERFLO=
W)))
     (defconstant float-inexact-code
       (conditional-os-constant '(os::FPE_FLTRES os::EXCEPTION_FLT_INEXACT_=
RESULT)))))
+
+(defparameter *pending-gc-notification-hook* nil)
 =

 ;;; UUOs are handled elsewhere.  This should handle all signals other than
 ;;; those generated by UUOs (and the non-UUO cases of things like SIGSEGV.)
@@ -466,7 +468,12 @@
                                      :address addr
                                      :write-p (not (zerop code)))
                      ()
-                     frame-ptr))))
+                     frame-ptr)))
+          ((=3D signal #$SIGTRAP)
+           (when (=3D code 0)
+             (let* ((hook *pending-gc-notification-hook*))
+               (declare (special *pending-gc-notification-hook*))
+               (when hook (funcall hook))))))
     skip))
 =

 (defun x86-faulting-instruction (xp)