src/cold/set-up-cold-packages.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB-COLD")
  11
  12 ;;; an entry in the table which describes the non-standard part (i.e. not
  13 ;;; CL/CL-USER/KEYWORD) of the package structure of the SBCL system
  14 ;;;
  15 ;;; We make no attempt to be fully general; our table doesn't need to be
  16 ;;; able to express features which we don't happen to use.
  17 (export '(package-data
  18           make-package-data
  19           package-data-name
  20           package-data-export
  21           package-data-reexport
  22           package-data-import-from
  23           package-data-use))
  24 (defstruct package-data
  25   ;; a string designator for the package name
  26   (name (error "missing PACKAGE-DATA-NAME datum"))
  27   ;; a doc string
  28   (doc (error "missing PACKAGE-DOC datum"))
  29   ;; a tree containing names for exported symbols which'll be set up at package
  30   ;; creation time, and NILs, which are ignored. (This is a tree in order to
  31   ;; allow constructs like '("ENOSPC" #!+LINUX ("EDQUOT" "EISNAM" "ENAVAIL"
  32   ;; "EREMOTEIO")) to be used in initialization. NIL entries in the tree are
  33   ;; ignored for the same reason of notational convenience.)
  34   export
  35   ;; a list of string designators for exported symbols which don't necessarily
  36   ;; originate in this package (so their EXPORT operations should be handled
  37   ;; after USE operations have been done, so that duplicates aren't created)
  38   reexport
  39   ;; a list of sublists describing imports. Each sublist has the format as an
  40   ;; IMPORT-FROM list in DEFPACKAGE: the first element is the name of the
  41   ;; package to import from, and the remaining elements are the names of
  42   ;; symbols to import.
  43   import-from
  44   ;; a tree of string designators for package names of other packages
  45   ;; which this package uses
  46   use)
  47
  48 (let ((package-data-list (read-from-file "package-data-list.lisp-expr")))
  49   (labels ((flatten (tree)
  50              (mapcan (lambda (x) (if (listp x) (flatten x) (list x)))
  51                      tree)))
  52
  53     ;; Build all packages that we need, and initialize them as far as we
  54     ;; can without referring to any other packages.
  55     (dolist (package-data package-data-list)
  56       (let* ((package (make-package
  57                        (package-data-name package-data)
  58                        ;; Note: As of 0.7.0, the only nicknames we use
  59                        ;; for our implementation packages are hacks
  60                        ;; not needed at cross-compile time (e.g. the
  61                        ;; deprecated SB-C-CALL nickname for SB-ALIEN).
  62                        ;; So support for nicknaming during xc is gone,
  63                        ;; since any nicknames are hacked in during
  64                        ;; cold init.
  65                        :nicknames nil
  66                        :use nil)))
  67         ;; Walk the tree of exported names, exporting each name.
  68         (dolist (string (flatten (package-data-export package-data)))
  69           (export (intern string package) package))))
  70
  71     ;; Now that all packages exist, we can set up package-package
  72     ;; references.
  73     (dolist (package-data package-data-list)
  74       (use-package (package-data-use package-data)
  75                    (package-data-name package-data))
  76       (dolist (sublist (package-data-import-from package-data))
  77         (let* ((from-package (first sublist))
  78                (symbol-names (rest sublist))
  79                (symbols (mapcar (lambda (name)
  80                                   ;; old way, broke for importing symbols
  81                                   ;; like SB!C::DEBUG-SOURCE-FORM into
  82                                   ;; SB!DI -- WHN 19990714
  83                                   #+nil
  84                                   (let ((s (find-symbol name from-package)))
  85                                     (unless s
  86                                       (error "can't find ~S in ~S"
  87                                              name
  88                                              from-package))
  89                                     s)
  90                                   ;; new way, works for SB!DI stuff
  91                                   ;; -- WHN 19990714
  92                                   (intern name from-package))
  93                                 (flatten symbol-names))))
  94           (import symbols (package-data-name package-data)))))
  95
  96     ;; Now that all package-package references exist, we can handle
  97     ;; REEXPORT operations. (We have to wait until now because they
  98     ;; interact with USE operations.)  This code handles dependencies
  99     ;; properly, but is somewhat ugly.
 100     (let (done)
 101       (labels
 102           ((reexport (package-data)
 103              (let ((package (find-package (package-data-name package-data))))
 104                (cond
 105                  ((member package done))
 106                  ((null (package-data-reexport package-data))
 107                   (push package done))
 108                  (t
 109                   (mapcar #'reexport
 110                           (remove-if-not
 111                            (lambda (x)
 112                              (member x (package-data-use package-data)
 113                                      :test #'string=))
 114                            package-data-list
 115                            :key #'package-data-name))
 116                   (dolist (symbol-name
 117                            (flatten (package-data-reexport package-data)))
 118                     (multiple-value-bind (symbol status)
 119                         (find-symbol symbol-name package)
 120                       (unless status
 121                         (error "No symbol named ~S is accessible in ~S."
 122                                symbol-name package))
 123                       (when (eq (symbol-package symbol) package)
 124                         (error
 125                          "~S is not inherited/imported, but native to ~S."
 126                          symbol-name package))
 127                       (export symbol package)))
 128                   (push package done))))))
 129         (dolist (x package-data-list)
 130           (reexport x))
 131         (assert (= (length done) (length package-data-list)))))))
 132
 133 ;; Each backend should have a different package for its instruction set
 134 ;; so that they can co-exist.
 135 (make-assembler-package (backend-asm-package-name))
 136
 137 (defun package-list-for-genesis ()
 138   (append (sb-cold:read-from-file "package-data-list.lisp-expr")
 139           (let ((asm-package (backend-asm-package-name)))
 140             (list (make-package-data
 141                    :name asm-package
 142                    :use (mapcar 'package-name
 143                                 (package-use-list asm-package))
 144                    :doc nil)))))