Better reporting of hardware traps.

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index a2d67b9684aa6cd3b76e6ac27dd033bf3988a3d6..e8e72ee125205fbd9adaebb5f6cce870127f69c1 100644 (file)
--- a/v7/src/runtime/conpar.scm
+++ b/v7/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.13 1990/04/12 22:54:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.14 1990/06/28 16:36:12 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -682,15 +682,31 @@ MIT in each case. |#
          (newline)
          (write-string ";; Top of the stack")))))
 \f
+(define (write-hex value)
+  (if (< value #x10)
+      (write value)
+      (begin
+       (write-string "#x")
+       (write-string (number->string value #x10)))))
+
 (define (hardware-trap-frame/describe frame long?)
   (guarantee-hardware-trap-frame frame)
   (let ((name (stack-frame/ref frame hardware-trap/signal-name-index))
        (state (stack-frame/ref frame hardware-trap/state-index)))
-    (if name
-       (begin
+    (if (not name)
+       (write-string "User microcode reset")
+       (let ((code (stack-frame/ref frame hardware-trap/code-index)))
          (write-string "Hardware trap ")
-         (write-string name))
-       (write-string "User microcode reset"))
+         (write-string name)
+         (write-string " (")
+         (if (and (pair? code) (cdr code))
+             (write-string (cdr code))
+             (begin
+               (write-string "code = ")
+               (write-hex (if (pair? code)
+                              (car code)
+                              code))))
+         (write-string ")")))
     (if long?
        (case state
          ((0)                          ; unknown
@@ -700,10 +716,7 @@ MIT in each case. |#
           (write (stack-frame/ref frame hardware-trap/pc-info1-index)))
          ((2)                          ; compiled code
           (write-string " at offset ")
-          (write-string
-           (number->string (stack-frame/ref frame
-                                            hardware-trap/pc-info2-index)
-                           16))
+          (write-hex (stack-frame/ref frame hardware-trap/pc-info2-index))
           (newline)
           (write-string "within ")
           (let ((block (stack-frame/ref frame hardware-trap/pc-info1-index)))

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index 05c5980b86f5fdc6ae8542221293cfcb598b9df2..50264df1a82afaf5564310f55d0a98fd0ab399c7 100644 (file)
--- a/v8/src/runtime/conpar.scm
+++ b/v8/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.13 1990/04/12 22:54:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.14 1990/06/28 16:36:12 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -682,15 +682,31 @@ MIT in each case. |#
          (newline)
          (write-string ";; Top of the stack")))))
 \f
+(define (write-hex value)
+  (if (< value #x10)
+      (write value)
+      (begin
+       (write-string "#x")
+       (write-string (number->string value #x10)))))
+
 (define (hardware-trap-frame/describe frame long?)
   (guarantee-hardware-trap-frame frame)
   (let ((name (stack-frame/ref frame hardware-trap/signal-name-index))
        (state (stack-frame/ref frame hardware-trap/state-index)))
-    (if name
-       (begin
+    (if (not name)
+       (write-string "User microcode reset")
+       (let ((code (stack-frame/ref frame hardware-trap/code-index)))
          (write-string "Hardware trap ")
-         (write-string name))
-       (write-string "User microcode reset"))
+         (write-string name)
+         (write-string " (")
+         (if (and (pair? code) (cdr code))
+             (write-string (cdr code))
+             (begin
+               (write-string "code = ")
+               (write-hex (if (pair? code)
+                              (car code)
+                              code))))
+         (write-string ")")))
     (if long?
        (case state
          ((0)                          ; unknown
@@ -700,10 +716,7 @@ MIT in each case. |#
           (write (stack-frame/ref frame hardware-trap/pc-info1-index)))
          ((2)                          ; compiled code
           (write-string " at offset ")
-          (write-string
-           (number->string (stack-frame/ref frame
-                                            hardware-trap/pc-info2-index)
-                           16))
+          (write-hex (stack-frame/ref frame hardware-trap/pc-info2-index))
           (newline)
           (write-string "within ")
           (let ((block (stack-frame/ref frame hardware-trap/pc-info1-index)))