From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 18 Jan 2000 20:39:42 +0000 (+0000)
Subject: Change format of ".glo" files to contain package ancestry information.
X-Git-Tag: 20090517-FFI~4322
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3c0741ab1b171732e0825a2a9ed0004eb805e887;p=mit-scheme.git

Change format of ".glo" files to contain package ancestry information.
---

diff --git a/v7/src/cref/make.scm b/v7/src/cref/make.scm
index 52eba4adb..c6bf348c6 100644
--- a/v7/src/cref/make.scm
+++ b/v7/src/cref/make.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 1.18 1999/01/03 05:22:10 cph Exp $
+$Id: make.scm,v 1.19 2000/01/18 20:38:37 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -32,5 +32,5 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (pathname-as-directory "cref")
      (lambda ()
        (load-option 'RB-TREE)
-       (package/system-loader "cref" '() false)))))
-(add-identification! "CREF" 1 18)
\ No newline at end of file
+       (package/system-loader "cref" '() #f)))))
+(add-identification! "CREF" 1 19)
\ No newline at end of file
diff --git a/v7/src/cref/redpkg.scm b/v7/src/cref/redpkg.scm
index 7e150bc45..76997ec29 100644
--- a/v7/src/cref/redpkg.scm
+++ b/v7/src/cref/redpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: redpkg.scm,v 1.11 1999/01/02 06:11:34 cph Exp $
+$Id: redpkg.scm,v 1.12 2000/01/18 20:38:41 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -42,14 +42,27 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 					   "glo")))
 		   (if (file-exists? pathname)
 		       (let ((contents (fasload pathname)))
-			 (cond ((check-list contents symbol?)
-				(list (cons '() contents)))
+			 (cond ((and (pair? contents)
+				     (pair? (car contents))
+				     (eq? 'VERSION (caar contents))
+				     (exact-nonnegative-integer?
+				      (cdar contents)))
+				(if (not (= 2 (cdar contents)))
+				    (error "Unknown globals-file version:"
+					   (cdar contents)))
+				(cdr contents))
+			       ((check-list contents symbol?)
+				(list (vector '() '() contents)))
 			       ((check-list contents
 				  (lambda (element)
 				    (and (pair? element)
 					 (check-list (car element) symbol?)
 					 (check-list (cdr element) symbol?))))
-				contents)
+				(map (lambda (element)
+				       (vector (car element)
+					       '()
+					       (cdr element)))
+				     contents))
 			       (else
 				(warn "Malformed globals file:" pathname)
 				'())))
@@ -409,12 +422,21 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    (let ((namestring (->namestring (car global))))
 	      (lambda (entry)
 		(for-each
-		 (let ((package (get-package (car entry) #t)))
+		 (let ((package (get-package (vector-ref entry 0) #t)))
+		   (let loop
+		       ((package package)
+			(ancestors (vector-ref entry 1)))
+		     (if (eq? 'UNKNOWN (package/parent package))
+			 (if (pair? ancestors)
+			     (let ((parent (get-package (car ancestors) #t)))
+			       (set-package/parent! package parent)
+			       (loop parent (cdr ancestors)))
+			     (set-package/parent! package #f))))
 		   (lambda (name)
 		     (bind! package
 			    name
 			    (make-expression package namestring #f))))
-		 (cdr entry))))
+		 (vector-ref entry 2))))
 	    (cdr global)))
 	 globals)
 	(for-each
diff --git a/v7/src/cref/toplev.scm b/v7/src/cref/toplev.scm
index 49c028174..bafe5ce41 100644
--- a/v7/src/cref/toplev.scm
+++ b/v7/src/cref/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 1.12 1999/01/02 06:11:34 cph Exp $
+$Id: toplev.scm,v 1.13 2000/01/18 20:39:42 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -105,7 +105,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       (with-output-to-file (pathname-new-type pathname "crf")
 	(lambda ()
 	  (format-packages-unusual pmodel)))))
-
+
 (define (write-globals pathname pmodel changes?)
   (if (or changes? (not (file-processed? pathname "pkg" "glo")))
       (let ((package-bindings
@@ -137,8 +137,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 					  package-bindings))
 			      unspecific)))))
 		  exports)
-	(fasdump (map (lambda (entry)
-			(cons (package/name (car entry))
-			      (map binding/name (cdr entry))))
-		      package-bindings)
+	(fasdump (cons '(VERSION . 2)
+		       (map (lambda (entry)
+			      (vector (package/name (car entry))
+				      (let loop ((package (car entry)))
+					(let ((parent
+					       (package/parent package)))
+					  (if parent
+					      (cons (package/name parent)
+						    (loop parent))
+					      '())))
+				      (map binding/name (cdr entry))))
+			    package-bindings))
 		 (pathname-new-type pathname "glo")))))
\ No newline at end of file