Redesign compiled-code debugging information so that it is keyed. The

key in the .com file and the key in the .bci file must match, or the
.bci file will be ignored.

diff --git a/v7/src/compiler/etc/comcmp.scm b/v7/src/compiler/etc/comcmp.scm
index 6845e1cb2c9805fff193b2f119c27a13452095dd..240c9e438c36a4f8d635da4988aef5043f6901cf 100644 (file)
--- a/v7/src/compiler/etc/comcmp.scm
+++ b/v7/src/compiler/etc/comcmp.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: comcmp.scm,v 1.6 1999/12/20 23:07:27 cph Exp $
+$Id: comcmp.scm,v 1.7 2001/08/10 17:28:20 cph Exp $
 
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Compiled code binary comparison program
@@ -29,8 +30,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define-macro (ucode-type name)
   (microcode-type name))
 
-(define comcmp:ignore-debugging-info? true)
-(define comcmp:show-differing-blocks? false)
+(define comcmp:ignore-debugging-info? #t)
+(define comcmp:show-differing-blocks? #f)
 
 (define (compare-code-blocks b1 b2)
   (let ((memoizations '()))
@@ -61,16 +62,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                                               (vector-ref y index))
                                       (loop (1+ index))))))))
                    ((compiled-code-block? x)
-                    (not (compare-blocks x y false)))
+                    (not (compare-blocks x y #f)))
                    ((compiled-code-address? x)
                     (and (= (compiled-entry/offset x)
                             (compiled-entry/offset y))
                          (not (compare-blocks
                                (compiled-entry/block x)
                                (compiled-entry/block y)
-                               false))))
+                               #f))))
                    (else
-                    false))
+                    #f))
              (and (number? x)
                   (number? y)
                   (= x y)
@@ -133,7 +134,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                                  (read-code b2 s2 e2)))
               `(code))
              (else
-              false))))
+              #f))))
 
     (define (read-code b s e)
       (let ((bs (bit-string-allocate (* addressing-granularity (- e s)))))
@@ -146,8 +147,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       ;; Kludge!
       (if comcmp:ignore-debugging-info?
          (begin
-           (set-compiled-code-block/debugging-info! b1 '())
-           (set-compiled-code-block/debugging-info! b2 '())))
+           (set-compiled-code-block/debugging-info! b1 #f)
+           (set-compiled-code-block/debugging-info! b2 #f)))
 
       (let ((s1 (compiled-code-block/constants-start b1))
            (s2 (compiled-code-block/constants-start b2))
@@ -176,7 +177,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                                (else
                                 diff))))
                       ((null? diffs)
-                       false)
+                       #f)
                       (else
                        (cons 'CONSTANTS (reverse! diffs)))))))))
 
@@ -210,7 +211,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                        (differ)))
                   (else
                    (differ))))))
-    (compare-blocks b1 b2 true)))
+    (compare-blocks b1 b2 #t)))
 
 (define (compare-com-files f1 f2 #!optional verbose?)
   (let ((quiet? (or (default-object? verbose?) (not verbose?))))

diff --git a/v7/src/compiler/machines/bobcat/dassm1.scm b/v7/src/compiler/machines/bobcat/dassm1.scm
index 6c2803a5b6c8da9b8e33eeb47e8dd4f081ee7fdc..5241325cb3a74f60cdf2d09c11eb1982eef2487d 100644 (file)
--- a/v7/src/compiler/machines/bobcat/dassm1.scm
+++ b/v7/src/compiler/machines/bobcat/dassm1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 4.19 1999/01/02 06:06:43 cph Exp $
+$Id: dassm1.scm,v 4.20 2001/08/10 17:28:55 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Disassembler: User Level
@@ -83,20 +84,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((symbol-table (and info (dbg-info/labels info))))
     (write-string "Disassembly of ")
     (write block)
-    (let loop ((info (compiled-code-block/debugging-info block)))
-      (cond ((string? info)
-            (write-string " (")
-            (write-string info)
-            (write-string ")"))
-           ((not (pair? info)))
-           ((vector? (car info))
-            (loop (cdr info)))
-           (else
-              (write-string " (Block ")
-              (write (cdr info))
-              (write-string " in ")
-              (write-string (car info))
-              (write-string ")"))))
+    (call-with-values
+       (lambda () (compiled-code-block/filename-and-index block))
+      (lambda (filename index)
+       (if filename
+           (begin
+             (write-string " (Block ")
+             (write index)
+             (write-string " in ")
+             (write-string filename)
+             (write-string ")")))))
     (write-string ":\n")
     (write-string "Code:\n\n")
     (disassembler/write-instruction-stream

diff --git a/v7/src/compiler/machines/i386/dassm1.scm b/v7/src/compiler/machines/i386/dassm1.scm
index 83bb55152bc56b31e52712168580cecbefbfd4b7..298e6e56655853657dff3cbf532a8abf49bcc8d6 100644 (file)
--- a/v7/src/compiler/machines/i386/dassm1.scm
+++ b/v7/src/compiler/machines/i386/dassm1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 1.9 1999/01/02 06:06:43 cph Exp $
+$Id: dassm1.scm,v 1.10 2001/08/10 17:29:03 cph Exp $
 
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Disassembler: User Level
@@ -26,17 +27,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 ;;; Flags that control disassembler behavior
 
-(define disassembler/symbolize-output? true)
-(define disassembler/compiled-code-heuristics? true)
-(define disassembler/write-offsets? true)
-(define disassembler/write-addresses? false)
+(define disassembler/symbolize-output? #t)
+(define disassembler/compiled-code-heuristics? #t)
+(define disassembler/write-offsets? #t)
+(define disassembler/write-addresses? #f)
 
 ;;;; Top level entries
 
 (define (compiler:write-lap-file filename #!optional symbol-table?)
   (let ((pathname (->pathname filename))
        (symbol-table?
-        (if (default-object? symbol-table?) true symbol-table?)))
+        (if (default-object? symbol-table?) #t symbol-table?)))
     (with-output-to-file (pathname-new-type pathname "lap")
       (lambda ()
        (let ((com-file (pathname-new-type pathname "com")))
@@ -71,9 +72,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (compiler:disassemble entry)
   (let ((block (compiled-entry/block entry)))
-    (let ((info (compiled-code-block/dbg-info block true)))
-      (fluid-let ((disassembler/write-offsets? true)
-                 (disassembler/write-addresses? true)
+    (let ((info (compiled-code-block/dbg-info block #t)))
+      (fluid-let ((disassembler/write-offsets? #t)
+                 (disassembler/write-addresses? #t)
                  (disassembler/base-address (object-datum block)))
        (newline)
        (newline)
@@ -83,20 +84,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((symbol-table (and info (dbg-info/labels info))))
     (write-string "Disassembly of ")
     (write block)
-    (let loop ((info (compiled-code-block/debugging-info block)))
-      (cond ((string? info)
-            (write-string " (")
-            (write-string info)
-            (write-string ")"))
-           ((not (pair? info)))
-           ((vector? (car info))
-            (loop (cdr info)))
-           (else
-              (write-string " (Block ")
-              (write (cdr info))
-              (write-string " in ")
-              (write-string (car info))
-              (write-string ")"))))
+    (call-with-values
+       (lambda () (compiled-code-block/filename-and-index block))
+      (lambda (filename index)
+       (if filename
+           (begin
+             (write-string " (Block ")
+             (write index)
+             (write-string " in ")
+             (write-string filename)
+             (write-string ")")))))
     (write-string ":\n")
     (write-string "Code:\n\n")
     (disassembler/write-instruction-stream
@@ -113,7 +110,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                             symbol-table))
 
 (define (disassembler/instructions/address start-address end-address)
-  (disassembler/instructions false start-address end-address false))
+  (disassembler/instructions #f start-address end-address #f))
 
 (define (disassembler/write-instruction-stream symbol-table instruction-stream)
   (fluid-let ((*unparser-radix* 16))
@@ -185,7 +182,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (write-string " in ")
         (write (compiled-code-address->block constant))
         (write-string ")"))
-       (else false)))
+       (else #f)))
 \f
 (define (disassembler/write-linkage-section block symbol-table index)
   (let* ((field (object-datum (system-vector-ref block index)))

diff --git a/v7/src/compiler/machines/mips/dassm1.scm b/v7/src/compiler/machines/mips/dassm1.scm
index 7c152037d3916dbb732f26f15d2660c15eea23c8..ff4e098c7f2deaa239fecd3bfac27c91da5d7c33 100644 (file)
--- a/v7/src/compiler/machines/mips/dassm1.scm
+++ b/v7/src/compiler/machines/mips/dassm1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 1.4 1999/01/02 06:06:43 cph Exp $
+$Id: dassm1.scm,v 1.5 2001/08/10 17:29:10 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Disassembler: User Level
@@ -83,20 +84,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((symbol-table (and info (dbg-info/labels info))))
     (write-string "Disassembly of ")
     (write block)
-    (let loop ((info (compiled-code-block/debugging-info block)))
-      (cond ((string? info)
-            (write-string " (")
-            (write-string info)
-            (write-string ")"))
-           ((not (pair? info)))
-           ((vector? (car info))
-            (loop (cdr info)))
-           (else
-              (write-string " (Block ")
-              (write (cdr info))
-              (write-string " in ")
-              (write-string (car info))
-              (write-string ")"))))
+    (call-with-values
+       (lambda () (compiled-code-block/filename-and-index block))
+      (lambda (filename index)
+       (if filename
+           (begin
+             (write-string " (Block ")
+             (write index)
+             (write-string " in ")
+             (write-string filename)
+             (write-string ")")))))
     (write-string ":\n")
     (write-string "Code:\n\n")
     (disassembler/write-instruction-stream

diff --git a/v7/src/compiler/machines/spectrum/dassm1.scm b/v7/src/compiler/machines/spectrum/dassm1.scm
index 859255bd1e85b23d5e17ded5b1b7fd5b96797e2d..7fc25fd810e053b3d28d345c987e5c08ade6565e 100644 (file)
--- a/v7/src/compiler/machines/spectrum/dassm1.scm
+++ b/v7/src/compiler/machines/spectrum/dassm1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 4.19 1999/01/02 06:06:43 cph Exp $
+$Id: dassm1.scm,v 4.20 2001/08/10 17:29:18 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Disassembler: User Level
@@ -83,20 +84,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((symbol-table (and info (dbg-info/labels info))))
     (write-string "Disassembly of ")
     (write block)
-    (let loop ((info (compiled-code-block/debugging-info block)))
-      (cond ((string? info)
-            (write-string " (")
-            (write-string info)
-            (write-string ")"))
-           ((not (pair? info)))
-           ((vector? (car info))
-            (loop (cdr info)))
-           (else
-              (write-string " (Block ")
-              (write (cdr info))
-              (write-string " in ")
-              (write-string (car info))
-              (write-string ")"))))
+    (call-with-values
+       (lambda () (compiled-code-block/filename-and-index block))
+      (lambda (filename index)
+       (if filename
+           (begin
+             (write-string " (Block ")
+             (write index)
+             (write-string " in ")
+             (write-string filename)
+             (write-string ")")))))
     (write-string ":\n")
     (write-string "Code:\n\n")
     (disassembler/write-instruction-stream