X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Finterr.lisp;h=d07f23d406c90e18b2b6a236fbbbbc2576641a8e;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=5b97d54edb8a84718a915b21665f0d1441e284fc;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 5b97d54..d07f23d 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -238,7 +238,7 @@
          :operands (list this that)))
 
 (deferr object-not-type-error (object type)
-  (error (if (and (typep object 'instance)
+  (error (if (and (%instancep object)
                   (layout-invalid (%instance-layout object)))
              'layout-invalid
              'type-error)
@@ -363,8 +363,8 @@
           (values "<error finding caller name -- trapped debug-condition>"
                   nil)))))
 
-(defun find-interrupted-name ()
-  (/show0 "entering FIND-INTERRUPTED-NAME")
+(defun find-interrupted-name-and-frame ()
+  (/show0 "entering FIND-INTERRUPTED-NAME-AND-FRAME")
   (if *finding-name*
       (values "<error finding interrupted name -- already finding name>" nil)
       (handler-case
@@ -392,8 +392,6 @@
 
 ;;;; INTERNAL-ERROR signal handler
 
-(defvar *internal-error-args*)
-
 (defun internal-error (context continuable)
   (declare (type system-area-pointer context))
   (declare (ignore continuable))
@@ -420,7 +418,7 @@
          (%primitive sb!c:halt))
 
        (multiple-value-bind (name sb!debug:*stack-top-hint*)
-           (find-interrupted-name)
+           (find-interrupted-name-and-frame)
          (/show0 "back from FIND-INTERRUPTED-NAME")
          (let ((fp (int-sap (sb!vm:context-register alien-context
                                                     sb!vm::cfp-offset)))
@@ -456,6 +454,20 @@
              "Control stack guard page temporarily disabled: proceed with caution~%")
      (error 'control-stack-exhausted))))
 
+;;; KLUDGE: we keep a single HEAP-EXHAUSTED-ERROR object around, so
+;;; that we don't need to allocate it when running out of memory. Similarly
+;;; we pass the amounts in special variables as there may be multiple threads
+;;; running into trouble at the same time. The condition is created by GC-REINIT.
+(defvar *heap-exhausted-error-condition*)
+(defvar *heap-exhausted-error-available-bytes*)
+(defvar *heap-exhausted-error-requested-bytes*)
+
+(defun heap-exhausted-error (available requested)
+  (infinite-error-protect
+   (let ((*heap-exhausted-error-available-bytes* available)
+         (*heap-exhausted-error-requested-bytes* requested))
+     (error *heap-exhausted-error-condition*))))
+
 (defun undefined-alien-variable-error ()
   (error 'undefined-alien-variable-error))
 
@@ -463,4 +475,4 @@
   (error 'undefined-alien-function-error))
 
 (defun memory-fault-error ()
-  (error 'memory-fault-error))
\ No newline at end of file
+  (error 'memory-fault-error))