+ (let* ((local-funs nil)
+ (mapped-bindings (mapcar (lambda (binding)
+ (destructuring-bind (type handler) binding
+ (let (lambda-form)
+ (if (and (consp handler)
+ (or (prog1 (eq 'lambda (car handler))
+ (setf lambda-form handler))
+ (and (eq 'function (car handler))
+ (consp (cdr handler))
+ (consp (cadr handler))
+ (prog1 (eq 'lambda (caadr handler))
+ (setf lambda-form (cadr handler)))))
+ ;; KLUDGE: DX-FLET doesn't handle non-required arguments yet.
+ (not (intersection (second lambda-form) sb!xc:lambda-list-keywords)))
+ (let ((name (gensym "LAMBDA")))
+ (push `(,name ,@(cdr lambda-form)) local-funs)
+ (list type `(function ,name)))
+ binding))))
+ bindings))
+ (form-fun (gensym "FORM-FUN")))
+ `(dx-flet (,@(reverse local-funs)
+ (,form-fun () (progn ,form)))
+ (let ((*handler-clusters*
+ (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x)))
+ mapped-bindings))
+ *handler-clusters*)))
+ (declare (dynamic-extent *handler-clusters*))
+ (,form-fun)))))
+
+(defmacro-mundanely handler-bind (bindings &body forms)
+ #!+sb-doc
+ "(HANDLER-BIND ( {(type handler)}* ) body)
+
+Executes body in a dynamic context where the given handler bindings are in
+effect. Each handler must take the condition being signalled as an argument.
+The bindings are searched first to last in the event of a signalled
+condition."
+ `(%handler-bind ,bindings
+ #!-x86 (progn ,@forms)
+ ;; Need to catch FP errors here!
+ #!+x86 (multiple-value-prog1 (progn ,@forms) (float-wait))))