From 041b4765600465e60f4e187ecc36ce75cdabbd06 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 29 Jan 1990 22:35:32 +0000 Subject: [PATCH] Add the INTERNAL-APPLY-VAL return code. --- v7/src/microcode/returns.h | 8 +++-- v7/src/microcode/version.h | 4 +-- v7/src/runtime/conpar.scm | 7 +++-- v7/src/runtime/framex.scm | 7 +++-- v7/src/runtime/uerror.scm | 61 ++++++++++++++++++++++---------------- v7/src/runtime/version.scm | 4 +-- v8/src/microcode/returns.h | 8 +++-- v8/src/microcode/version.h | 4 +-- v8/src/runtime/conpar.scm | 7 +++-- v8/src/runtime/framex.scm | 7 +++-- 10 files changed, 69 insertions(+), 48 deletions(-) diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h index 1e32f3ff8..101150654 100644 --- 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 #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 dc47b3826..8fdabc6af 100644 --- 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 16d593964..0d0b36d5c 100644 --- 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 ab8f12048..ef7e3af24 100644 --- 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 c7a972243..612dfc5ca 100644 --- 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 02f96b058..816ff8936 100644 --- 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 97200fefd..5e9947f92 100644 --- 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 #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 29f94b310..0f17a1d44 100644 --- 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 cb98cf0da..8dde62eff 100644 --- 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 ea0964aa9..94bf78c98 100644 --- 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) -- 2.25.1