From dea6edb0d432be4138fda1a63de2d7b86c708a11 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 10 Oct 1994 21:29:53 +0000 Subject: [PATCH] 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. --- v7/src/runtime/uerror.scm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) 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 "))) -- 2.25.1