From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Wed, 3 Oct 1990 21:53:21 +0000 (+0000)
Subject: Add handler for COMPILER-ERROR-RESTART.
X-Git-Tag: 20090517-FFI~11154
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f204c43e583206c086910f4b02dafef5ed2d43a0;p=mit-scheme.git

Add handler for COMPILER-ERROR-RESTART.
---

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index 072c2ade6..4f5dd2eec 100644
--- 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 7bf670597..e1968991f 100644
--- 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 66c750838..222f0ffb0 100644
--- 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 3f7a7ba53..f3c7a671f 100644
--- 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