Fix up fni->bci files in crsend.scm.

diff --git a/src/compiler/base/crsend.scm b/src/compiler/base/crsend.scm
index 711f4f2487c8985e28e194d5e15cb1da189d04bf..5944d8614e8cd2137811bf7c3f2f22cc02d07c8a 100644 (file)
--- a/src/compiler/base/crsend.scm
+++ b/src/compiler/base/crsend.scm
@@ -32,6 +32,8 @@ USA.
 ;;; compiler.
 
 (declare (usual-integrations))
+
+(load-option 'COMPRESS)                        ; XXX ugh
 \f
 (define (finish-cross-compilation:directory directory #!optional force?)
   (let ((force? (if (default-object? force?) #f force?)))
@@ -42,12 +44,38 @@ USA.
                                    (or (string=? ns ".")
                                        (string=? ns ".."))))
                             (loop pathname)))
+                       ((let ((t (pathname-type pathname)))
+                          (and (string? t)
+                               (string=? t "fni")))
+                        (finish-cross-compilation:info-file pathname force?))
                        ((let ((t (pathname-type pathname)))
                           (and (string? t)
                                (string=? t "moc")))
                         (finish-cross-compilation:file pathname force?))))
                (directory-read (pathname-as-directory directory))))))
 
+(define (finish-cross-compilation:info-file pathname #!optional force?)
+  (let* ((input-file (pathname-default-type pathname "fni"))
+        (output-file (pathname-new-type input-file "bci")))
+    (if (or (if (default-object? force?) #t force?)
+           (file-modification-time<? output-file input-file))
+       (with-notification
+           (lambda (port)
+             (write-string "Compressing info: " port)
+             (write (enough-namestring input-file) port)
+             (write-string " => " port)
+             (write (enough-namestring output-file) port))
+           (lambda ()
+             (let ((inf (fasload input-file #t)))
+               ((access SPLIT-INF-STRUCTURE! ; XXX ugh
+                        (->environment '(RUNTIME COMPILER-INFO)))
+                inf
+                #f)
+               (call-with-temporary-filename
+                 (lambda (temp)
+                   (fasdump inf temp #t)
+                   (compress temp output-file)))))))))
+
 (define (finish-cross-compilation:file input-file #!optional force?)
   (let* ((input-file (pathname-default-type input-file "moc"))
         (output-file (pathname-new-type input-file "com")))