Add the INTERNAL-APPLY-VAL return code.

diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h
index 1e32f3ff88b1a3eecb508deae22ccfc77871cc3a..10115065417e0ea4f2f32b14cae1c074316e65d7 100644 (file)
--- a/v7/src/microcode/returns.h
+++ b/v7/src/microcode/returns.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.36 1989/09/20 23:11:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.37 1990/01/29 22:31:02 jinx Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -119,10 +119,11 @@ MIT in each case. */
 /* formerly RC_COMP_CACHE_ASSIGN_RESTART       0x5A */
 #define RC_COMP_LINK_CACHES_RESTART    0x5B
 #define RC_HARDWARE_TRAP               0x5C
+#define RC_INTERNAL_APPLY_VAL          0x5D
 
 /* When adding return codes, add them to the table below as well! */
 
-#define MAX_RETURN_CODE                        0x5C
+#define MAX_RETURN_CODE                        0x5D
 \f
 #define RETURN_NAME_TABLE                                              \
 {                                                                      \
@@ -218,5 +219,6 @@ MIT in each case. */
 /* 0x59 */             "COMPILER_UNASSIGNED_P_TRAP_RESTART",           \
 /* 0x5A */             "",                                             \
 /* 0x5B */             "COMPILER_LINK_CACHES_RESTART",                 \
-/* 0x5C */             "HARDWARE_TRAP"                                 \
+/* 0x5C */             "HARDWARE_TRAP",                                \
+/* 0x5D */             "INTERNAL_APPLY_VAL"                            \
 }

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index dc47b38267cafc6b4d2350bff2496c1dbbd155a9..8fdabc6af03b3eadaf5050b27a1fc276db2f2430 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.22 1990/01/23 08:35:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.23 1990/01/29 22:33:32 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     22
+#define SUBVERSION     23
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index 16d593964a8d69e7a24dad9e1ea02f87d3d3746b..0d0b36d5c149c4de02a2693a089505abcb483788 100644 (file)
--- a/v7/src/runtime/conpar.scm
+++ b/v7/src/runtime/conpar.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.11 1989/12/07 05:35:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.12 1990/01/29 22:34:18 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -561,7 +561,8 @@ MIT in each case. |#
 
     (let ((length (length/application-frame 2 0)))
       (standard-subproblem 'COMBINATION-APPLY length)
-      (standard-subproblem 'INTERNAL-APPLY length))
+      (standard-subproblem 'INTERNAL-APPLY length)
+      (standard-subproblem 'INTERNAL-APPLY-VAL length))
 
     (standard-subproblem 'COMPILER-LOOKUP-APPLY-RESTART
                         (length/application-frame 4 1))

diff --git a/v7/src/runtime/framex.scm b/v7/src/runtime/framex.scm
index ab8f12048f84eec80559892bae5067248187a596..ef7e3af24b4a91975e6e32714d3148ced18852fb 100644 (file)
--- a/v7/src/runtime/framex.scm
+++ b/v7/src/runtime/framex.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/framex.scm,v 14.9 1989/07/13 18:38:41 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/framex.scm,v 14.10 1990/01/29 22:34:56 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -242,6 +242,9 @@ MIT in each case. |#
            (,(method/application-frame 3)
             INTERNAL-APPLY)
 
+           (,(method/application-frame 3)
+            INTERNAL-APPLY-VAL)
+
            (,(method/application-frame 1)
             REPEAT-PRIMITIVE)
 

diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm
index c7a9722438e9d85e9e839a498c680e409a7251da..612dfc5ca98731ed470306b2150e5647f74c8ce8 100644 (file)
--- a/v7/src/runtime/uerror.scm
+++ b/v7/src/runtime/uerror.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uerror.scm,v 14.11 1989/12/07 05:06:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uerror.scm,v 14.12 1990/01/29 22:35:09 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -411,36 +411,45 @@ MIT in each case. |#
           (list (irritant (expression-only-frame/expression frame)))
           repl-environment))))
 
+    (define (define-apply-handler definer)
+      (for-each definer '(INTERNAL-APPLY INTERNAL-APPLY-VAL)))
+
     (define (define-internal-apply-handler error-type environment irritant
              . operators)
-      (define-error-handler error-type 'INTERNAL-APPLY
-       (apply internal-apply-frame/operator-filter operators)
-       (lambda (condition-type frame)
-         (make-error-condition
-          condition-type
-          (list (internal-apply-frame/select frame irritant))
-          (if environment
-              (internal-apply-frame/select frame environment)
-              repl-environment)))))
+      (define-apply-handler
+       (lambda (return-address)
+        (define-error-handler error-type return-address
+          (apply internal-apply-frame/operator-filter operators)
+          (lambda (condition-type frame)
+            (make-error-condition
+             condition-type
+             (list (internal-apply-frame/select frame irritant))
+             (if environment
+                 (internal-apply-frame/select frame environment)
+                 repl-environment)))))))
 
     (define (define-operator-handler error-type)
-      (define-error-handler error-type 'INTERNAL-APPLY true
-       (lambda (condition-type frame)
-         (make-error-condition condition-type
-                               (list (internal-apply-frame/operator frame))
-                               repl-environment))))
+      (define-apply-handler
+       (lambda (return-address)
+         (define-error-handler error-type return-address true
+           (lambda (condition-type frame)
+             (make-error-condition condition-type
+                                   (list (internal-apply-frame/operator frame))
+                                   repl-environment))))))
 
     (define (define-operand-handler error-type irritant #!optional filter)
-      (define-error-handler error-type 'INTERNAL-APPLY
-       (if (default-object? filter) true filter)
-       (lambda (condition-type frame)
-         (make-error-condition
-          condition-type
-          (list (internal-apply-frame/select frame irritant)
-                (error-irritant/noise char:newline)
-                (error-irritant/noise "within procedure")
-                (internal-apply-frame/operator frame))
-          repl-environment))))
+      (define-apply-handler
+       (lambda (return-address)
+         (define-error-handler error-type return-address
+           (if (default-object? filter) true filter)
+           (lambda (condition-type frame)
+             (make-error-condition
+              condition-type
+              (list (internal-apply-frame/select frame irritant)
+                    (error-irritant/noise char:newline)
+                    (error-irritant/noise "within procedure")
+                    (internal-apply-frame/operator frame))
+              repl-environment))))))
 
     (define (define-reference-trap-handler error-type frame-type)
       (define-error-handler error-type frame-type true

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 02f96b0581fa3c0d82d759989a9ef5fadcf72657..816ff8936bd04b390f6e14de214f6bd8e7fc4fbe 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.72 1990/01/22 23:41:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.73 1990/01/29 22:35:32 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 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 72))
+  (add-identification! "Runtime" 14 73))
 
 (define microcode-system)
 

diff --git a/v8/src/microcode/returns.h b/v8/src/microcode/returns.h
index 97200fefdc5ee6401bdd40107e9bce5f41fc163d..5e9947f922982568dc0244023dc7c0cce15bfb9a 100644 (file)
--- a/v8/src/microcode/returns.h
+++ b/v8/src/microcode/returns.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.36 1989/09/20 23:11:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.37 1990/01/29 22:31:02 jinx Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -119,10 +119,11 @@ MIT in each case. */
 /* formerly RC_COMP_CACHE_ASSIGN_RESTART       0x5A */
 #define RC_COMP_LINK_CACHES_RESTART    0x5B
 #define RC_HARDWARE_TRAP               0x5C
+#define RC_INTERNAL_APPLY_VAL          0x5D
 
 /* When adding return codes, add them to the table below as well! */
 
-#define MAX_RETURN_CODE                        0x5C
+#define MAX_RETURN_CODE                        0x5D
 \f
 #define RETURN_NAME_TABLE                                              \
 {                                                                      \
@@ -218,5 +219,6 @@ MIT in each case. */
 /* 0x59 */             "COMPILER_UNASSIGNED_P_TRAP_RESTART",           \
 /* 0x5A */             "",                                             \
 /* 0x5B */             "COMPILER_LINK_CACHES_RESTART",                 \
-/* 0x5C */             "HARDWARE_TRAP"                                 \
+/* 0x5C */             "HARDWARE_TRAP",                                \
+/* 0x5D */             "INTERNAL_APPLY_VAL"                            \
 }

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 29f94b310edf7eccfd3de4375757c141d957f823..0f17a1d443b58573f6ef63a534a829740b133b4c 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.22 1990/01/23 08:35:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.23 1990/01/29 22:33:32 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     22
+#define SUBVERSION     23
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index cb98cf0daeb175538af45530cec0553022b96cfb..8dde62eff7e877ecf333be2223c9328f510681c5 100644 (file)
--- a/v8/src/runtime/conpar.scm
+++ b/v8/src/runtime/conpar.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.11 1989/12/07 05:35:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.12 1990/01/29 22:34:18 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -561,7 +561,8 @@ MIT in each case. |#
 
     (let ((length (length/application-frame 2 0)))
       (standard-subproblem 'COMBINATION-APPLY length)
-      (standard-subproblem 'INTERNAL-APPLY length))
+      (standard-subproblem 'INTERNAL-APPLY length)
+      (standard-subproblem 'INTERNAL-APPLY-VAL length))
 
     (standard-subproblem 'COMPILER-LOOKUP-APPLY-RESTART
                         (length/application-frame 4 1))

diff --git a/v8/src/runtime/framex.scm b/v8/src/runtime/framex.scm
index ea0964aa9153b916eb3fadad535cc4059039456a..94bf78c989799e03edd47d7873981add83677364 100644 (file)
--- a/v8/src/runtime/framex.scm
+++ b/v8/src/runtime/framex.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/framex.scm,v 14.9 1989/07/13 18:38:41 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/framex.scm,v 14.10 1990/01/29 22:34:56 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -242,6 +242,9 @@ MIT in each case. |#
            (,(method/application-frame 3)
             INTERNAL-APPLY)
 
+           (,(method/application-frame 3)
+            INTERNAL-APPLY-VAL)
+
            (,(method/application-frame 1)
             REPEAT-PRIMITIVE)