X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-target-error.lisp;h=216a9fedf3ca1350b56d7b978c3390a680bbc79f;hb=2d0b882f9eabffe5e2d32c0e2e7ab06c96f4fea3;hp=8ea1f031ee8f203b77dc401446eb8332e263a20f;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/early-target-error.lisp b/src/code/early-target-error.lisp index 8ea1f03..216a9fe 100644 --- a/src/code/early-target-error.lisp +++ b/src/code/early-target-error.lisp @@ -10,10 +10,7 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!CONDITIONS") - -(sb!int:file-comment - "$Header$") +(in-package "SB!KERNEL") ;;;; restarts @@ -46,7 +43,7 @@ (res restart)))) (res)))) -(defstruct restart +(defstruct (restart (:copier nil)) name function report-function @@ -317,9 +314,10 @@ 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 @@ -379,65 +377,6 @@ body)))) annotated-cases)))))))) -;;; FIXME: Delete this when the system is stable. -#| -This macro doesn't work in our system due to lossage in closing over tags. -The previous version sets up unique run-time tags. - -(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 - 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 - var specification." - (let ((no-error-clause (assoc ':no-error cases))) - (if no-error-clause - (let ((normal-return (make-symbol "normal-return")) - (error-return (make-symbol "error-return"))) - `(block ,error-return - (multiple-value-call #'(lambda ,@(cdr no-error-clause)) - (block ,normal-return - (return-from ,error-return - (handler-case (return-from ,normal-return ,form) - ,@(remove no-error-clause cases))))))) - (let ((tag (gensym)) - (var (gensym)) - (annotated-cases (mapcar #'(lambda (case) (cons (gensym) case)) - cases))) - `(block ,tag - (let ((,var nil)) - ,var ;ignorable - (tagbody - (handler-bind - ,(mapcar #'(lambda (annotated-case) - (list (cadr annotated-case) - `#'(lambda (temp) - ,(if (caddr annotated-case) - `(setq ,var temp) - '(declare (ignore temp))) - (go ,(car annotated-case))))) - annotated-cases) - (return-from ,tag ,form)) - ,@(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)) - ((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 @@ -450,7 +389,7 @@ The previous version sets up unique run-time tags. (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) @@ -504,7 +443,7 @@ The previous version sets up unique run-time tags. (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