From 749f76994d89f64ba888bf06ef55b79afa8959f8 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 26 Jan 1991 03:24:00 +0000 Subject: [PATCH] Make changes to handle new system-call errors that are generated by microcode version 11.61. This runtime system will continue to work with older microcode versions. --- v7/src/runtime/runtime.pkg | 8 +++-- v7/src/runtime/uerror.scm | 60 ++++++++++++++++++++++---------------- v7/src/runtime/utabs.scm | 27 ++++++++++++++--- v7/src/runtime/version.scm | 6 ++-- v8/src/runtime/runtime.pkg | 8 +++-- 5 files changed, 73 insertions(+), 36 deletions(-) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 4dd598226..2373ecc3b 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.87 1990/11/15 23:27:32 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.88 1991/01/26 03:23:44 cph Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -1105,6 +1105,10 @@ MIT in each case. |# microcode-return/code->name microcode-return/code-limit microcode-return/name->code + microcode-system-call-error/code->name + microcode-system-call-error/name->code + microcode-system-call/code->name + microcode-system-call/name->code microcode-termination/code->name microcode-termination/code-limit microcode-termination/name->code diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm index 342c88596..00533039f 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.16 1990/10/03 21:53:53 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uerror.scm,v 14.17 1991/01/26 03:23:51 cph Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -70,7 +70,6 @@ MIT in each case. |# (define (make-error-translator alist error-type) (lambda (error-code interrupt-enables) - error-code (set-interrupt-enables! interrupt-enables) (with-proceed-point proceed-value-filter (lambda () @@ -90,7 +89,7 @@ MIT in each case. |# (cdar translators) (loop (cdr translators))))))))))) (if translator - (translator error-type frame) + (translator error-type frame error-code) (make-error-condition error-type '() repl-environment))))))))) @@ -102,7 +101,9 @@ MIT in each case. |# (signal-error (make-error-condition error-type:anomalous - (list (or (microcode-error/code->name error-code) error-code)) + (list (or (and (exact-nonnegative-integer? error-code) + (microcode-error/code->name error-code)) + error-code)) repl-environment))))) ;;;; Frame Decomposition @@ -147,7 +148,8 @@ MIT in each case. |# ;;;; Special Handlers -(define (wrong-number-of-arguments-error condition-type frame) +(define (wrong-number-of-arguments-error condition-type frame error-code) + error-code (make-error-condition condition-type (let ((operator (internal-apply-frame/operator frame))) @@ -162,17 +164,18 @@ MIT in each case. |# (cdr arity)))) repl-environment)) -(define (file-error condition-type frame) - condition-type frame +(define (file-error condition-type frame error-code) + condition-type frame error-code (make-error-condition error-type:file '() repl-environment)) -(define (open-file-error condition-type frame) - condition-type +(define (open-file-error condition-type frame error-code) + condition-type error-code (make-error-condition error-type:open-file (list (internal-apply-frame/operand frame 0)) repl-environment)) -(define (out-of-file-handles-error condition-type frame) +(define (out-of-file-handles-error condition-type frame error-code) + error-code (make-error-condition condition-type (list (internal-apply-frame/operand frame 0)) repl-environment)) @@ -240,7 +243,8 @@ MIT in each case. |# (make-condition-type (list error-type:file) "Channel write terminated prematurely")) (set! error-type:anomalous - (make-internal-type "Anomalous microcode error"))) + (make-internal-type "Anomalous microcode error")) + unspecific) (define (make-base-type message) (make-condition-type (list condition-type:error) message)) @@ -329,6 +333,7 @@ MIT in each case. |# (INAPPLICABLE-CONTINUATION ,(make-internal-type "Inapplicable continuation")) (IO-ERROR ,(make-condition-type (list error-type:file) "I/O error")) + (SYSTEM-CALL ,(make-internal-type "Error in system call")) (OUT-OF-FILE-HANDLES ,(make-condition-type (list error-type:open-file) "Too many open files")) @@ -402,7 +407,8 @@ MIT in each case. |# (define (define-standard-frame-handler error-type frame-type frame-filter irritant) (define-error-handler error-type frame-type frame-filter - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (irritant (standard-frame/expression frame))) @@ -411,7 +417,8 @@ MIT in each case. |# (define (define-expression-frame-handler error-type frame-type frame-filter irritant) (define-error-handler error-type frame-type frame-filter - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (irritant (expression-only-frame/expression frame))) @@ -426,7 +433,8 @@ MIT in each case. |# (lambda (return-address) (define-error-handler error-type return-address (apply internal-apply-frame/operator-filter operators) - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (internal-apply-frame/select frame irritant)) @@ -438,17 +446,20 @@ MIT in each case. |# (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)))))) + (lambda (condition-type frame error-code) + error-code + (make-error-condition + condition-type + (list (internal-apply-frame/operator frame)) + repl-environment)))))) (define (define-operand-handler error-type irritant #!optional filter) (define-apply-handler (lambda (return-address) (define-error-handler error-type return-address (if (default-object? filter) true filter) - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (internal-apply-frame/select frame irritant) @@ -459,7 +470,8 @@ MIT in each case. |# (define (define-reference-trap-handler error-type frame-type) (define-error-handler error-type frame-type true - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (stack-frame/ref frame 2)) @@ -609,9 +621,6 @@ MIT in each case. |# (define-error-handler 'EXTERNAL-RETURN return-address (internal-apply-frame/operator-filter (ucode-primitive file-length) - ;; (ucode-primitive file-read-char) ; -gone. - (ucode-primitive file-write-char) - (ucode-primitive file-write-string) (ucode-primitive file-copy) (ucode-primitive file-rename) (ucode-primitive file-remove) @@ -623,7 +632,8 @@ MIT in each case. |# 'COMPILER-ERROR-RESTART (lambda (frame) (primitive-procedure? (stack-frame/ref frame 2))) - (lambda (condition-type frame) + (lambda (condition-type frame error-code) + error-code (make-error-condition condition-type (list (error-irritant/noise ": inappropriate arguments to open-coded") diff --git a/v7/src/runtime/utabs.scm b/v7/src/runtime/utabs.scm index a07d072dc..4ac813ce4 100644 --- a/v7/src/runtime/utabs.scm +++ b/v7/src/runtime/utabs.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/utabs.scm,v 14.4 1989/09/24 14:51:41 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/utabs.scm,v 14.5 1991/01/26 03:23:56 cph Exp $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -57,6 +57,8 @@ MIT in each case. |# (fixed-object/name->code 'MICROCODE-TERMINATIONS-VECTOR)) (set! types-slot (fixed-object/name->code 'MICROCODE-TYPES-VECTOR)) (set! non-object-slot (fixed-object/name->code 'NON-OBJECT)) + (set! system-call-names-slot (fixed-object/name->code 'SYSTEM-CALL-NAMES)) + (set! system-call-errors-slot (fixed-object/name->code 'SYSTEM-CALL-ERRORS)) (set! microcode-id/version (microcode-identification-item 'MICROCODE-VERSION)) (set! microcode-id/modification @@ -79,7 +81,8 @@ MIT in each case. |# (let ((string (microcode-identification-item 'STACK-TYPE-STRING))) (cond ((string? string) (intern string)) ((not string) 'STANDARD) - (else (error "illegal stack type" string)))))) + (else (error "illegal stack type" string))))) + unspecific) (define microcode-tables-identification) (define microcode-id/version) @@ -190,4 +193,20 @@ MIT in each case. |# (define (microcode-identification-item name) (vector-ref identification-vector - (microcode-identification-vector-slot name))) \ No newline at end of file + (microcode-identification-vector-slot name))) + +(define system-call-names-slot) + +(define (microcode-system-call/name->code name) + (microcode-table-search system-call-names-slot name)) + +(define (microcode-system-call/code->name code) + (microcode-table-ref system-call-names-slot code)) + +(define system-call-errors-slot) + +(define (microcode-system-call-error/name->code name) + (microcode-table-search system-call-errors-slot name)) + +(define (microcode-system-call-error/code->name code) + (microcode-table-ref system-call-errors-slot code)) \ No newline at end of file diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 1cbd83554..5bb563641 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.104 1990/11/19 19:34:35 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.105 1991/01/26 03:24:00 cph Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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 104)) + (add-identification! "Runtime" 14 105)) (define microcode-system) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 32b798e85..aa467a11a 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.87 1990/11/15 23:27:32 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.88 1991/01/26 03:23:44 cph Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -1105,6 +1105,10 @@ MIT in each case. |# microcode-return/code->name microcode-return/code-limit microcode-return/name->code + microcode-system-call-error/code->name + microcode-system-call-error/name->code + microcode-system-call/code->name + microcode-system-call/name->code microcode-termination/code->name microcode-termination/code-limit microcode-termination/name->code -- 2.25.1