From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 10 Oct 1994 21:29:53 +0000 (+0000)
Subject: Use SYSTEM-CALL-ERROR-MESSAGE primitive to allow microcode to provide
X-Git-Tag: 20090517-FFI~7078
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dea6edb0d432be4138fda1a63de2d7b86c708a11;p=mit-scheme.git

Use SYSTEM-CALL-ERROR-MESSAGE primitive to allow microcode to provide
more meaningful error messages if possible.  If the microcode is
unable to provide an error message, fall back to the previous
strategy.
---

diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm
index 17f81a1ec..e73638919 100644
--- a/v7/src/runtime/uerror.scm
+++ b/v7/src/runtime/uerror.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uerror.scm,v 14.40 1994/07/24 21:49:00 cph Exp $
+$Id: uerror.scm,v 14.41 1994/10/10 21:29:53 cph Exp $
 
 Copyright (c) 1988-94 Massachusetts Institute of Technology
 
@@ -289,9 +289,15 @@ MIT in each case. |#
 ;;;; Utilities
 
 (define (error-type->string error-type)
-  (if (symbol? error-type)
-      (string-replace (symbol->string error-type) #\- #\space)
-      (string-append "error " (write-to-string error-type))))
+  (or (let ((code
+	     (if (symbol? error-type)
+		 (microcode-system-call-error/name->code error-type)
+		 (and (exact-nonnegative-integer? error-type) error-type))))
+	(and code
+	     ((ucode-primitive system-call-error-message 1) code)))
+      (if (symbol? error-type)
+	  (string-replace (symbol->string error-type) #\- #\space)
+	  (string-append "error " (write-to-string error-type)))))
 
 (define (normalize-trap-code-name name)
   (let loop ((prefixes '("floating-point " "integer ")))