Changeset 10653


Ignore:
Timestamp:
Sep 8, 2008, 12:23:39 PM (11 years ago)
Author:
gz
Message:

per gb, fixes to handler-case (and restart-case et.al.) to fix a possible race condition

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/macros.lisp

    r10480 r10653  
    317317                 `(block ,block
    318318                    (let* ((,restart-name (%cons-restart ',name () ,report ,interactive ,test))
    319                            (,cluster (list ,restart-name))
    320                            (%restarts% (cons ,cluster %restarts%)))
    321                       (declare (dynamic-extent ,restart-name ,cluster %restarts%))
    322                       (catch ,cluster (return-from ,block ,form)))
     319                           (,cluster (list ,restart-name)))
     320                      (declare (dynamic-extent ,restart-name ,cluster))
     321                      (catch ,cluster
     322                        (let ((%restarts% (cons ,cluster %restarts%)))
     323                          (declare (dynamic-extent %restarts%))
     324                          (return-from ,block ,form))))
    323325                    ,@body))))
    324326            (t
     
    337339               `(block ,block
    338340                  (let ((,val (let* (,@restarts
    339                                      (,cluster (list ,@(reverse restart-names)))
    340                                      (%restarts% (cons ,cluster %restarts%)))
    341                                 (declare (dynamic-extent ,@restart-names ,cluster %restarts%))
    342                                 (catch ,cluster (return-from ,block ,form)))))
     341                                     (,cluster (list ,@(reverse restart-names))))
     342                                (declare (dynamic-extent ,@restart-names ,cluster))
     343                                (catch ,cluster
     344                                  (let ((%restarts% (cons ,cluster %restarts%)))
     345                                    (declare (dynamic-extent %restarts%))
     346                                    (return-from ,block ,form))))))
    343347                    (case (pop ,val)
    344348                      ,@(nreverse cases))))))))))
     
    411415                 `(block ,block
    412416                    ((lambda ,var ,@body)
    413                       (let* ((,cluster (list ',type))
    414                             (%handlers% (cons ,cluster %handlers%)))
    415                        (declare (dynamic-extent ,cluster %handlers%))
    416                        (catch ,cluster (return-from ,block ,form)))))
     417                      (let* ((,cluster (list ',type)))
     418                        (declare (dynamic-extent ,cluster))
     419                        (catch ,cluster
     420                          (let ((%handlers% (cons ,cluster %handlers%)))
     421                            (declare (dynamic-extent %handlers%))
     422                            (return-from ,block ,form))))))
    417423                 `(block ,block
    418                     (let* ((,cluster (list ',type))
    419                            (%handlers% (cons ,cluster %handlers%)))
    420                       (declare (dynamic-extent ,cluster %handlers%))
    421                       (catch ,cluster (return-from ,block ,form)))
    422                     (locally ,@body))))))
     424                    (let* ((,cluster (list ',type)))
     425                      (declare (dynamic-extent ,cluster))
     426                      (catch ,cluster
     427                        (let ((%handlers% (cons ,cluster %handlers%)))
     428                          (declare (dynamic-extent %handlers%))
     429                          (return-from ,block ,form)))
     430                      (locally ,@body)))))))
    423431          (t (let ((block (gensym)) (cluster (gensym)) (val (gensym))
    424432                   (index -1) handlers cases)
     
    434442                           `(,index (locally ,@body))) cases)))
    435443               `(block ,block
    436                   (let ((,val (let* ((,cluster (list ,@(nreverse handlers)))
    437                                      (%handlers% (cons ,cluster %handlers%)))
    438                                 (declare (dynamic-extent ,cluster %handlers%))
    439                                 (catch ,cluster (return-from ,block ,form)))))
     444                  (let ((,val (let* ((,cluster (list ,@(nreverse handlers))))
     445                                (declare (dynamic-extent ,cluster))
     446                                (catch ,cluster
     447                                  (let ((%handlers% (cons ,cluster %handlers%)))
     448                                    (declare (dynamic-extent %handlers%))
     449                                    (return-from ,block ,form))))))
    440450                    (case (pop ,val)
    441451                      ,@(nreverse cases)))))))))))
     
    459469                                nil
    460470                                nil))
    461           (,cluster (list ,temp))
    462           (%restarts% (cons ,cluster %restarts%)))
    463      (declare (dynamic-extent ,temp ,cluster %restarts%))
    464      (catch ,cluster ,@body)))
     471          (,cluster (list ,temp)))
     472     (declare (dynamic-extent ,temp ,cluster))
     473     (catch ,cluster
     474       (let ((%restarts% (cons ,cluster %restarts%)))
     475         (declare (dynamic-extent %restarts%))
     476         ,@body))))
    465477
    466478;Like with-simple-restart but takes a pre-consed restart.  Not CL.
    467479(defmacro with-restart (restart &body body &aux (cluster (gensym)))
    468   `(let* ((,cluster (list ,restart))
    469           (%restarts% (cons ,cluster %restarts%)))
    470      (declare (dynamic-extent ,cluster %restarts%))
    471      (catch ,cluster ,@body)))
     480  `(let* ((,cluster (list ,restart)))
     481     (declare (dynamic-extent ,cluster))
     482     (catch ,cluster
     483       (let ((%restarts% (cons ,cluster %restarts%)))
     484         (declare (dynamic-extent %restarts%))
     485         ,@body))))
    472486
    473487(defmacro ignore-errors (&rest forms)
Note: See TracChangeset for help on using the changeset viewer.