From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 15 Jul 1997 17:54:48 +0000 (+0000)
Subject: Small changes to allow butils.scm to be shared between 7.4 and 8.0
X-Git-Tag: 20090517-FFI~5059
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b4bf0afd8794bcdd50cab853d451ad73fce61f5e;p=mit-scheme.git

Small changes to allow butils.scm to be shared between 7.4 and 8.0
---

diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm
index 3b7f6edfc..f5467c3aa 100644
--- a/v7/src/sf/toplev.scm
+++ b/v7/src/sf/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 4.13 1995/01/06 18:36:24 cph Exp $
+$Id: toplev.scm,v 4.14 1997/07/15 17:54:38 adams Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,6 +39,8 @@ MIT in each case. |#
 
 ;;;; User Interface
 
+(define bin-pathname-type "bin")
+
 (define (integrate/procedure procedure declarations)
   (procedure-components procedure
     (lambda (*lambda environment)
@@ -169,7 +171,7 @@ MIT in each case. |#
 					 (if (> (string-length input-type) 2)
 					     (string-head input-type 2)
 					     input-type))
-			  "bin")))))
+			  bin-pathname-type)))))
 	      (if bin-string
 		  (merge-pathnames bin-string bin-path)
 		  bin-path))
diff --git a/v8/src/sf/toplev.scm b/v8/src/sf/toplev.scm
index 3b7f6edfc..06cead5a1 100644
--- a/v8/src/sf/toplev.scm
+++ b/v8/src/sf/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 4.13 1995/01/06 18:36:24 cph Exp $
+$Id: toplev.scm,v 4.14 1997/07/15 17:54:48 adams Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,6 +39,8 @@ MIT in each case. |#
 
 ;;;; User Interface
 
+(define bin-pathname-type "bin")
+
 (define (integrate/procedure procedure declarations)
   (procedure-components procedure
     (lambda (*lambda environment)
@@ -133,6 +135,7 @@ MIT in each case. |#
 ;;;; File Syntaxer
 
 (define (syntax-file input-string bin-string spec-string)
+  (perhaps-issue-compatibility-warning)
   (if (not (or (false? sf/default-syntax-table)
 	       (syntax-table? sf/default-syntax-table)))
       (error "Malformed binding of SF/DEFAULT-SYNTAX-TABLE:"
@@ -169,7 +172,7 @@ MIT in each case. |#
 					 (if (> (string-length input-type) 2)
 					     (string-head input-type 2)
 					     input-type))
-			  "bin")))))
+			  bin-pathname-type)))))
 	      (if bin-string
 		  (merge-pathnames bin-string bin-path)
 		  bin-path))
@@ -379,4 +382,15 @@ MIT in each case. |#
 	(write (/ (exact->inexact process-time) 1000))
 	(write-string " (process time); ")
 	(write (/ (exact->inexact real-time) 1000))
-	(write-string " (real time)"))))
\ No newline at end of file
+	(write-string " (real time)"))))
+
+(define compatibility-detection-frob (vector #F '()))
+
+(define (perhaps-issue-compatibility-warning)
+  (if (eq? (vector-ref compatibility-detection-frob 0)
+	   (vector-ref compatibility-detection-frob 1))
+      (begin
+	(warn "!! You are syntaxing while in compatibilty mode, where #F is the")
+	(warn "!! same as '().  The resulting file may be incorrect for the")
+	(warn "!! standard environment."))))
+