Add handler for COMPILER-ERROR-RESTART.

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index 072c2ade607a7937d0a6237dc9bb0876a0d7b12b..4f5dd2eece4024f913c62aa94c624b2da6a30bf4 100644 (file)
--- a/v7/src/runtime/conpar.scm
+++ b/v7/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.19 1990/09/11 20:43:44 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.20 1990/10/03 21:53:21 jinx Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -303,7 +303,7 @@ MIT in each case. |#
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
-                     (parser-state/fluid-bindingU state)
+                     (parser-state/fluid-bindings state)
                      (vector-ref elements 1)
                      (parser-state/history state)
                      (parser-state/previous-history-offset state)
@@ -626,7 +626,9 @@ MIT in each case. |#
       (compiler-subproblem 'COMPILER-SAFE-REFERENCE-TRAP-RESTART 4)
       (compiler-subproblem 'COMPILER-UNASSIGNED?-RESTART 4)
       (compiler-subproblem 'COMPILER-UNASSIGNED?-TRAP-RESTART 4)
-      (compiler-subproblem 'COMPILER-UNBOUND?-RESTART 4))
+      (compiler-subproblem 'COMPILER-UNBOUND?-RESTART 4)
+
+      (compiler-subproblem 'COMPILER-ERROR-RESTART 3))
 
     (stack-frame-type 'HARDWARE-TRAP
                      true

diff --git a/v7/src/runtime/framex.scm b/v7/src/runtime/framex.scm
index 7bf67059700b655ab07fa412eefbc8f109fee4bf..e1968991fed9915d76a3e7abac83181fa92e4815 100644 (file)
--- a/v7/src/runtime/framex.scm
+++ b/v7/src/runtime/framex.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/framex.scm,v 14.13 1990/09/12 00:43:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/framex.scm,v 14.14 1990/10/03 21:52:58 jinx Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -42,18 +42,21 @@ MIT in each case. |#
         (stack-frame-type/debugging-info-method (stack-frame/type frame))))
     (if (not method)
        ;; (error "STACK-FRAME/DEBUGGING-INFO: missing method" frame)
-       (values (make-debugging-info/noise
-                (lambda (long?)
-                  (with-output-to-string
-                    (lambda ()
-                      (display "Unknown (methodless) ")
-                      (if long?
-                          (pp frame)
-                          (write frame))))))
-               undefined-environment
-               undefined-expression)
+       (stack-frame/debugging-info/default frame)
        (method frame))))
 
+(define (stack-frame/debugging-info/default frame)
+  (values (make-debugging-info/noise
+          (lambda (long?)
+            (with-output-to-string
+              (lambda ()
+                (display "Unknown (methodless) ")
+                (if long?
+                    (pp frame)
+                    (write frame))))))
+         undefined-environment
+         undefined-expression))
+
 (define (debugging-info/undefined-expression? expression)
   (or (eq? expression undefined-expression)
       (debugging-info/noise? expression)))
@@ -192,6 +195,16 @@ MIT in each case. |#
          (stack-frame/ref frame 3)
          undefined-expression))
 
+(define (method/compiler-error-restart frame)
+  (let ((primitive (stack-frame/ref frame 2)))
+    (if (primitive-procedure? primitive)
+       (values (%make-combination (make-variable 'apply)
+                                  (list primitive
+                                        unknown-expression))
+               undefined-environment
+               undefined-expression)
+       (stack-frame/debugging-info/default frame))))
+
 (define (stack-frame-list frame start)
   (let ((end (stack-frame/length frame)))
     (let loop ((index start))
@@ -341,6 +354,8 @@ MIT in each case. |#
                 method/compiler-lookup-apply-trap-restart)
   (record-method 'COMPILER-OPERATOR-LOOKUP-TRAP-RESTART
                 method/compiler-lookup-apply-trap-restart)
+  (record-method 'COMPILER-ERROR-RESTART
+                method/compiler-error-restart)
   (record-method 'HARDWARE-TRAP method/hardware-trap)
   (set-stack-frame-type/debugging-info-method!
    stack-frame-type/compiled-return-address

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index 66c75083855d3dc1e3c1d975812209f38fa36983..222f0ffb0a5b8c2176334a2e58d51ea3740239af 100644 (file)
--- a/v8/src/runtime/conpar.scm
+++ b/v8/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.19 1990/09/11 20:43:44 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.20 1990/10/03 21:53:21 jinx Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -303,7 +303,7 @@ MIT in each case. |#
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
-                     (parser-state/fluid-bindingU state)
+                     (parser-state/fluid-bindings state)
                      (vector-ref elements 1)
                      (parser-state/history state)
                      (parser-state/previous-history-offset state)
@@ -626,7 +626,9 @@ MIT in each case. |#
       (compiler-subproblem 'COMPILER-SAFE-REFERENCE-TRAP-RESTART 4)
       (compiler-subproblem 'COMPILER-UNASSIGNED?-RESTART 4)
       (compiler-subproblem 'COMPILER-UNASSIGNED?-TRAP-RESTART 4)
-      (compiler-subproblem 'COMPILER-UNBOUND?-RESTART 4))
+      (compiler-subproblem 'COMPILER-UNBOUND?-RESTART 4)
+
+      (compiler-subproblem 'COMPILER-ERROR-RESTART 3))
 
     (stack-frame-type 'HARDWARE-TRAP
                      true

diff --git a/v8/src/runtime/framex.scm b/v8/src/runtime/framex.scm
index 3f7a7ba534ca1d0dbc31fbec1029d9852d98a613..f3c7a671f4fd16f5b30b31745b01c2da147c12f1 100644 (file)
--- a/v8/src/runtime/framex.scm
+++ b/v8/src/runtime/framex.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/framex.scm,v 14.13 1990/09/12 00:43:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/framex.scm,v 14.14 1990/10/03 21:52:58 jinx Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -42,18 +42,21 @@ MIT in each case. |#
         (stack-frame-type/debugging-info-method (stack-frame/type frame))))
     (if (not method)
        ;; (error "STACK-FRAME/DEBUGGING-INFO: missing method" frame)
-       (values (make-debugging-info/noise
-                (lambda (long?)
-                  (with-output-to-string
-                    (lambda ()
-                      (display "Unknown (methodless) ")
-                      (if long?
-                          (pp frame)
-                          (write frame))))))
-               undefined-environment
-               undefined-expression)
+       (stack-frame/debugging-info/default frame)
        (method frame))))
 
+(define (stack-frame/debugging-info/default frame)
+  (values (make-debugging-info/noise
+          (lambda (long?)
+            (with-output-to-string
+              (lambda ()
+                (display "Unknown (methodless) ")
+                (if long?
+                    (pp frame)
+                    (write frame))))))
+         undefined-environment
+         undefined-expression))
+
 (define (debugging-info/undefined-expression? expression)
   (or (eq? expression undefined-expression)
       (debugging-info/noise? expression)))
@@ -192,6 +195,16 @@ MIT in each case. |#
          (stack-frame/ref frame 3)
          undefined-expression))
 
+(define (method/compiler-error-restart frame)
+  (let ((primitive (stack-frame/ref frame 2)))
+    (if (primitive-procedure? primitive)
+       (values (%make-combination (make-variable 'apply)
+                                  (list primitive
+                                        unknown-expression))
+               undefined-environment
+               undefined-expression)
+       (stack-frame/debugging-info/default frame))))
+
 (define (stack-frame-list frame start)
   (let ((end (stack-frame/length frame)))
     (let loop ((index start))
@@ -341,6 +354,8 @@ MIT in each case. |#
                 method/compiler-lookup-apply-trap-restart)
   (record-method 'COMPILER-OPERATOR-LOOKUP-TRAP-RESTART
                 method/compiler-lookup-apply-trap-restart)
+  (record-method 'COMPILER-ERROR-RESTART
+                method/compiler-error-restart)
   (record-method 'HARDWARE-TRAP method/hardware-trap)
   (set-stack-frame-type/debugging-info-method!
    stack-frame-type/compiled-return-address