X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-target-error.lisp;h=87bc24071f4549f429ea2380cea21f19d6a12a56;hb=7dd568fb64927be78556ac27f1f0dc60e79cf942;hp=ddf6def0fc276f7b99e0ddaf14823d71f58bbd7c;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/early-target-error.lisp b/src/code/early-target-error.lisp
index ddf6def..87bc240 100644
--- a/src/code/early-target-error.lisp
+++ b/src/code/early-target-error.lisp
@@ -10,7 +10,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!CONDITIONS")
+(in-package "SB!KERNEL")
 
 ;;;; restarts
 
@@ -43,7 +43,7 @@
 	    (res restart))))
       (res))))
 
-(defstruct restart
+(defstruct (restart (:copier nil))
   name
   function
   report-function
@@ -165,8 +165,8 @@
 				    ',name)))
 		`(with-condition-restarts
 		     ,n-cond
-		     (list ,@(mapcar #'(lambda (da)
-					 `(find-restart ',(nth 0 da)))
+		     (list ,@(mapcar (lambda (da)
+				       `(find-restart ',(nth 0 da)))
 				     data))
 		   ,(if (eq name 'cerror)
 			`(cerror ,(second expression) ,n-cond)
@@ -314,20 +314,20 @@
 				bindings))
 		*handler-clusters*)))
      (multiple-value-prog1
-      ,@forms
-      ;; Wait for any float exceptions
-      #!+x86 (float-wait))))
+	 (progn
+	   ,@forms)
+       ;; Wait for any float exceptions.
+       #!+x86 (float-wait))))
 
 ;;;; HANDLER-CASE and IGNORE-ERRORS
 
 (defmacro handler-case (form &rest cases)
-  #!+sb-doc
   "(HANDLER-CASE form
    { (type ([var]) body) }* )
-   Executes form in a context with handlers established for the condition
+   Execute FORM in a context with handlers established for the condition
    types. A peculiar property allows type to be :no-error. If such a clause
    occurs, and form returns normally, all its values are passed to this clause
-   as if by MULTIPLE-VALUE-CALL. The :no-error clause accepts more than one
+   as if by MULTIPLE-VALUE-CALL.  The :NO-ERROR clause accepts more than one
    var specification."
   (let ((no-error-clause (assoc ':no-error cases)))
     (if no-error-clause
@@ -339,56 +339,57 @@
 		 (return-from ,error-return
 		   (handler-case (return-from ,normal-return ,form)
 		     ,@(remove no-error-clause cases)))))))
-	(let ((var (gensym))
-	      (outer-tag (gensym))
-	      (inner-tag (gensym))
-	      (tag-var (gensym))
+	(let ((tag (gensym))
+	      (var (gensym))
 	      (annotated-cases (mapcar #'(lambda (case) (cons (gensym) case))
 				       cases)))
-	  `(let ((,outer-tag (cons nil nil))
-		 (,inner-tag (cons nil nil))
-		 ,var ,tag-var)
-	     ;; FIXME: should be (DECLARE (IGNORABLE ,VAR))
-	     ,var			;ignoreable
-	     (catch ,outer-tag
-	       (catch ,inner-tag
-		 (throw ,outer-tag
+	  `(block ,tag
+	     (let ((,var nil))
+	       (declare (ignorable ,var))
+	       (tagbody
 			(handler-bind
 			    ,(mapcar #'(lambda (annotated-case)
-					 `(,(cadr annotated-case)
-					   #'(lambda (temp)
+			       (list (cadr annotated-case)
+				     `#'(lambda (temp)
 					       ,(if (caddr annotated-case)
 						    `(setq ,var temp)
 						    '(declare (ignore temp)))
-					       (setf ,tag-var
-						     ',(car annotated-case))
-					       (throw ,inner-tag nil))))
+					  (go ,(car annotated-case)))))
 				     annotated-cases)
-			  ,form)))
-	       (case ,tag-var
-		 ,@(mapcar #'(lambda (annotated-case)
-			       (let ((body (cdddr annotated-case))
-				     (varp (caddr annotated-case)))
-				 `(,(car annotated-case)
-				   ,@(if varp
-					 `((let ((,(car varp) ,var))
+			       (return-from ,tag
+				 #-x86 ,form
+				 #+x86 (multiple-value-prog1 ,form
+					 ;; Need to catch FP errors here!
+					 (float-wait))))
+		 ,@(mapcan
+		    #'(lambda (annotated-case)
+			(list (car annotated-case)
+			      (let ((body (cdddr annotated-case)))
+				`(return-from
+				  ,tag
+				  ,(cond ((caddr annotated-case)
+					  `(let ((,(caaddr annotated-case)
+						  ,var))
 					     ,@body))
-					 body))))
+					 ((not (cdr body))
+					  (car body))
+					 (t
+					  `(progn ,@body)))))))
 			   annotated-cases))))))))
 
 (defmacro ignore-errors (&rest forms)
   #!+sb-doc
-  "Executes forms after establishing a handler for all error conditions that
-   returns from this form NIL and the condition signalled."
+  "Execute FORMS handling ERROR conditions, returning the result of the last
+  form, or (VALUES NIL the-ERROR-that-was-caught) if an ERROR was handled."
   `(handler-case (progn ,@forms)
      (error (condition) (values nil condition))))
 
-;;;; helper functions for restartable error handling which couldn't be defined
-;;;; 'til now 'cause they use the RESTART-CASE macro
+;;;; helper functions for restartable error handling which couldn't be
+;;;; defined 'til now 'cause they use the RESTART-CASE macro
 
 (defun assert-error (assertion places datum &rest arguments)
   (let ((cond (if datum
-		(sb!conditions::coerce-to-condition datum
+		(coerce-to-condition datum
 						    arguments
 						    'simple-error
 						    'error)
@@ -442,7 +443,7 @@
 
 (defun case-body-error (name keyform keyform-value expected-type keys)
   (restart-case
-      (error 'sb!conditions::case-failure
+      (error 'case-failure
 	     :name name
 	     :datum keyform-value
 	     :expected-type expected-type