Changeset 15121


Ignore:
Timestamp:
05/07/18 20:08:10 (4 years ago)
Author:
Mark Evenson
Message:

update to asdf-3.2.2

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/doc/asdf/asdf.texinfo

    r15113 r15121  
    6666@titlepage
    6767@title ASDF: Another System Definition Facility
    68 @subtitle Manual for Version 3.3.1
     68@subtitle Manual for Version 3.3.2
    6969@c The following two commands start the copyright page.
    7070@page
     
    8383@top ASDF: Another System Definition Facility
    8484@ifnottex
    85 Manual for Version 3.3.1
     85Manual for Version 3.3.2
    8686@end ifnottex
    8787
     
    63486348  @url{http://nhplace.com/kent/Papers/Large-Systems.html}
    63496349@item Dan Weinreb and David Moon:
    6350   ``Lisp Machine Manual'', MIT, 1981.
     6350  ``Lisp Machine Manual'', 3rd Edition MIT, March 1981.
    63516351  The famous CHINE NUAL describes one of the earliest variants of DEFSYSTEM.
    6352   @url{https://bitsavers.trailing-edge.com/pdf/mit/cadr/chinual_4thEd_Jul81.pdf}
     6352  (NB: Not present in the second preliminary version of January 1979)
     6353  @url{http://bitsavers.org/pdf/mit/cadr/chinual_3rdEd_Mar81.pdf}
    63536354@end itemize
    63546355
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r15113 r15121  
    11;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
    2 ;;; This is ASDF 3.3.1: Another System Definition Facility.
     2;;; This is ASDF 3.3.2: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    748748      :when (eq kw :unintern) :append args :into unintern :else
    749749        :do (error "unrecognized define-package keyword ~S" kw)
    750       :finally (return `(,package
    751                          :nicknames ,nicknames :documentation ,documentation
    752                          :use ,(if use-p use '(:common-lisp))
    753                          :shadow ,shadow :shadowing-import-from ,shadowing-import-from
    754                          :import-from ,import-from :export ,export :intern ,intern
    755                          :recycle ,(if recycle-p recycle (cons package nicknames))
    756                          :mix ,mix :reexport ,reexport :unintern ,unintern)))))
     750      :finally (return `(',package
     751                         :nicknames ',nicknames :documentation ',documentation
     752                         :use ',(if use-p use '(:common-lisp))
     753                         :shadow ',shadow :shadowing-import-from ',shadowing-import-from
     754                         :import-from ',import-from :export ',export :intern ',intern
     755                         :recycle ',(if recycle-p recycle (cons package nicknames))
     756                         :mix ',mix :reexport ',reexport :unintern ',unintern)))))
    757757
    758758(defmacro define-package (package &rest clauses)
     
    780780UNINTERN -- Remove symbols here from PACKAGE."
    781781  (let ((ensure-form
    782           `(apply 'ensure-package ',(parse-define-package-form package clauses))))
     782         `(prog1
     783              (funcall 'ensure-package ,@(parse-define-package-form package clauses))
     784            #+sbcl (setf (sb-impl::package-source-location (find-package ',package))
     785                         (sb-c:source-location)))))
    783786    `(progn
    784787       #+(or clasp ecl gcl mkcl) (defpackage ,package (:use))
     
    808811(in-package :uiop/common-lisp)
    809812
    810 #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     813#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
    811814(error "ASDF is not supported on your implementation. Please help us port it.")
    812815
     
    816819;;;; Early meta-level tweaks
    817820
    818 #+(or allegro clasp clisp clozure cmucl ecl mkcl sbcl)
     821#+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
    819822(eval-when (:load-toplevel :compile-toplevel :execute)
    820823  (when (and #+allegro (member :ics *features*)
     
    16701673
    16711674(with-upgradability ()
    1672   (defparameter *uiop-version* "3.3.1")
     1675  (defparameter *uiop-version* "3.3.2")
    16731676
    16741677  (defun unparse-version (version-list)
     
    18981901    (featurep :haiku))
    18991902
     1903  (defun os-mezzano-p ()
     1904    "Is the underlying operating system Mezzano?"
     1905    (featurep :mezzano))
     1906
    19001907  (defun detect-os ()
    19011908    "Detects the current operating system. Only needs be run at compile-time,
     
    19051912                                         (:os-windows . os-windows-p)
    19061913                                         (:genera . os-genera-p) (:os-oldmac . os-oldmac-p)
    1907                                          (:haiku . os-haiku-p))
     1914                                         (:haiku . os-haiku-p)
     1915                                         (:mezzano . os-mezzano-p))
    19081916           :when (and (or (not o) (eq feature :os-macosx)) (funcall detect))
    19091917           :do (setf o feature) (pushnew feature *features*)
     
    19421950        (ct:free buffer1)))
    19431951    #+gcl (system:getenv x)
    1944     #+genera nil
     1952    #+(or genera mezzano) nil
    19451953    #+lispworks (lispworks:environment-variable x)
    19461954    #+mcl (ccl:with-cstrs ((name x))
     
    19501958    #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
    19511959    #+sbcl (sb-ext:posix-getenv x)
    1952     #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     1960    #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
    19531961    (not-implemented-error 'getenv))
    19541962
     
    19962004       (:cmu :cmucl :cmu) :clasp :ecl :gcl
    19972005       (:lwpe :lispworks-personal-edition) (:lw :lispworks)
    1998        :mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
     2006       :mcl :mezzano :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
    19992007
    20002008  (defvar *implementation-type* (implementation-type)
     
    20112019       (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
    20122020       :unix
    2013        :genera)))
     2021       :genera
     2022       :mezzano)))
    20142023
    20152024  (defun architecture ()
     
    20692078          (format nil "~D.~D" major minor))
    20702079        #+mcl (subseq s 8) ; strip the leading "Version "
     2080        #+mezzano (format nil "~A-~D"
     2081                          (subseq s 0 (position #\space s)) ; strip commit hash
     2082                          sys.int::*llf-version*)
    20712083        ;; seems like there should be a shorter way to do this, like ACALL.
    20722084        #+mkcl (or
     
    20942106  (defun hostname ()
    20952107    "return the hostname of the current host"
    2096     #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
     2108    #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mezzano mkcl sbcl scl xcl) (machine-instance)
    20972109    #+cormanlisp "localhost" ;; is there a better way? Does it matter?
    20982110    #+allegro (symbol-call :excl.osi :gethostname)
     
    21142126  (defun getcwd ()
    21152127    "Get the current working directory as per POSIX getcwd(3), as a pathname object"
    2116     (or #+(or abcl genera xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
     2128    (or #+(or abcl genera mezzano xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
    21172129        #+allegro (excl::current-directory)
    21182130        #+clisp (ext:default-directory)
     
    21322144    "Change current directory, as per POSIX chdir(2), to a given pathname object"
    21332145    (if-let (x (pathname x))
    2134       #+(or abcl genera xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
     2146      #+(or abcl genera mezzano xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
    21352147      #+allegro (excl:chdir x)
    21362148      #+clisp (ext:cd x)
     
    23252337  (defparameter *unspecific-pathname-type*
    23262338    #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
    2327     #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil
     2339    #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
    23282340    "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
    23292341
     
    45124524          (dbg:*debug-print-length* *print-length*))
    45134525      (dbg:bug-backtrace nil))
     4526    #+mezzano
     4527    (let ((*standard-output* stream))
     4528      (sys.int::backtrace count))
    45144529    #+sbcl
    45154530    (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))
     
    46004615    #+(or cmucl scl) extensions:*command-line-strings*
    46014616    #+gcl si:*command-args*
    4602     #+(or genera mcl) nil
     4617    #+(or genera mcl mezzano) nil
    46034618    #+lispworks sys:*line-arguments-list*
    46044619    #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))
    46054620    #+sbcl sb-ext:*posix-argv*
    46064621    #+xcl system:*argv*
    4607     #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     4622    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
    46084623    (not-implemented-error 'raw-command-line-arguments))
    46094624
     
    75077522         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    75087523         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    7509          (asdf-version "3.3.1")
     7524         (asdf-version "3.3.2")
    75107525         (existing-version (asdf-version)))
    75117526    (setf *asdf-version* asdf-version)
     
    83258340
    83268341  (defun primary-system-name (system-designator)
    8327     "Given a system designator NAME, return the name of the corresponding primary system,
    8328 after which the .asd file is named. That's the first component when dividing the name
    8329 as a string by / slashes. A component designates its system."
     8342    "Given a system designator NAME, return the name of the corresponding
     8343primary system, after which the .asd file in which it is defined is named.
     8344If given a string or symbol (to downcase), do it syntactically
     8345 by stripping anything from the first slash on.
     8346If given a component, do it semantically by extracting
     8347the system-primary-system-name of its system."
    83308348    (etypecase system-designator
    83318349      (string (if-let (p (position #\/ system-designator))
    83328350                (subseq system-designator 0 p) system-designator))
    83338351      (symbol (primary-system-name (coerce-name system-designator)))
    8334       (component (primary-system-name (coerce-name (component-system system-designator))))))
     8352      (component (let* ((system (component-system system-designator))
     8353                        (source-file (physicalize-pathname (system-source-file system))))
     8354                   (and source-file
     8355                        (equal (pathname-type source-file) "asd")
     8356                        (pathname-name source-file))))))
    83358357
    83368358  (defun primary-system-p (system)
    83378359    "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.
    8338 Also return NIL if system is neither a SYSTEM nor a string designating one."
    8339     (typecase system
     8360If given a string, do it syntactically and return true if the name does not contain a slash.
     8361If given a symbol, downcase to a string then fallback to previous case (NB: for NIL return T).
     8362If given a component, do it semantically and return T if it's a SYSTEM and its primary-system-name
     8363is the same as its component-name."
     8364    (etypecase system
    83408365      (string (not (find #\/ system)))
    8341       (system (primary-system-p (coerce-name system)))))
     8366      (symbol (primary-system-p (coerce-name system)))
     8367      (component (and (typep system 'system)
     8368                      (equal (component-name system) (primary-system-name system))))))
    83428369
    83438370  (defun coerce-filename (name)
     
    1000010027  ;; and the stamps could be cryptographic checksums rather than timestamps.
    1000110028  ;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP.
     10029  (define-condition dependency-not-done (warning)
     10030    ((op
     10031      :initarg :op)
     10032     (component
     10033      :initarg :component)
     10034     (dep-op
     10035      :initarg :dep-op)
     10036     (dep-component
     10037      :initarg :dep-component)
     10038     (plan
     10039      :initarg :plan
     10040      :initform nil))
     10041    (:report (lambda (condition stream)
     10042               (with-slots (op component dep-op dep-component plan) condition
     10043                 (format stream "Computing just-done stamp ~@[in plan ~S~] for action ~S, but dependency ~S wasn't done yet!"
     10044                         plan
     10045                         (action-path (make-action op component))
     10046                         (action-path (make-action dep-op dep-component)))))))
    1000210047
    1000310048  (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
     
    1003310078                       ;; It's OK to lose some ASDF action stamps during self-upgrade
    1003410079                       (unless (equal "asdf" (primary-system-name dc))
    10035                          (warn "Computing just-done stamp in plan ~S for action ~S, but dependency ~S wasn't done yet!"
    10036                                plan
    10037                                (action-path (make-action o c))
    10038                                (action-path (make-action do dc))))
     10080                         (warn 'dependency-not-done
     10081                               :plan plan
     10082                               :op o :component c
     10083                               :dep-op do :dep-component dc))
    1003910084                       status)
    1004010085                      (t
     
    1068310728  ;; the cache-priming call to input-files here?
    1068410729  (defmethod input-files ((o define-op) (s system))
    10685     (assert (equal (coerce-name s) (primary-system-name s)))
    1068610730    (if-let ((asd (system-source-file s))) (list asd)))
    1068710731
    1068810732  (defmethod perform ((o define-op) (s system))
    10689     (assert (equal (coerce-name s) (primary-system-name s)))
    1069010733    (nest
    1069110734     (if-let ((pathname (first (input-files o s)))))
     
    1079610839  (defun locate-system (name)
    1079710840    "Given a system NAME designator, try to locate where to load the system from.
    10798 Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
     10841Returns six values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME PREVIOUS-PRIMARY
    1079910842FOUNDP is true when a system was found,
    1080010843either a new unregistered one or a previously registered one.
     
    1080310846either associated with FOUND-SYSTEM, or with the PREVIOUS system.
    1080410847PREVIOUS when not null is a previously loaded SYSTEM object of same name.
    10805 PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
     10848PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
     10849PREVIOUS-PRIMARY when not null is the primary system for the PREVIOUS system."
    1080610850    (with-asdf-session () ;; NB: We don't cache the results. We once used to, but it wasn't useful,
    1080710851      ;; and keeping a negative cache was a bug (see lp#1335323), which required
     
    1080910853      (let* ((name (coerce-name name))
    1081010854             (previous (registered-system name)) ; load from disk if absent or newer on disk
    10811              (primary (registered-system (primary-system-name name)))
    10812              (previous-time (and previous primary (component-operation-time 'define-op primary)))
     10855             (previous-primary-name (and previous (primary-system-name previous)))
     10856             (previous-primary-system (and previous-primary-name
     10857                                           (registered-system previous-primary-name)))
     10858             (previous-time (and previous-primary-system
     10859                                 (component-operation-time 'define-op previous-primary-system)))
    1081310860             (found (search-for-system-definition name))
    1081410861             (found-system (and (typep found 'system) found))
     
    1082310870          (check-type previous system) ;; asdf is preloaded, so there should be a previous one.
    1082410871          (setf found-system nil pathname nil))
    10825         (values foundp found-system pathname previous previous-time))))
     10872        (values foundp found-system pathname previous previous-time previous-primary-system))))
     10873
     10874  ;; TODO: make a prepare-define-op node for this
     10875  ;; so we can properly cache the answer rather than recompute it.
     10876  (defun definition-dependencies-up-to-date-p (system)
     10877    (check-type system system)
     10878    (or (not (primary-system-p system))
     10879        (handler-case
     10880            (loop :with plan = (make-instance *plan-class*)
     10881              :for action :in (definition-dependency-list system)
     10882              :always (action-up-to-date-p
     10883                       plan (action-operation action) (action-component action))
     10884              :finally
     10885              (let ((o (make-operation 'define-op)))
     10886                (multiple-value-bind (stamp done-p)
     10887                    (compute-action-stamp plan o system)
     10888                  (return (and (timestamp<= stamp (component-operation-time o system))
     10889                               done-p)))))
     10890          (system-out-of-date () nil))))
    1082610891
    1082710892  ;; Main method for find-system: first, make sure the computation is memoized in a session cache.
     
    1083010895  ;; preloaded, with a previous configuration, or before filesystem changes), and
    1083110896  ;; load a found .asd if appropriate. Finally, update registration table and return results.
    10832 
    10833   (defun definition-dependencies-up-to-date-p (system)
    10834     (check-type system system)
    10835     (assert (primary-system-p system))
    10836     (handler-case
    10837         (loop :with plan = (make-instance *plan-class*)
    10838           :for action :in (definition-dependency-list system)
    10839           :always (action-up-to-date-p
    10840                    plan (action-operation action) (action-component action))
    10841           :finally
    10842           (let ((o (make-operation 'define-op)))
    10843             (multiple-value-bind (stamp done-p)
    10844                 (compute-action-stamp plan o system)
    10845               (return (and (timestamp<= stamp (component-operation-time o system))
    10846                            done-p)))))
    10847       (system-out-of-date () nil)))
    10848 
    1084910897  (defmethod find-system ((name string) &optional (error-p t))
    1085010898    (nest
     
    1085310901       (unless name-primary-p (find-system (primary-system-name name) nil)))
    1085410902     (or (and *immutable-systems* (gethash name *immutable-systems*) (registered-system name)))
    10855      (multiple-value-bind (foundp found-system pathname previous previous-time)
     10903     (multiple-value-bind (foundp found-system pathname previous previous-time previous-primary)
    1085610904         (locate-system name)
    1085710905       (assert (eq foundp (and (or found-system pathname previous) t))))
     
    1086410912       (if-let ((stamp (get-file-stamp pathname)))
    1086510913         (let ((up-to-date-p
    10866                 (and previous
     10914                (and previous previous-primary
    1086710915                     (or (pathname-equal pathname previous-pathname)
    1086810916                         (and pathname previous-pathname
     
    1087110919                               (physicalize-pathname previous-pathname))))
    1087210920                     (timestamp<= stamp previous-time)
    10873                      ;; TODO: check that all dependencies are up-to-date.
    10874                      ;; This necessitates traversing them without triggering
    10875                      ;; the adding of nodes to the plan.
    10876                      (or (not name-primary-p)
    10877                          (definition-dependencies-up-to-date-p previous)))))
     10921                     ;; Check that all previous definition-dependencies are up-to-date,
     10922                     ;; traversing them without triggering the adding of nodes to the plan.
     10923                     ;; TODO: actually have a prepare-define-op, extract its timestamp,
     10924                     ;; and check that it is less than the stamp of the previous define-op ?
     10925                     (definition-dependencies-up-to-date-p previous-primary))))
    1087810926           (unless up-to-date-p
    1087910927             (restart-case
     
    1128511333
    1128611334(with-upgradability ()
    11287   (defclass bundle-op (operation)
    11288     ;; NB: use of instance-allocated slots for operations is DEPRECATED
    11289     ;; and only supported in a temporary fashion for backward compatibility.
    11290     ;; Supported replacement: Define slots on program-system instead.
    11291     ((bundle-type :initform :no-output-file :reader bundle-type :allocation :class))
     11335  (defclass bundle-op (operation) ()
    1129211336    (:documentation "base class for operations that bundle outputs from multiple components"))
     11337  (defgeneric bundle-type (bundle-op))
    1129311338
    1129411339  (defclass monolithic-op (operation) ()
     
    1133111376    (:documentation "Abstract operation for linking files together"))
    1133211377
    11333   (defclass gather-operation (bundle-op)
    11334     ((gather-operation :initform nil :allocation :class :reader gather-operation)
    11335      (gather-type :initform :no-output-file :allocation :class :reader gather-type))
     11378  (defclass gather-operation (bundle-op) ()
    1133611379    (:documentation "Abstract operation for gathering many input files from a system"))
     11380  (defgeneric gather-operation (gather-operation))
     11381  (defmethod gather-operation ((o gather-operation)) nil)
     11382  (defgeneric gather-type (gather-operation))
    1133711383
    1133811384  (defun operation-monolithic-p (op)
     
    1137111417
    1137211418  ;; Create a single fasl for the entire library
    11373   (defclass basic-compile-bundle-op (bundle-op basic-compile-op)
    11374     ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object
    11375                   :allocation :class)
    11376      (bundle-type :initform :fasb :allocation :class))
     11419  (defclass basic-compile-bundle-op (bundle-op basic-compile-op) ()
    1137711420    (:documentation "Base class for compiling into a bundle"))
     11421  (defmethod bundle-type ((o basic-compile-bundle-op)) :fasb)
     11422  (defmethod gather-type ((o basic-compile-bundle-op))
     11423    #-(or clasp ecl mkcl) :fasl
     11424    #+(or clasp ecl mkcl) :object)
    1137811425
    1137911426  ;; Analog to prepare-op, for load-bundle-op and compile-bundle-op
     
    1138411431    (:documentation "Operation class for loading the bundles of a system's dependencies"))
    1138511432
    11386   (defclass lib-op (link-op gather-operation non-propagating-operation)
    11387     ((gather-type :initform :object :allocation :class)
    11388      (bundle-type :initform :lib :allocation :class))
     11433  (defclass lib-op (link-op gather-operation non-propagating-operation) ()
    1138911434    (:documentation "Compile the system and produce a linkable static library (.a/.lib)
    1139011435for all the linkable object files associated with the system. Compare with DLL-OP.
     
    1139511440themselves. In any case, this operation will produce what you need to further build
    1139611441a static runtime for your system, or a dynamic library to load in an existing runtime."))
     11442  (defmethod bundle-type ((o lib-op)) :lib)
     11443  (defmethod gather-type ((o lib-op)) :object)
    1139711444
    1139811445  ;; What works: on ECL, CLASP(?), MKCL, we link the many .o files from the system into the .so;
     
    1141811465  ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
    1141911466
    11420   (defclass dll-op (link-op gather-operation non-propagating-operation)
    11421     ((gather-type :initform :object :allocation :class)
    11422      (bundle-type :initform :dll :allocation :class))
     11467  (defclass dll-op (link-op gather-operation non-propagating-operation) ()
    1142311468    (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
    1142411469for all the linkable object files associated with the system. Compare with LIB-OP."))
     11470  (defmethod bundle-type ((o dll-op)) :dll)
     11471  (defmethod gather-type ((o dll-op)) :object)
    1142511472
    1142611473  (defclass deliver-asd-op (basic-compile-op selfward-operation)
     
    1145111498    (:documentation "Load a single fasl for the system and its dependencies."))
    1145211499
    11453   (defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation)
    11454     ((gather-type :initform :object :allocation :class))
     11500  (defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation) ()
    1145511501    (:documentation "Compile the system and produce a linkable static library (.a/.lib)
    1145611502for all the linkable object files associated with the system or its dependencies. See LIB-OP."))
    1145711503
    11458   (defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation)
    11459     ((gather-type :initform :object :allocation :class))
     11504  (defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation) ()
    1146011505    (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
    1146111506for all the linkable object files associated with the system or its dependencies. See LIB-OP"))
     
    1146311508  (defclass image-op (monolithic-bundle-op selfward-operation
    1146411509                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
    11465     ((bundle-type :initform :image :allocation :class)
    11466      (gather-operation :initform 'lib-op :allocation :class)
    11467      #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
    11468      (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
     11510    ((selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
    1146911511    (:documentation "create an image file from the system and its dependencies"))
    11470 
    11471   (defclass program-op (image-op)
    11472     ((bundle-type :initform :program :allocation :class))
     11512  (defmethod bundle-type ((o image-op)) :image)
     11513  #+(or clasp ecl mkcl) (defmethod gather-operation ((o image-op)) 'lib-op)
     11514  #+(or clasp ecl mkcl) (defmethod gather-type ((o image-op)) :static-library)
     11515
     11516  (defclass program-op (image-op) ()
    1147311517    (:documentation "create an executable file from the system and its dependencies"))
     11518  (defmethod bundle-type ((o program-op)) :program)
    1147411519
    1147511520  ;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type.
     
    1185811903(with-upgradability ()
    1185911904  ;; Base classes for both regular and monolithic concatenate-source operations
    11860   (defclass basic-concatenate-source-op (bundle-op)
    11861     ((bundle-type :initform "lisp" :allocation :class)))
     11905  (defclass basic-concatenate-source-op (bundle-op) ())
     11906  (defmethod bundle-type ((o basic-concatenate-source-op)) "lisp")
    1186211907  (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
    1186311908  (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
     
    1207712122                        (eval `(defsystem ,system
    1207812123                                 :class package-inferred-system
    12079                                  :source-file nil
     12124                                 :source-file ,(system-source-file top)
    1208012125                                 :pathname ,dir
    1208112126                                 :depends-on ,dependencies
     
    1328313328        :asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle)
    1328413329  ;; Happily, all those implementations all have the same module-provider hook interface.
    13285   #+(or abcl clasp cmucl clozure ecl mkcl sbcl)
    13286   (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext
    13287     #:*module-provider-functions*
    13288     #+ecl #:*load-hooks*)
     13330  #+(or abcl clasp cmucl clozure ecl mezzano mkcl sbcl)
     13331  (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext #+mezzano :sys.int
     13332                #:*module-provider-functions*
     13333                #+ecl #:*load-hooks*)
    1328913334  #+(or clasp mkcl) (:import-from :si #:*load-hooks*))
    1329013335
     
    1330013345
    1330113346;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
    13302 #+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl)
     13347#+(or abcl clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
    1330313348(with-upgradability ()
    1330413349  ;; Hook into CL:REQUIRE.
     
    1332013365    (defun wrap-module-provider (provider name)
    1332113366      (let ((results (multiple-value-list (funcall provider name))))
    13322   (when (first results) (register-preloaded-system (coerce-name name)))
    13323   (values-list results)))
     13367        (when (first results) (register-preloaded-system (coerce-name name)))
     13368        (values-list results)))
    1332413369    (defun wrap-module-provider-function (provider)
    1332513370      (ensure-gethash provider *wrapped-module-provider*
    13326           (constantly
    13327            #'(lambda (module-name)
    13328          (wrap-module-provider provider module-name)))))
     13371                      (constantly
     13372                       #'(lambda (module-name)
     13373                           (wrap-module-provider provider module-name)))))
    1332913374    (setf *module-provider-functions*
    13330     (mapcar #'wrap-module-provider-function *module-provider-functions*))))
     13375          (mapcar #'wrap-module-provider-function *module-provider-functions*))))
    1333113376
    1333213377#+cmucl ;; Hook into the CMUCL herald.
Note: See TracChangeset for help on using the changeset viewer.