X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Finterr.lisp;h=282e1df5627289df1b502f67237f67b8a0256f53;hb=05d9e55946615d14fa26d276b29072931f9dc5b5;hp=6bfbf65c4a393975127edaf7c43766939e30d41c;hpb=d564ccae6f79c4423b3d8f8dd1af59844fea6ac2;p=sbcl.git diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 6bfbf65..282e1df 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -390,6 +390,7 @@ (values "" nil))))) + ;;;; INTERNAL-ERROR signal handler (defun internal-error (context continuable) @@ -400,7 +401,7 @@ (infinite-error-protect (/show0 "about to bind ALIEN-CONTEXT") (let ((alien-context (locally - (declare (optimize (inhibit-warnings 3))) + (declare (optimize (inhibit-warnings 3))) (sb!alien:sap-alien context (* os-context-t))))) (/show0 "about to bind ERROR-NUMBER and ARGUMENTS") (multiple-value-bind (error-number arguments) @@ -474,8 +475,21 @@ (defun undefined-alien-function-error () (error 'undefined-alien-function-error)) +#!-win32 (define-alien-variable current-memory-fault-address long) +#!-win32 (defun memory-fault-error () (error 'memory-fault-error :address current-memory-fault-address)) + +;;; This is SIGTRAP / EXCEPTION_BREAKPOINT that runtime could not deal +;;; with. Prior to Windows we just had a Lisp side handler for +;;; SIGTRAP, but now we need to deal with this portably. +(defun unhandled-trap-error (context-sap) + (declare (type system-area-pointer context-sap)) + (infinite-error-protect + (let ((context (sap-alien context-sap (* os-context-t)))) + (error 'breakpoint-error + :context context + :address (sap-int (sb!vm:context-pc context))))))