Bind `sf/default-externs-pathname' to same directory as input file

when syntaxing a file.  This is correct default for relative filenames
that appear in a file's declarations.

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index e1eadd89e0bee824d7b06c0f4b76bc458eac242e..ca9d3b75c1758bd1b15d079c383779678df93c39 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -61,11 +61,11 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 4)
-      (define :modification 2)
+      (define :modification 3)
       (define :files)
 
       (define :rcs-header              ;RCS sets up this string.
-       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $")
+       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $")
 
       (define :files-lists
        (list

diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm
index a4a30757f6e0614facafc2bd85018b36556ec7b8..4d15a558f3a363c4b169ec4449c3f1e67a4b2b94 100644 (file)
--- a/v7/src/sf/toplev.scm
+++ b/v7/src/sf/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.9 1988/03/30 23:05:03 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.10 1988/04/23 08:24:45 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -153,55 +153,61 @@ Currently only the 68000 implementation needs this."
    (stickify-input-filenames input-string sf/default-input-pathname)))
 \f
 (define (syntax-file* input-pathname bin-pathname spec-pathname)
-  (let ((start-date (date))
-       (start-time (time))
-       (input-filename (pathname->string input-pathname))
-       (bin-filename (pathname->string bin-pathname))
-       (spec-filename (and spec-pathname (pathname->string spec-pathname))))
-    (newline)
-    (write-string "Syntax file: ")
-    (write input-filename)
-    (write-string " ")
-    (write bin-filename)
-    (write-string " ")
-    (write spec-filename)
-    (transmit-values
-       (transmit-values (file-info/find input-pathname)
-         (lambda (syntax-table declarations)
-           (integrate/file input-pathname syntax-table declarations
-                           spec-pathname)))
-      (lambda (expression externs events)
-       (fasdump (wrapping-hook
-                 (make-comment `((SOURCE-FILE . ,input-filename)
-                                 (DATE . ,start-date)
-                                 (TIME . ,start-time)
-                                 (FLUID-LET . ,*fluid-let-type*))
-                               (set! expression false)))
-                bin-pathname)
-       (write-externs-file (pathname-new-type
-                            bin-pathname
-                            (pathname-type sf/default-externs-pathname))
-                           (set! externs false))
-       (if spec-pathname
-           (begin (newline)
-                  (write-string "Writing ")
-                  (write spec-filename)
-                  (with-output-to-file spec-pathname
-                    (lambda ()
-                      (newline)
-                      (write `(DATE ,start-date ,start-time))
-                      (newline)
-                      (write `(FLUID-LET ,*fluid-let-type*))
-                      (newline)
-                      (write `(SOURCE-FILE ,input-filename))
-                      (newline)
-                      (write `(BINARY-FILE ,bin-filename))
-                      (for-each (lambda (event)
-                                  (newline)
-                                  (write `(,(car event)
-                                           (RUNTIME ,(cdr event)))))
-                                events)))
-                  (write-string " -- done")))))))
+  (fluid-let ((sf/default-externs-pathname
+              (make-pathname (pathname-device input-pathname)
+                             (pathname-directory input-pathname)
+                             false
+                             "ext"
+                             'NEWEST)))
+    (let ((start-date (date))
+         (start-time (time))
+         (input-filename (pathname->string input-pathname))
+         (bin-filename (pathname->string bin-pathname))
+         (spec-filename (and spec-pathname (pathname->string spec-pathname))))
+      (newline)
+      (write-string "Syntax file: ")
+      (write input-filename)
+      (write-string " ")
+      (write bin-filename)
+      (write-string " ")
+      (write spec-filename)
+      (transmit-values
+         (transmit-values (file-info/find input-pathname)
+           (lambda (syntax-table declarations)
+             (integrate/file input-pathname syntax-table declarations
+                             spec-pathname)))
+       (lambda (expression externs events)
+         (fasdump (wrapping-hook
+                   (make-comment `((SOURCE-FILE . ,input-filename)
+                                   (DATE . ,start-date)
+                                   (TIME . ,start-time)
+                                   (FLUID-LET . ,*fluid-let-type*))
+                                 (set! expression false)))
+                  bin-pathname)
+         (write-externs-file (pathname-new-type
+                              bin-pathname
+                              (pathname-type sf/default-externs-pathname))
+                             (set! externs false))
+         (if spec-pathname
+             (begin (newline)
+                    (write-string "Writing ")
+                    (write spec-filename)
+                    (with-output-to-file spec-pathname
+                      (lambda ()
+                        (newline)
+                        (write `(DATE ,start-date ,start-time))
+                        (newline)
+                        (write `(FLUID-LET ,*fluid-let-type*))
+                        (newline)
+                        (write `(SOURCE-FILE ,input-filename))
+                        (newline)
+                        (write `(BINARY-FILE ,bin-filename))
+                        (for-each (lambda (event)
+                                    (newline)
+                                    (write `(,(car event)
+                                             (RUNTIME ,(cdr event)))))
+                                  events)))
+                    (write-string " -- done"))))))))
 \f
 (define (read-externs-file pathname)
   (let ((pathname

diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index 22b2d205e0186beaaf6f5fa818d78b46f3ad48d8..519a6cd550dba6bd1313f2101929ee4113689c36 100644 (file)
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -61,11 +61,11 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 4)
-      (define :modification 2)
+      (define :modification 3)
       (define :files)
 
       (define :rcs-header              ;RCS sets up this string.
-       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $")
+       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $")
 
       (define :files-lists
        (list

diff --git a/v8/src/sf/toplev.scm b/v8/src/sf/toplev.scm
index 16d5c04bc2545ec8521319cf1b132c149eeec983..fd38490eb2e1246abed42562c5309c07e72774f8 100644 (file)
--- a/v8/src/sf/toplev.scm
+++ b/v8/src/sf/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.9 1988/03/30 23:05:03 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.10 1988/04/23 08:24:45 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -153,55 +153,61 @@ Currently only the 68000 implementation needs this."
    (stickify-input-filenames input-string sf/default-input-pathname)))
 \f
 (define (syntax-file* input-pathname bin-pathname spec-pathname)
-  (let ((start-date (date))
-       (start-time (time))
-       (input-filename (pathname->string input-pathname))
-       (bin-filename (pathname->string bin-pathname))
-       (spec-filename (and spec-pathname (pathname->string spec-pathname))))
-    (newline)
-    (write-string "Syntax file: ")
-    (write input-filename)
-    (write-string " ")
-    (write bin-filename)
-    (write-string " ")
-    (write spec-filename)
-    (transmit-values
-       (transmit-values (file-info/find input-pathname)
-         (lambda (syntax-table declarations)
-           (integrate/file input-pathname syntax-table declarations
-                           spec-pathname)))
-      (lambda (expression externs events)
-       (fasdump (wrapping-hook
-                 (make-comment `((SOURCE-FILE . ,input-filename)
-                                 (DATE . ,start-date)
-                                 (TIME . ,start-time)
-                                 (FLUID-LET . ,*fluid-let-type*))
-                               (set! expression false)))
-                bin-pathname)
-       (write-externs-file (pathname-new-type
-                            bin-pathname
-                            (pathname-type sf/default-externs-pathname))
-                           (set! externs false))
-       (if spec-pathname
-           (begin (newline)
-                  (write-string "Writing ")
-                  (write spec-filename)
-                  (with-output-to-file spec-pathname
-                    (lambda ()
-                      (newline)
-                      (write `(DATE ,start-date ,start-time))
-                      (newline)
-                      (write `(FLUID-LET ,*fluid-let-type*))
-                      (newline)
-                      (write `(SOURCE-FILE ,input-filename))
-                      (newline)
-                      (write `(BINARY-FILE ,bin-filename))
-                      (for-each (lambda (event)
-                                  (newline)
-                                  (write `(,(car event)
-                                           (RUNTIME ,(cdr event)))))
-                                events)))
-                  (write-string " -- done")))))))
+  (fluid-let ((sf/default-externs-pathname
+              (make-pathname (pathname-device input-pathname)
+                             (pathname-directory input-pathname)
+                             false
+                             "ext"
+                             'NEWEST)))
+    (let ((start-date (date))
+         (start-time (time))
+         (input-filename (pathname->string input-pathname))
+         (bin-filename (pathname->string bin-pathname))
+         (spec-filename (and spec-pathname (pathname->string spec-pathname))))
+      (newline)
+      (write-string "Syntax file: ")
+      (write input-filename)
+      (write-string " ")
+      (write bin-filename)
+      (write-string " ")
+      (write spec-filename)
+      (transmit-values
+         (transmit-values (file-info/find input-pathname)
+           (lambda (syntax-table declarations)
+             (integrate/file input-pathname syntax-table declarations
+                             spec-pathname)))
+       (lambda (expression externs events)
+         (fasdump (wrapping-hook
+                   (make-comment `((SOURCE-FILE . ,input-filename)
+                                   (DATE . ,start-date)
+                                   (TIME . ,start-time)
+                                   (FLUID-LET . ,*fluid-let-type*))
+                                 (set! expression false)))
+                  bin-pathname)
+         (write-externs-file (pathname-new-type
+                              bin-pathname
+                              (pathname-type sf/default-externs-pathname))
+                             (set! externs false))
+         (if spec-pathname
+             (begin (newline)
+                    (write-string "Writing ")
+                    (write spec-filename)
+                    (with-output-to-file spec-pathname
+                      (lambda ()
+                        (newline)
+                        (write `(DATE ,start-date ,start-time))
+                        (newline)
+                        (write `(FLUID-LET ,*fluid-let-type*))
+                        (newline)
+                        (write `(SOURCE-FILE ,input-filename))
+                        (newline)
+                        (write `(BINARY-FILE ,bin-filename))
+                        (for-each (lambda (event)
+                                    (newline)
+                                    (write `(,(car event)
+                                             (RUNTIME ,(cdr event)))))
+                                  events)))
+                    (write-string " -- done"))))))))
 \f
 (define (read-externs-file pathname)
   (let ((pathname