Made BSM files optional.

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index e1b6ab94736e1a08851d30dec0c5c010b563a95b..e0a12948fe0e751d99d85817f74a58e600de696f 100644 (file)
--- a/v7/src/compiler/base/toplev.scm
+++ b/v7/src/compiler/base/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.39 1992/05/26 19:50:35 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.40 1992/05/26 20:06:27 mhwu Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -1149,6 +1149,16 @@ MIT in each case. |#
                (compress bsm-path bcs-path)
                (announce-info-files bci-path bcs-path)))))))))
 
+(define (compiler:dump-bci-file binf pathname)
+  (let ((bci-path (pathname-new-type pathname "bci")))
+    (load-option 'COMPRESS)
+    (call-with-temporary-filename
+      (lambda (bif-name)
+       (let ((bif-path (merge-pathnames bif-name)))
+         (inf-structure->bif/bsm binf bif-path false)
+         (compress bif-path bci-path)
+         (announce-info-files bci-path))))))
+
 (define compiler:dump-info-file compiler:dump-bci/bcs-files)
 
 \f

diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm
index 17a31afcc6f6e1d8feece7b47a425993f89e7cd6..596ac8387f9c55ee53ca2b95bd133c62c9125c82 100644 (file)
--- a/v7/src/runtime/infutl.scm
+++ b/v7/src/runtime/infutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.29 1992/05/26 19:36:08 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.30 1992/05/26 20:06:18 mhwu Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -403,24 +403,28 @@ MIT in each case. |#
 
 (define (inf-structure->bif/bsm binf bifpath bsmpath)
   (let* ((bifpath (merge-pathnames bifpath))
-        (bsmpath (merge-pathnames bsmpath))
-        (bsmname (->namestring bsmpath)))
+        (bsmpath (and bsmpath (merge-pathnames bsmpath)))
+        (bsmname (and bsmpath (->namestring bsmpath))))
     (cond ((dbg-info? binf)
           (let ((labels (dbg-info/labels/desc binf)))
             (set-dbg-info/labels/desc! binf bsmname)
             (fasdump binf bifpath true)
-            (fasdump labels bsmpath true)))
+            (if bsmpath
+                (fasdump labels bsmpath true))))
          ((vector? binf)
           (let ((bsm (make-vector (vector-length binf))))
             (let loop ((pos 0))
               (if (fix:= pos (vector-length bsm))
                   (begin
-                    (fasdump bsm bsmpath true)
-                    (fasdump binf bifpath true))
+                    (fasdump binf bifpath true)
+                    (if bsmpath
+                        (fasdump bsm bsmpath true)))
                   (let ((dbg-info (vector-ref binf pos)))
                     (let ((labels (dbg-info/labels/desc dbg-info)))
                       (vector-set! bsm pos labels)
-                      (set-dbg-info/labels/desc! dbg-info (cons bsmname pos))
+                      (set-dbg-info/labels/desc!
+                       dbg-info
+                       (and bsmnname (cons bsmname pos)))
                       (loop (fix:1+ pos))))))))
          (else 
           (error "Unknown inf file format" infpath)))))

diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm
index 124b18c175ec5a6bd3e55562d9fabdd97d000c53..8187effa8056948e9df18ce47074d253477f2283 100644 (file)
--- a/v8/src/runtime/infutl.scm
+++ b/v8/src/runtime/infutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.29 1992/05/26 19:36:08 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.30 1992/05/26 20:06:18 mhwu Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -403,24 +403,28 @@ MIT in each case. |#
 
 (define (inf-structure->bif/bsm binf bifpath bsmpath)
   (let* ((bifpath (merge-pathnames bifpath))
-        (bsmpath (merge-pathnames bsmpath))
-        (bsmname (->namestring bsmpath)))
+        (bsmpath (and bsmpath (merge-pathnames bsmpath)))
+        (bsmname (and bsmpath (->namestring bsmpath))))
     (cond ((dbg-info? binf)
           (let ((labels (dbg-info/labels/desc binf)))
             (set-dbg-info/labels/desc! binf bsmname)
             (fasdump binf bifpath true)
-            (fasdump labels bsmpath true)))
+            (if bsmpath
+                (fasdump labels bsmpath true))))
          ((vector? binf)
           (let ((bsm (make-vector (vector-length binf))))
             (let loop ((pos 0))
               (if (fix:= pos (vector-length bsm))
                   (begin
-                    (fasdump bsm bsmpath true)
-                    (fasdump binf bifpath true))
+                    (fasdump binf bifpath true)
+                    (if bsmpath
+                        (fasdump bsm bsmpath true)))
                   (let ((dbg-info (vector-ref binf pos)))
                     (let ((labels (dbg-info/labels/desc dbg-info)))
                       (vector-set! bsm pos labels)
-                      (set-dbg-info/labels/desc! dbg-info (cons bsmname pos))
+                      (set-dbg-info/labels/desc!
+                       dbg-info
+                       (and bsmnname (cons bsmname pos)))
                       (loop (fix:1+ pos))))))))
          (else 
           (error "Unknown inf file format" infpath)))))