From: Henry M. Wu <edu/mit/csail/zurich/mhwu>
Date: Tue, 26 May 1992 20:06:27 +0000 (+0000)
Subject: Made BSM files optional.
X-Git-Tag: 20090517-FFI~9359
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=58bca51a915782563eabff4cbb668f66c4602a6f;p=mit-scheme.git

Made BSM files optional.
---

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index e1b6ab947..e0a12948f 100644
--- 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)
 
 
diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm
index 17a31afcc..596ac8387 100644
--- 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 124b18c17..8187effa8 100644
--- 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)))))