;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-

 ;;;

 ;;; Feedback, bug reports, and patches are all welcome:

 ;;; please mail to <asdf-devel@common-lisp.net>.

         :and :do (setf use-p t) :else

       :when (eq kw :unintern) :append args :into unintern :else

         :do (error "unrecognized define-package keyword ~S" kw)

 (defmacro define-package (package &rest clauses)

   "DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form

 of shadowing, etc. the symbols with the same name may not be the same symbols.

 UNINTERN -- Remove symbols here from PACKAGE."

   (let ((ensure-form

     `(progn

        #+(or clasp ecl gcl mkcl) (defpackage ,package (:use))

        (eval-when (:compile-toplevel :load-toplevel :execute)

   #+(or mcl cmucl) (:shadow #:user-homedir-pathname))

 (in-package :uiop/common-lisp)

 (error "ASDF is not supported on your implementation. Please help us port it.")

 ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults.

 ;;;; Early meta-level tweaks

 (eval-when (:load-toplevel :compile-toplevel :execute)

   (when (and #+allegro (member :ics *features*)

              #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)

 (in-package :uiop/version)

 (with-upgradability ()

   (defun unparse-version (version-list)

     "From a parsed version (a list of natural numbers), compute the version string"

     "Is the underlying operating system Haiku?"

     (featurep :haiku))

   (defun detect-os ()

     "Detects the current operating system. Only needs be run at compile-time,

 except on ABCL where it might change between FASL compilation and runtime."

            :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p)

                                          (:os-windows . os-windows-p)

                                          (:genera . os-genera-p) (:os-oldmac . os-oldmac-p)

            :when (and (or (not o) (eq feature :os-macosx)) (funcall detect))

            :do (setf o feature) (pushnew feature *features*)

            :else :do (setf *features* (remove feature *features*))

         (ct:free buffer)

         (ct:free buffer1)))

     #+gcl (system:getenv x)

     #+lispworks (lispworks:environment-variable x)

     #+mcl (ccl:with-cstrs ((name x))

             (let ((value (_getenv name)))

                 (ccl:%get-cstring value))))

     #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)

     #+sbcl (sb-ext:posix-getenv x)

     (not-implemented-error 'getenv))

   (defsetf getenv (x) (val)

      '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp)

        (:cmu :cmucl :cmu) :clasp :ecl :gcl

        (:lwpe :lispworks-personal-edition) (:lw :lispworks)

   (defvar *implementation-type* (implementation-type)

     "The type of Lisp implementation used, as a short UIOP-standardized keyword")

        (:solaris :solaris :sunos)

        (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)

        :unix

   (defun architecture ()

     "The CPU architecture of the current host"

         (multiple-value-bind (major minor) (sct:get-system-version "System")

           (format nil "~D.~D" major minor))

         #+mcl (subseq s 8) ; strip the leading "Version "

         ;; seems like there should be a shorter way to do this, like ACALL.

         #+mkcl (or

                 (let ((fname (find-symbol* '#:git-describe-this-mkcl :mkcl nil)))

 (with-upgradability ()

   (defun hostname ()

     "return the hostname of the current host"

     #+cormanlisp "localhost" ;; is there a better way? Does it matter?

     #+allegro (symbol-call :excl.osi :gethostname)

     #+clisp (first (split-string (machine-instance) :separator " "))

   (defun getcwd ()

     "Get the current working directory as per POSIX getcwd(3), as a pathname object"

         #+allegro (excl::current-directory)

         #+clisp (ext:default-directory)

         #+clozure (ccl:current-directory)

   (defun chdir (x)

     "Change current directory, as per POSIX chdir(2), to a given pathname object"

     (if-let (x (pathname x))

       #+allegro (excl:chdir x)

       #+clisp (ext:cd x)

       #+clozure (setf (ccl:current-directory) x)

   ;; This will be :unspecific if supported, or NIL if not.

   (defparameter *unspecific-pathname-type*

     #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific

     "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")

   (defun make-pathname* (&rest keys &key directory host device name type version defaults

           (dbg:*debug-print-level* *print-level*)

           (dbg:*debug-print-length* *print-length*))

       (dbg:bug-backtrace nil))

     #+sbcl

     (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))

     #+xcl

     #+clozure ccl:*command-line-argument-list*

     #+(or cmucl scl) extensions:*command-line-strings*

     #+gcl si:*command-args*

     #+lispworks sys:*line-arguments-list*

     #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))

     #+sbcl sb-ext:*posix-argv*

     #+xcl system:*argv*

     (not-implemented-error 'raw-command-line-arguments))

   (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))

          ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.

          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5

          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67

          (existing-version (asdf-version)))

     (setf *asdf-version* asdf-version)

     (when (and existing-version (not (equal asdf-version existing-version)))

       (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))

   (defun primary-system-name (system-designator)

     (etypecase system-designator

       (string (if-let (p (position #\/ system-designator))

                 (subseq system-designator 0 p) system-designator))

       (symbol (primary-system-name (coerce-name system-designator)))

   (defun primary-system-p (system)

     "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.

       (string (not (find #\/ system)))

   (defun coerce-filename (name)

     "Coerce a system designator NAME into a string suitable as a filename component.

   ;; so they need not refer to the state of the filesystem,

   ;; and the stamps could be cryptographic checksums rather than timestamps.

   ;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP.

   (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)

     ;; Given an action, figure out at what time in the past it has been done,

                       (just-done

                        ;; It's OK to lose some ASDF action stamps during self-upgrade

                        (unless (equal "asdf" (primary-system-name dc))

                        status)

                       (t

                        (return (values nil nil))))))

   ;; TODO: could this file be refactored so that locate-system is merely

   ;; the cache-priming call to input-files here?

   (defmethod input-files ((o define-op) (s system))

     (if-let ((asd (system-source-file s))) (list asd)))

   (defmethod perform ((o define-op) (s system))

     (nest

      (if-let ((pathname (first (input-files o s)))))

      (let ((readtable *readtable*) ;; save outer syntax tables. TODO: proper syntax-control

   (defun locate-system (name)

     "Given a system NAME designator, try to locate where to load the system from.

 FOUNDP is true when a system was found,

 either a new unregistered one or a previously registered one.

 FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed.

 PATHNAME when not null is a path from which to load the system,

 either associated with FOUND-SYSTEM, or with the PREVIOUS system.

 PREVIOUS when not null is a previously loaded SYSTEM object of same name.

     (with-asdf-session () ;; NB: We don't cache the results. We once used to, but it wasn't useful,

       ;; and keeping a negative cache was a bug (see lp#1335323), which required

       ;; explicit invalidation in clear-system and find-system (when unsucccessful).

       (let* ((name (coerce-name name))

              (previous (registered-system name)) ; load from disk if absent or newer on disk

              (found (search-for-system-definition name))

              (found-system (and (typep found 'system) found))

              (pathname (ensure-pathname

         (unless (check-not-old-asdf-system name pathname)

           (check-type previous system) ;; asdf is preloaded, so there should be a previous one.

           (setf found-system nil pathname nil))

   ;; Main method for find-system: first, make sure the computation is memoized in a session cache.

   ;; Unless the system is immutable, use locate-system to find the primary system;

   ;; reconcile the finding (if any) with any previous definition (in a previous session,

   ;; preloaded, with a previous configuration, or before filesystem changes), and

   ;; load a found .asd if appropriate. Finally, update registration table and return results.

   (defmethod find-system ((name string) &optional (error-p t))

     (nest

      (with-asdf-session (:key `(find-system ,name)))

      (let ((name-primary-p (primary-system-p name)))

        (unless name-primary-p (find-system (primary-system-name name) nil)))

      (or (and *immutable-systems* (gethash name *immutable-systems*) (registered-system name)))

          (locate-system name)

        (assert (eq foundp (and (or found-system pathname previous) t))))

      (let ((previous-pathname (system-source-file previous))

          (setf (system-source-file system) pathname))

        (if-let ((stamp (get-file-stamp pathname)))

          (let ((up-to-date-p

                      (or (pathname-equal pathname previous-pathname)

                          (and pathname previous-pathname

                               (pathname-equal

                                (physicalize-pathname pathname)

                                (physicalize-pathname previous-pathname))))

                      (timestamp<= stamp previous-time)

            (unless up-to-date-p

              (restart-case

                  (signal 'system-out-of-date :name name)

 (in-package :asdf/bundle)

 (with-upgradability ()

     (:documentation "base class for operations that bundle outputs from multiple components"))

   (defclass monolithic-op (operation) ()

     (:documentation "A MONOLITHIC operation operates on a system *and all of its

   (defclass link-op (bundle-op) ()

     (:documentation "Abstract operation for linking files together"))

     (:documentation "Abstract operation for gathering many input files from a system"))

   (defun operation-monolithic-p (op)

     (typep op 'monolithic-op))

       `((,go ,@deps) ,@(call-next-method))))

   ;; Create a single fasl for the entire library

     (:documentation "Base class for compiling into a bundle"))

   ;; Analog to prepare-op, for load-bundle-op and compile-bundle-op

   (defclass prepare-bundle-op (sideway-operation)

       :allocation :class))

     (:documentation "Operation class for loading the bundles of a system's dependencies"))

     (:documentation "Compile the system and produce a linkable static library (.a/.lib)

 for all the linkable object files associated with the system. Compare with DLL-OP.

 On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp files

 themselves. In any case, this operation will produce what you need to further build

 a static runtime for your system, or a dynamic library to load in an existing runtime."))

   ;; What works: on ECL, CLASP(?), MKCL, we link the many .o files from the system into the .so;

   ;; on other implementations, we combine (usually concatenate) the .fasl files into one.

   ;; we'd have to have the monolithic-op not inherit from the main op,

   ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.

     (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)

 for all the linkable object files associated with the system. Compare with LIB-OP."))

   (defclass deliver-asd-op (basic-compile-op selfward-operation)

     ((selfward-operation

     ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))

     (:documentation "Load a single fasl for the system and its dependencies."))

     (:documentation "Compile the system and produce a linkable static library (.a/.lib)

 for all the linkable object files associated with the system or its dependencies. See LIB-OP."))

     (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)

 for all the linkable object files associated with the system or its dependencies. See LIB-OP"))

   (defclass image-op (monolithic-bundle-op selfward-operation

                       #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)

     (:documentation "create an image file from the system and its dependencies"))

     (:documentation "create an executable file from the system and its dependencies"))

   ;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type.

   (defun bundle-pathname-type (bundle-type)

 ;;;

 (with-upgradability ()

   ;; Base classes for both regular and monolithic concatenate-source operations

   (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())

   (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())

   (defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ())

                         previous

                         (eval `(defsystem ,system

                                  :class package-inferred-system

                                  :pathname ,dir

                                  :depends-on ,dependencies

                                  :around-compile ,around-compile

         :asdf/system ;; used by ECL

         :asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle)

   ;; Happily, all those implementations all have the same module-provider hook interface.

   #+(or clasp mkcl) (:import-from :si #:*load-hooks*))

 (in-package :asdf/footer)

 ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.

 (with-upgradability ()

   ;; Hook into CL:REQUIRE.

   #-clisp (pushnew 'module-provide-asdf *module-provider-functions*)

     (setf (gethash 'module-provide-asdf *wrapped-module-provider*) 'module-provide-asdf)

     (defun wrap-module-provider (provider name)

       (let ((results (multiple-value-list (funcall provider name))))

     (defun wrap-module-provider-function (provider)

       (ensure-gethash provider *wrapped-module-provider*

     (setf *module-provider-functions*

 #+cmucl ;; Hook into the CMUCL herald.

 (with-upgradability ()

 <a name="Top"></a>

 <a name="ASDF_003a-Another-System-Definition-Facility"></a>

 <h1 class="top">ASDF: Another System Definition Facility</h1>

 </p>

 <p>This manual describes ASDF, a system definition facility

   Available in updated-for-CL form on the web at

   <a href="http://nhplace.com/kent/Papers/Large-Systems.html">http://nhplace.com/kent/Papers/Large-Systems.html</a>

 </li><li> Dan Weinreb and David Moon:

   The famous CHINE NUAL describes one of the earliest variants of DEFSYSTEM.

 </li></ul>

 ASDF: Another System Definition Facility

 ****************************************

    This manual describes ASDF, a system definition facility for Common

 Lisp programs and libraries.

    * Kent M. Pitman (kmp): "The Description of Large Systems", MIT AI

      Memo 801, 1984.  Available in updated-for-CL form on the web at

      <http://nhplace.com/kent/Papers/Large-Systems.html>

 File: asdf.info,  Node: Concept Index,  Next: Function and Class Index,  Prev: Bibliography,  Up: Top

 Node: How do I run the tests interactively in a REPL?252242

 Node: Ongoing Work253809

 Node: Bibliography254088

 End Tag Table

 ## New in this release:

   * Known issues:

   * Feature enhancements

   * Changes

     * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG.

       * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937.