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.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 4dd598226fcf901fcaca3fe961e2cb5ed8aa5c66..2373ecc3b637bd2bf46c6ebcc813e5c703deaf58 100644 (file)
--- 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 342c885960daaf5253cd7ae5a24b697d006031f3..00533039f21525fb60e07f8d8ce08f84466095be 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.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)))))
 \f
 ;;;; Frame Decomposition
@@ -147,7 +148,8 @@ MIT in each case. |#
 \f
 ;;;; 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 a07d072dc3754ed164ebaf13d5aa56e3d1178933..4ac813ce46c23effc80710a987e0412a9c635a66 100644 (file)
--- 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 1cbd83554c44b6622b040cba6dcde5b3786b33cb..5bb563641a3387f53a013c50ba5a3de3dbae4abc 100644 (file)
--- 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 32b798e855fe74ea914c6348e25f95fa27e89490..aa467a11a7ea63adcb20d0187f97e69174bbf6a5 100644 (file)
--- 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