Add new procedure `bind-default-condition-handler'.

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index 731ab88e28bbafea3faf4625325717a24ca0e3f9..e4ceadf12f47358635e7f4bbe2ff82beda772400 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.11 1991/02/15 18:05:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.12 1991/03/06 05:14:06 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -398,21 +398,22 @@ MIT in each case. |#
 \f
 ;;;; Condition Signalling and Handling
 
-(define handler-frames false)
+(define static-handler-frames '())
+(define dynamic-handler-frames '())
 (define break-on-signals-types '())
 
-(define-structure (handler-frame
-                  (type vector)
-                  (conc-name handler-frame/))
-  (types false read-only true)
-  (handler false read-only true)
-  (next false read-only true))
+(define (bind-default-condition-handler types handler)
+  (guarantee-condition-types types 'BIND-DEFAULT-CONDITION-HANDLER)
+  (guarantee-condition-handler handler 'BIND-DEFAULT-CONDITION-HANDLER)
+  (set! static-handler-frames
+       (cons (cons types handler) static-handler-frames))
+  unspecific)
 
 (define (bind-condition-handler types handler thunk)
   (guarantee-condition-types types 'BIND-CONDITION-HANDLER)
   (guarantee-condition-handler handler 'BIND-CONDITION-HANDLER)
-  (fluid-let ((handler-frames
-              (make-handler-frame types handler handler-frames)))
+  (fluid-let ((dynamic-handler-frames
+              (cons (cons types handler) dynamic-handler-frames)))
     (thunk)))
 
 (define (break-on-signals types)
@@ -437,15 +438,21 @@ MIT in each case. |#
            (and (not (null? types))
                 (intersect-generalizations? types)))
          (bkpt "BKPT entered because of BREAK-ON-SIGNALS:" condition))
-      (let loop ((frame handler-frames))
-       (if frame
-           (let ((next (handler-frame/next frame)))
-             (if (let ((types (handler-frame/types frame)))
-                   (or (null? types)
-                       (intersect-generalizations? types)))
-                 (fluid-let ((handler-frames next))
-                   ((handler-frame/handler frame) condition)))
-             (loop next)))))))
+      (do ((frames dynamic-handler-frames (cdr frames)))
+         ((null? frames))
+       (if (let ((types (caar frames)))
+             (or (null? types)
+                 (intersect-generalizations? types)))
+           (fluid-let ((dynamic-handler-frames (cdr frames)))
+             ((cdar frames) condition))))
+      (do ((frames static-handler-frames (cdr frames)))
+         ((null? frames))
+       (if (let ((types (caar frames)))
+             (or (null? types)
+                 (intersect-generalizations? types)))
+           (fluid-let ((static-handler-frames (cdr frames))
+                       (dynamic-handler-frames '()))
+             ((cdar frames) condition)))))))
 \f
 ;;;; Standard Condition Signallers
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index c23350ed48afbd2e52679752dc9f79c39cce5c3a..5d45e75e2baa27c78cd1a5ccd2c93894b1c24a65 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.91 1991/03/01 01:06:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.92 1991/03/06 05:14:23 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -532,6 +532,7 @@ MIT in each case. |#
          abort
          access-condition
          bind-condition-handler
+         bind-default-condition-handler
          bind-restart
          bound-restarts
          break-on-signals

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 2de2a89ddfb73f68a2f951cbb57f791abf1b598b..84210e203ff8723d4d7ce215fa0789fe753f6085 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.108 1991/03/01 20:15:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.109 1991/03/06 05:14:50 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 108))
+  (add-identification! "Runtime" 14 109))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index ad478cd75dd52f47aa8d73ab01a95b25b5e1e834..829562e5620b0e9bc7435be72704f6ff1a12618f 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.91 1991/03/01 01:06:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.92 1991/03/06 05:14:23 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -532,6 +532,7 @@ MIT in each case. |#
          abort
          access-condition
          bind-condition-handler
+         bind-default-condition-handler
          bind-restart
          bound-restarts
          break-on-signals