Eliminate references to THE-ENVIRONMENT.
authorChris Hanson <org/chris-hanson/cph>
Thu, 20 Dec 2001 18:56:59 +0000 (18:56 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 20 Dec 2001 18:56:59 +0000 (18:56 +0000)
v7/src/runtime/make.scm

index fe64e9a07e6334f718f19a81787e805bc75a5392..c4b1fd87c2597959c220564406b0f1fc6b61a7b2 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.75 2001/12/18 18:39:38 cph Exp $
+$Id: make.scm,v 14.76 2001/12/20 18:56:59 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -32,7 +32,7 @@ USA.
 ;; that are not performed directly using LOCAL-ASSIGNMENT.
 
 ((ucode-primitive local-assignment 3)
- (the-environment)
+ #f ;global environment
  'DEFINE-MULTIPLE
  (named-lambda (define-multiple env names values)
    (if (or (not (vector? names))
@@ -48,6 +48,8 @@ USA.
                                       (vector-ref names i)
                                       (vector-ref values i)))))))))
 
+(define system-global-environment #f)
+
 ;; This definition is replaced later in the boot sequence.
 (define apply (ucode-primitive apply 2))
 
@@ -63,14 +65,9 @@ USA.
           names)
          parent)
         values))
-
-(define system-global-environment
-  (the-environment))
 \f
 (let ((environment-for-package (let () (the-environment))))
 
-(define this-environment (the-environment))
-
 (define-primitives
   (+ integer-add)
   (- integer-subtract)
@@ -311,12 +308,6 @@ USA.
   (export 'SYSTEM-GLOBAL-PACKAGE))
 (package/add-child! system-global-package 'PACKAGE environment-for-package)
 
-(let ((import
-       (lambda (name)
-        (link-variables this-environment name
-                        environment-for-package name))))
-  (import 'CONSTRUCT-PACKAGES-FROM-FILE)
-  (import 'LOAD-PACKAGES-FROM-FILE))
 (define packages-file
   (fasload (case os-name
             ((NT) "runtime-w32.pkd")
@@ -324,7 +315,7 @@ USA.
             ((UNIX) "runtime-unx.pkd")
             (else "runtime-unk.pkd"))
           #f))
-(construct-packages-from-file packages-file)
+((access construct-packages-from-file environment-for-package) packages-file)
 \f
 ;;; Global databases.  Load, then initialize.
 (let ((files1
@@ -375,23 +366,24 @@ USA.
   (package-initialize '(RUNTIME GC-FINALIZER) 'INITIALIZE-PACKAGE! #t)
 
   ;; Load everything else.
-  (load-packages-from-file packages-file
-                          `((SORT-TYPE . MERGE-SORT)
-                            (OS-TYPE . ,os-name)
-                            (OPTIONS . NO-LOAD))
-    (let ((file-member?
-          (lambda (filename files)
-            (let loop ((files files))
-              (and (pair? files)
-                   (or (string=? (car (car files)) filename)
-                       (loop (cdr files))))))))
-      (lambda (filename environment)
-       (if (not (or (string=? filename "packag")
-                    (file-member? filename files1)
-                    (file-member? filename files2)))
-           (eval (file->object filename #t #f)
-                 environment))
-       unspecific))))
+  ((access load-packages-from-file environment-for-package)
+   packages-file
+   `((SORT-TYPE . MERGE-SORT)
+     (OS-TYPE . ,os-name)
+     (OPTIONS . NO-LOAD))
+   (let ((file-member?
+         (lambda (filename files)
+           (let loop ((files files))
+             (and (pair? files)
+                  (or (string=? (car (car files)) filename)
+                      (loop (cdr files))))))))
+     (lambda (filename environment)
+       (if (not (or (string=? filename "packag")
+                   (file-member? filename files1)
+                   (file-member? filename files2)))
+          (eval (file->object filename #t #f)
+                environment))
+       unspecific))))
 \f
 ;;; Funny stuff is done.  Rest of sequence is standardized.
 (package-initialization-sequence