8.0 debugging changes.

Added a procedure COMPILED-CODE-BLOCK/NAME to guess the name of the
procedure in the compiled code block.  If the dbg info has only one
top-level procedure then use the name of that procedure, otherwise
return false.  Requires LOAD-DEBUGGING-INFO-ON-DEMAND? to be true to
load the dbg info.

Fixed HARDWARE-TRAP-FRAME/DESCRIBE to use the new 8.0 debugging
information - it was an oversight that it was still trying to use the
old debugging locator to identify the file name for the compiled code
block.  Also use COMPILED-CODE-BLOCK/NAME to identify the procedure.

Together, these changes mean that (with LOAD-DEBUGGING-INFO-ON-DEMAND?
true), SIGSEGVs and SIGFPEs can usually identify the offending
procedure by name.

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index bdc97c9bb4301efb618d3c734b159265a94a466c..c23f31ff6aea60456a70f22ea293794c42071710 100644 (file)
--- a/v8/src/runtime/conpar.scm
+++ b/v8/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpar.scm,v 14.37 1996/07/26 00:34:49 adams Exp $
+$Id: conpar.scm,v 14.38 1997/07/12 04:23:26 adams Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -1136,26 +1136,25 @@ MIT in each case. |#
           (write-string " within ")
           (write (stack-frame/ref frame hardware-trap/pc-info1-index)))
          ((2)                          ; compiled code
-          (write-string " at offset ")
-          (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)))
+          (let ((block  (stack-frame/ref frame hardware-trap/pc-info1-index))
+                (offset (stack-frame/ref frame hardware-trap/pc-info2-index)))
+            (write-string " at offset ")
+            (write-hex offset)
+            (newline)
+            (write-string "within ")
             (write block)
-            (let loop ((info (compiled-code-block/debugging-info block)))
-              (cond ((null? info)
-                     false)
-                    ((string? info)
-                     (begin
-                       (write-string " (")
-                       (write-string info)
-                       (write-string ")")))
-                    ((not (pair? info))
-                     false)
-                    ((string? (car info))
-                     (loop (car info)))
-                    (else
-                     (loop (cdr info)))))))
+            (let ((descriptor (compiled-code-block/dbg-descriptor block)))
+              (if descriptor
+                  (begin
+                    (write-string " (")
+                    (display (dbg-locator/file (car descriptor)))
+                    (flush-output) ; incase following is slow...
+                    (let ((name (compiled-code-block/name block offset)))
+                      (if name
+                          (begin
+                            (write-string " ")
+                            (display name))))
+                    (write-string ")"))))))
          ((3)                          ; probably compiled-code
           (write-string " at an unknown compiled-code location."))
          ((4)                          ; builtin (i.e. hook)

diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm
index 916418f5d67ef8f545579fc10bc0b8399e5cff31..719cabdaee0f2d12650a2bfe6bb4855104881fe2 100644 (file)
--- a/v8/src/runtime/infutl.scm
+++ b/v8/src/runtime/infutl.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: infutl.scm,v 1.61 1995/08/02 20:47:38 adams Exp $
+$Id: infutl.scm,v 1.62 1997/07/12 04:23:16 adams Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -383,6 +383,29 @@ MIT in each case. |#
           (or (special-form-procedure-name? name)
               (symbol->string name))))))
 
+(define (compiled-code-block/name block offset)
+  ;; Try to come up with a name for BLOCK.  If there is one top-level
+  ;; procedure, use its name.
+  (define (top-level-proc-name proc)
+    (and (dbg-block? (dbg-procedure/block proc))
+        (eq? 'IC (dbg-block/parent (dbg-procedure/block proc)))
+        (let ((name (dbg-procedure/name proc)))
+          (or (special-form-procedure-name? name)
+              name))))
+  offset ; ignored
+  (let ((dbg-info
+        (compiled-code-block/dbg-info block load-debugging-info-on-demand?)))
+    (and dbg-info
+        (not (dbg-info/expression dbg-info)) ; top level or group compiled
+        (let ((procs (dbg-info/procedures dbg-info)))
+          (let loop ((i 0) (name #F))
+            (cond ((= i (vector-length procs))  name)
+                  ((top-level-proc-name (vector-ref procs i))
+                   => (lambda (name*)
+                        (and (not name)
+                             (loop (+ i 1) name*))))
+                  (else (loop (+ i 1) name))))))))
+
 (define load-debugging-info-on-demand?
   false)
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 09b0aea1834dbab3cfa1762770e8361d24c6232d..d3aeeae2bcd8ea50bac819ef8334078f35e9fd3d 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.289 1997/06/25 03:28:26 cph Exp $
+$Id: runtime.pkg,v 14.290 1997/07/12 04:23:04 adams Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -276,6 +276,10 @@ MIT in each case. |#
          dbg-expression?)
   (export (runtime unparser)
          compiled-entry/filename-and-index)
+  (export (runtime continuation-parser)
+         compiled-code-block/dbg-descriptor
+         compiled-code-block/name
+         dbg-locator/file)
   (export (runtime compress)
          uncompress-internal)
   (initialization (initialize-package!)))