cmucl-cvs

Download

cmucl-cvs@common-lisp.net

May 2018

1 participants
1 discussions

[Git][cmucl/cmucl][master] ASDF 3.3.2
by Raymond Toy 12 May '18

12 May '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 23e31483 by Raymond Toy at 2018-05-12T10:40:12-07:00 ASDF 3.3.2 - - - - - 5 changed files: - src/contrib/asdf/asdf.lisp - src/contrib/asdf/doc/asdf.html - src/contrib/asdf/doc/asdf.info - src/contrib/asdf/doc/asdf.pdf - src/general-info/release-21d.md Changes: ===================================== src/contrib/asdf/asdf.lisp ===================================== --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.3.1: Another System Definition Facility. +;;; This is ASDF 3.3.2: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -747,13 +747,13 @@ or when loading the package is optional." :and :do (setf use-p t) :else :when (eq kw :unintern) :append args :into unintern :else :do (error "unrecognized define-package keyword ~S" kw) - :finally (return `(,package - :nicknames ,nicknames :documentation ,documentation - :use ,(if use-p use '(:common-lisp)) - :shadow ,shadow :shadowing-import-from ,shadowing-import-from - :import-from ,import-from :export ,export :intern ,intern - :recycle ,(if recycle-p recycle (cons package nicknames)) - :mix ,mix :reexport ,reexport :unintern ,unintern))))) + :finally (return `(',package + :nicknames ',nicknames :documentation ',documentation + :use ',(if use-p use '(:common-lisp)) + :shadow ',shadow :shadowing-import-from ',shadowing-import-from + :import-from ',import-from :export ',export :intern ',intern + :recycle ',(if recycle-p recycle (cons package nicknames)) + :mix ',mix :reexport ',reexport :unintern ',unintern))))) (defmacro define-package (package &rest clauses) "DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form @@ -779,7 +779,10 @@ export symbols with the same name as those exported from p. Note that in the ca of shadowing, etc. the symbols with the same name may not be the same symbols. UNINTERN -- Remove symbols here from PACKAGE." (let ((ensure-form - `(apply 'ensure-package ',(parse-define-package-form package clauses)))) + `(prog1 + (funcall 'ensure-package ,@(parse-define-package-form package clauses)) + #+sbcl (setf (sb-impl::package-source-location (find-package ',package)) + (sb-c:source-location))))) `(progn #+(or clasp ecl gcl mkcl) (defpackage ,package (:use)) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -807,7 +810,7 @@ UNINTERN -- Remove symbols here from PACKAGE." #+(or mcl cmucl) (:shadow #:user-homedir-pathname)) (in-package :uiop/common-lisp) -#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) +#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl) (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. @@ -815,7 +818,7 @@ UNINTERN -- Remove symbols here from PACKAGE." ;;;; Early meta-level tweaks -#+(or allegro clasp clisp clozure cmucl ecl mkcl sbcl) +#+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl) (eval-when (:load-toplevel :compile-toplevel :execute) (when (and #+allegro (member :ics *features*) #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*) @@ -1669,7 +1672,7 @@ message, that takes the functionality as its first argument (that can be skipped (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.1") + (defparameter *uiop-version* "3.3.2") (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" @@ -1897,6 +1900,10 @@ keywords explicitly." "Is the underlying operating system Haiku?" (featurep :haiku)) + (defun os-mezzano-p () + "Is the underlying operating system Mezzano?" + (featurep :mezzano)) + (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." @@ -1904,7 +1911,8 @@ 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) - (:haiku . os-haiku-p)) + (:haiku . os-haiku-p) + (:mezzano . os-mezzano-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*)) @@ -1941,7 +1949,7 @@ use getenvp to return NIL in such a case." (ct:free buffer) (ct:free buffer1))) #+gcl (system:getenv x) - #+genera nil + #+(or genera mezzano) nil #+lispworks (lispworks:environment-variable x) #+mcl (ccl:with-cstrs ((name x)) (let ((value (_getenv name))) @@ -1949,7 +1957,7 @@ use getenvp to return NIL in such a case." (ccl:%get-cstring value)))) #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x) #+sbcl (sb-ext:posix-getenv x) - #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl) (not-implemented-error 'getenv)) (defsetf getenv (x) (val) @@ -1995,7 +2003,7 @@ then returning the non-empty string value of the variable" '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) (:cmu :cmucl :cmu) :clasp :ecl :gcl (:lwpe :lispworks-personal-edition) (:lw :lispworks) - :mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) + :mcl :mezzano :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) (defvar *implementation-type* (implementation-type) "The type of Lisp implementation used, as a short UIOP-standardized keyword") @@ -2010,7 +2018,8 @@ then returning the non-empty string value of the variable" (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly) :unix - :genera))) + :genera + :mezzano))) (defun architecture () "The CPU architecture of the current host" @@ -2068,6 +2077,9 @@ then returning the non-empty string value of the variable" (multiple-value-bind (major minor) (sct:get-system-version "System") (format nil "~D.~D" major minor)) #+mcl (subseq s 8) ; strip the leading "Version " + #+mezzano (format nil "~A-~D" + (subseq s 0 (position #\space s)) ; strip commit hash + sys.int::*llf-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))) @@ -2093,7 +2105,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (with-upgradability () (defun hostname () "return the hostname of the current host" - #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) + #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mezzano mkcl sbcl scl xcl) (machine-instance) #+cormanlisp "localhost" ;; is there a better way? Does it matter? #+allegro (symbol-call :excl.osi :gethostname) #+clisp (first (split-string (machine-instance) :separator " ")) @@ -2113,7 +2125,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun getcwd () "Get the current working directory as per POSIX getcwd(3), as a pathname object" - (or #+(or abcl genera xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical! + (or #+(or abcl genera mezzano xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical! #+allegro (excl::current-directory) #+clisp (ext:default-directory) #+clozure (ccl:current-directory) @@ -2131,7 +2143,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun chdir (x) "Change current directory, as per POSIX chdir(2), to a given pathname object" (if-let (x (pathname x)) - #+(or abcl genera xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical! + #+(or abcl genera mezzano xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical! #+allegro (excl:chdir x) #+clisp (ext:cd x) #+clozure (setf (ccl:current-directory) x) @@ -2324,7 +2336,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific - #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil + #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil "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 @@ -4511,6 +4523,9 @@ This is designed to abstract away the implementation specific quit forms." (dbg:*debug-print-level* *print-level*) (dbg:*debug-print-length* *print-length*)) (dbg:bug-backtrace nil)) + #+mezzano + (let ((*standard-output* stream)) + (sys.int::backtrace count)) #+sbcl (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum)) #+xcl @@ -4599,12 +4614,12 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" #+clozure ccl:*command-line-argument-list* #+(or cmucl scl) extensions:*command-line-strings* #+gcl si:*command-args* - #+(or genera mcl) nil + #+(or genera mcl mezzano) nil #+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* - #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl) (not-implemented-error 'raw-command-line-arguments)) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) @@ -7506,7 +7521,7 @@ previously-loaded version of ASDF." ;; "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 - (asdf-version "3.3.1") + (asdf-version "3.3.2") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -8324,21 +8339,33 @@ a SYMBOL (designing its name, downcased), or a STRING (designing itself)." (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name)))) (defun primary-system-name (system-designator) - "Given a system designator NAME, return the name of the corresponding primary system, -after which the .asd file is named. That's the first component when dividing the name -as a string by / slashes. A component designates its system." + "Given a system designator NAME, return the name of the corresponding +primary system, after which the .asd file in which it is defined is named. +If given a string or symbol (to downcase), do it syntactically + by stripping anything from the first slash on. +If given a component, do it semantically by extracting +the system-primary-system-name of its system." (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))) - (component (primary-system-name (coerce-name (component-system system-designator)))))) + (component (let* ((system (component-system system-designator)) + (source-file (physicalize-pathname (system-source-file system)))) + (and source-file + (equal (pathname-type source-file) "asd") + (pathname-name source-file)))))) (defun primary-system-p (system) "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL. -Also return NIL if system is neither a SYSTEM nor a string designating one." - (typecase system +If given a string, do it syntactically and return true if the name does not contain a slash. +If given a symbol, downcase to a string then fallback to previous case (NB: for NIL return T). +If given a component, do it semantically and return T if it's a SYSTEM and its primary-system-name +is the same as its component-name." + (etypecase system (string (not (find #\/ system))) - (system (primary-system-p (coerce-name system))))) + (symbol (primary-system-p (coerce-name system))) + (component (and (typep system 'system) + (equal (component-name system) (primary-system-name system)))))) (defun coerce-filename (name) "Coerce a system designator NAME into a string suitable as a filename component. @@ -9999,6 +10026,24 @@ initialized with SEED." ;; 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. + (define-condition dependency-not-done (warning) + ((op + :initarg :op) + (component + :initarg :component) + (dep-op + :initarg :dep-op) + (dep-component + :initarg :dep-component) + (plan + :initarg :plan + :initform nil)) + (:report (lambda (condition stream) + (with-slots (op component dep-op dep-component plan) condition + (format stream "Computing just-done stamp ~@[in plan ~S~] for action ~S, but dependency ~S wasn't done yet!" + plan + (action-path (make-action op component)) + (action-path (make-action dep-op dep-component))))))) (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, @@ -10032,10 +10077,10 @@ initialized with SEED." (just-done ;; It's OK to lose some ASDF action stamps during self-upgrade (unless (equal "asdf" (primary-system-name dc)) - (warn "Computing just-done stamp in plan ~S for action ~S, but dependency ~S wasn't done yet!" - plan - (action-path (make-action o c)) - (action-path (make-action do dc)))) + (warn 'dependency-not-done + :plan plan + :op o :component c + :dep-op do :dep-component dc)) status) (t (return (values nil nil)))))) @@ -10682,11 +10727,9 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) ;; 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)) - (assert (equal (coerce-name s) (primary-system-name s))) (if-let ((asd (system-source-file s))) (list asd))) (defmethod perform ((o define-op) (s system)) - (assert (equal (coerce-name s) (primary-system-name s))) (nest (if-let ((pathname (first (input-files o s))))) (let ((readtable *readtable*) ;; save outer syntax tables. TODO: proper syntax-control @@ -10795,21 +10838,25 @@ Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." (defun locate-system (name) "Given a system NAME designator, try to locate where to load the system from. -Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME +Returns six values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME PREVIOUS-PRIMARY 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. -PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." +PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. +PREVIOUS-PRIMARY when not null is the primary system for the PREVIOUS system." (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 - (primary (registered-system (primary-system-name name))) - (previous-time (and previous primary (component-operation-time 'define-op primary))) + (previous-primary-name (and previous (primary-system-name previous))) + (previous-primary-system (and previous-primary-name + (registered-system previous-primary-name))) + (previous-time (and previous-primary-system + (component-operation-time 'define-op previous-primary-system))) (found (search-for-system-definition name)) (found-system (and (typep found 'system) found)) (pathname (ensure-pathname @@ -10822,37 +10869,38 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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)) - (values foundp found-system pathname previous previous-time)))) + (values foundp found-system pathname previous previous-time previous-primary-system)))) + + ;; TODO: make a prepare-define-op node for this + ;; so we can properly cache the answer rather than recompute it. + (defun definition-dependencies-up-to-date-p (system) + (check-type system system) + (or (not (primary-system-p system)) + (handler-case + (loop :with plan = (make-instance *plan-class*) + :for action :in (definition-dependency-list system) + :always (action-up-to-date-p + plan (action-operation action) (action-component action)) + :finally + (let ((o (make-operation 'define-op))) + (multiple-value-bind (stamp done-p) + (compute-action-stamp plan o system) + (return (and (timestamp<= stamp (component-operation-time o system)) + done-p))))) + (system-out-of-date () 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. - - (defun definition-dependencies-up-to-date-p (system) - (check-type system system) - (assert (primary-system-p system)) - (handler-case - (loop :with plan = (make-instance *plan-class*) - :for action :in (definition-dependency-list system) - :always (action-up-to-date-p - plan (action-operation action) (action-component action)) - :finally - (let ((o (make-operation 'define-op))) - (multiple-value-bind (stamp done-p) - (compute-action-stamp plan o system) - (return (and (timestamp<= stamp (component-operation-time o system)) - done-p))))) - (system-out-of-date () nil))) - (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))) - (multiple-value-bind (foundp found-system pathname previous previous-time) + (multiple-value-bind (foundp found-system pathname previous previous-time previous-primary) (locate-system name) (assert (eq foundp (and (or found-system pathname previous) t)))) (let ((previous-pathname (system-source-file previous)) @@ -10863,18 +10911,18 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (setf (system-source-file system) pathname)) (if-let ((stamp (get-file-stamp pathname))) (let ((up-to-date-p - (and previous + (and previous previous-primary (or (pathname-equal pathname previous-pathname) (and pathname previous-pathname (pathname-equal (physicalize-pathname pathname) (physicalize-pathname previous-pathname)))) (timestamp<= stamp previous-time) - ;; TODO: check that all dependencies are up-to-date. - ;; This necessitates traversing them without triggering - ;; the adding of nodes to the plan. - (or (not name-primary-p) - (definition-dependencies-up-to-date-p previous))))) + ;; Check that all previous definition-dependencies are up-to-date, + ;; traversing them without triggering the adding of nodes to the plan. + ;; TODO: actually have a prepare-define-op, extract its timestamp, + ;; and check that it is less than the stamp of the previous define-op ? + (definition-dependencies-up-to-date-p previous-primary)))) (unless up-to-date-p (restart-case (signal 'system-out-of-date :name name) @@ -11284,12 +11332,9 @@ system names contained using COERCE-NAME. Return the result." (in-package :asdf/bundle) (with-upgradability () - (defclass bundle-op (operation) - ;; NB: use of instance-allocated slots for operations is DEPRECATED - ;; and only supported in a temporary fashion for backward compatibility. - ;; Supported replacement: Define slots on program-system instead. - ((bundle-type :initform :no-output-file :reader bundle-type :allocation :class)) + (defclass bundle-op (operation) () (:documentation "base class for operations that bundle outputs from multiple components")) + (defgeneric bundle-type (bundle-op)) (defclass monolithic-op (operation) () (:documentation "A MONOLITHIC operation operates on a system *and all of its @@ -11330,10 +11375,11 @@ itself.")) (defclass link-op (bundle-op) () (:documentation "Abstract operation for linking files together")) - (defclass gather-operation (bundle-op) - ((gather-operation :initform nil :allocation :class :reader gather-operation) - (gather-type :initform :no-output-file :allocation :class :reader gather-type)) + (defclass gather-operation (bundle-op) () (:documentation "Abstract operation for gathering many input files from a system")) + (defgeneric gather-operation (gather-operation)) + (defmethod gather-operation ((o gather-operation)) nil) + (defgeneric gather-type (gather-operation)) (defun operation-monolithic-p (op) (typep op 'monolithic-op)) @@ -11370,11 +11416,12 @@ itself.")) `((,go ,@deps) ,@(call-next-method)))) ;; Create a single fasl for the entire library - (defclass basic-compile-bundle-op (bundle-op basic-compile-op) - ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object - :allocation :class) - (bundle-type :initform :fasb :allocation :class)) + (defclass basic-compile-bundle-op (bundle-op basic-compile-op) () (:documentation "Base class for compiling into a bundle")) + (defmethod bundle-type ((o basic-compile-bundle-op)) :fasb) + (defmethod gather-type ((o basic-compile-bundle-op)) + #-(or clasp ecl mkcl) :fasl + #+(or clasp ecl mkcl) :object) ;; Analog to prepare-op, for load-bundle-op and compile-bundle-op (defclass prepare-bundle-op (sideway-operation) @@ -11383,9 +11430,7 @@ itself.")) :allocation :class)) (:documentation "Operation class for loading the bundles of a system's dependencies")) - (defclass lib-op (link-op gather-operation non-propagating-operation) - ((gather-type :initform :object :allocation :class) - (bundle-type :initform :lib :allocation :class)) + (defclass lib-op (link-op gather-operation non-propagating-operation) () (: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. @@ -11394,6 +11439,8 @@ written in C or another language with a compiler producing linkable object files 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.")) + (defmethod bundle-type ((o lib-op)) :lib) + (defmethod gather-type ((o lib-op)) :object) ;; 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. @@ -11417,11 +11464,11 @@ faster and more resource efficient.")) ;; 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. - (defclass dll-op (link-op gather-operation non-propagating-operation) - ((gather-type :initform :object :allocation :class) - (bundle-type :initform :dll :allocation :class)) + (defclass dll-op (link-op gather-operation non-propagating-operation) () (: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.")) + (defmethod bundle-type ((o dll-op)) :dll) + (defmethod gather-type ((o dll-op)) :object) (defclass deliver-asd-op (basic-compile-op selfward-operation) ((selfward-operation @@ -11450,27 +11497,25 @@ for all the linkable object files associated with the system. Compare with LIB-O ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class)) (:documentation "Load a single fasl for the system and its dependencies.")) - (defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation) - ((gather-type :initform :object :allocation :class)) + (defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation) () (: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.")) - (defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation) - ((gather-type :initform :object :allocation :class)) + (defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation) () (: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) - ((bundle-type :initform :image :allocation :class) - (gather-operation :initform 'lib-op :allocation :class) - #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class) - (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class)) + ((selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) + (defmethod bundle-type ((o image-op)) :image) + #+(or clasp ecl mkcl) (defmethod gather-operation ((o image-op)) 'lib-op) + #+(or clasp ecl mkcl) (defmethod gather-type ((o image-op)) :static-library) - (defclass program-op (image-op) - ((bundle-type :initform :program :allocation :class)) + (defclass program-op (image-op) () (:documentation "create an executable file from the system and its dependencies")) + (defmethod bundle-type ((o program-op)) :program) ;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type. (defun bundle-pathname-type (bundle-type) @@ -11857,8 +11902,8 @@ which is probably not what you want; you probably need to tweak your output tran ;;; (with-upgradability () ;; Base classes for both regular and monolithic concatenate-source operations - (defclass basic-concatenate-source-op (bundle-op) - ((bundle-type :initform "lisp" :allocation :class))) + (defclass basic-concatenate-source-op (bundle-op) ()) + (defmethod bundle-type ((o basic-concatenate-source-op)) "lisp") (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) ()) @@ -12076,7 +12121,7 @@ otherwise return a default system name computed from PACKAGE-NAME." previous (eval `(defsystem ,system :class package-inferred-system - :source-file nil + :source-file ,(system-source-file top) :pathname ,dir :depends-on ,dependencies :around-compile ,around-compile @@ -13282,10 +13327,10 @@ system or its dependencies if it has already been loaded." :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 abcl clasp cmucl clozure ecl mkcl sbcl) - (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext - #:*module-provider-functions* - #+ecl #:*load-hooks*) + #+(or abcl clasp cmucl clozure ecl mezzano mkcl sbcl) + (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext #+mezzano :sys.int + #:*module-provider-functions* + #+ecl #:*load-hooks*) #+(or clasp mkcl) (:import-from :si #:*load-hooks*)) (in-package :asdf/footer) @@ -13299,7 +13344,7 @@ system or its dependencies if it has already been loaded." ;;;; Hook ASDF into the implementation's REQUIRE and other entry points. -#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl) +#+(or abcl clasp clisp clozure cmucl ecl mezzano mkcl sbcl) (with-upgradability () ;; Hook into CL:REQUIRE. #-clisp (pushnew 'module-provide-asdf *module-provider-functions*) @@ -13319,15 +13364,15 @@ system or its dependencies if it has already been loaded." (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)))) - (when (first results) (register-preloaded-system (coerce-name name))) - (values-list results))) + (when (first results) (register-preloaded-system (coerce-name name))) + (values-list results))) (defun wrap-module-provider-function (provider) (ensure-gethash provider *wrapped-module-provider* - (constantly - #'(lambda (module-name) - (wrap-module-provider provider module-name))))) + (constantly + #'(lambda (module-name) + (wrap-module-provider provider module-name))))) (setf *module-provider-functions* - (mapcar #'wrap-module-provider-function *module-provider-functions*)))) + (mapcar #'wrap-module-provider-function *module-provider-functions*)))) #+cmucl ;; Hook into the CMUCL herald. (with-upgradability () ===================================== src/contrib/asdf/doc/asdf.html ===================================== --- a/src/contrib/asdf/doc/asdf.html +++ b/src/contrib/asdf/doc/asdf.html @@ -277,7 +277,7 @@ ul.no-bullet {list-style: none} <a name="Top"></a> <a name="ASDF_003a-Another-System-Definition-Facility"></a> <h1 class="top">ASDF: Another System Definition Facility</h1> -<p>Manual for Version 3.3.1 +<p>Manual for Version 3.3.2 </p> <p>This manual describes ASDF, a system definition facility @@ -6047,9 +6047,10 @@ see the <samp>TODO</samp> file in the source repository. 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: - “Lisp Machine Manual”, MIT, 1981. + “Lisp Machine Manual”, 3rd Edition MIT, March 1981. The famous CHINE NUAL describes one of the earliest variants of DEFSYSTEM. - <a href="https://bitsavers.trailing-edge.com/pdf/mit/cadr/chinual_4thEd_Jul81.pdf">https://bitsavers.trailing-edge.com/pdf/mit/cadr/chinual_4thEd_Jul81.pdf</a> + (NB: Not present in the second preliminary version of January 1979) + <a href="http://bitsavers.org/pdf/mit/cadr/chinual_3rdEd_Mar81.pdf">http://bitsavers.org/pdf/mit/cadr/chinual_3rdEd_Mar81.pdf</a> </li></ul> ===================================== src/contrib/asdf/doc/asdf.info ===================================== --- a/src/contrib/asdf/doc/asdf.info +++ b/src/contrib/asdf/doc/asdf.info @@ -43,7 +43,7 @@ File: asdf.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) ASDF: Another System Definition Facility **************************************** -Manual for Version 3.3.1 +Manual for Version 3.3.2 This manual describes ASDF, a system definition facility for Common Lisp programs and libraries. @@ -5544,10 +5544,11 @@ Bibliography * 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> - * Dan Weinreb and David Moon: "Lisp Machine Manual", MIT, 1981. The - famous CHINE NUAL describes one of the earliest variants of - DEFSYSTEM. - <https://bitsavers.trailing-edge.com/pdf/mit/cadr/chinual_4thEd_Jul81.pdf> + * Dan Weinreb and David Moon: "Lisp Machine Manual", 3rd Edition MIT, + March 1981. The famous CHINE NUAL describes one of the earliest + variants of DEFSYSTEM. (NB: Not present in the second preliminary + version of January 1979) + <http://bitsavers.org/pdf/mit/cadr/chinual_3rdEd_Mar81.pdf> File: asdf.info, Node: Concept Index, Next: Function and Class Index, Prev: Bibliography, Up: Top @@ -5999,8 +6000,8 @@ Node: ASDF development FAQs252003 Node: How do I run the tests interactively in a REPL?252242 Node: Ongoing Work253809 Node: Bibliography254088 -Node: Concept Index257559 -Node: Function and Class Index264554 -Node: Variable Index276328 +Node: Concept Index257635 +Node: Function and Class Index264630 +Node: Variable Index276404 End Tag Table ===================================== src/contrib/asdf/doc/asdf.pdf ===================================== Binary files a/src/contrib/asdf/doc/asdf.pdf and b/src/contrib/asdf/doc/asdf.pdf differ ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -19,7 +19,7 @@ public domain. ## New in this release: * Known issues: * Feature enhancements - * Update to ASDF 3.3.1, fixing issues introduced in 3.3.0 + * Update to ASDF 3.3.2 * 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. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/23e31483c0524f5ddb6349d04… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/23e31483c0524f5ddb6349d04… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0