Commit 787fe6b5 authored by mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Update to ASDF 3.1.0.103.

Seems to fix loading of Ironclad, and other Quicklisp failures.
parent 2c86d39b
......@@ -246,8 +246,9 @@ we recommend you upgrade to ASDF 3
--- and we explain how to do that. @xref{Loading ASDF}.
(In the context of compatibility requirements,
ASDF 2.27, released on Feb 1st 2013, and further 2.x releases up to 2.33,
count as pre-releases of ASDF 3, and define the :asdf3 feature;
count as pre-releases of ASDF 3, and define the @code{:asdf3} feature;
still, please use the latest release).
Release ASDF 3.1.1 and later also define the @code{:asdf3.1} feature.
Also note that ASDF is not to be confused with ASDF-Install.
ASDF-Install is not part of ASDF, but a separate piece of software.
......@@ -256,6 +257,9 @@ We recommend you use Quicklisp instead,
which works great and is being actively maintained.
If you want to download software from version control instead of tarballs,
so you may more easily modify it, we recommend clbuild.
We recommend @file{~/common-lisp/}
as a place into which to install Common Lisp software;
starting with ASDF 3.1.1, it is included in the default source-registry configuration.
@node Quick start summary, Loading ASDF, Introduction, Top
@chapter Quick start summary
......@@ -276,7 +280,9 @@ Make sure ASDF can find system definitions
through proper source-registry configuration.
For more details, @xref{Configuring ASDF to find your systems}.
The simplest way is simply to put all your lisp code in subdirectories of
@file{~/.local/share/common-lisp/source/}.
@file{~/common-lisp/} (starting with ASDF 3.1.1),
or @file{~/.local/share/common-lisp/source/}
(for ASDF 2 and later, or if you want to keep source in a hidden directory).
Such code will automatically be found.
@item
......@@ -433,10 +439,12 @@ we assume you're an expert deliberately using a legacy implementation,
and are proficient enough to install this fasl.
Still, the ASDF source repository contains a script
@file{bin/install-asdf-as-module} that can help you do that.
It relies on cl-launch 4 for command-line invocation,
It relies on @file{cl-launch} 4 for command-line invocation,
which may depend on ASDF being checked out in @file{~/cl/asdf/}
if your implementation doesn't even have an ASDF 2;
but you can run the code it manually if needs be.
but if you don't have @file{cl-launch},
you can instead @code{(load "bin/install-asdf-as-module")}
from your implementation's REPL.
Finally, if your implementation only provides ASDF 2,
and you can't or won't upgrade it or override its ASDF module,
......@@ -553,7 +561,7 @@ and resetting the ASDF configuration is usually only needed in corner cases.
* Resetting the ASDF configuration::
@end menu
@node Configuring ASDF to find your systems, Configuring where ASDF stores object files, Configuring ASDF, Configuring ASDF
@node Configuring ASDF to find your systems, Configuring ASDF to find your systems --- old style, Configuring ASDF, Configuring ASDF
@section Configuring ASDF to find your systems
In order to compile and load your systems, ASDF must be configured to find
......@@ -566,9 +574,11 @@ ASDF, starting from easiest to the most complex:
@item
Put all of your systems in subdirectories of
@file{~/common-lisp/} or
@file{~/.local/share/common-lisp/source/}.
If you install software there (it can be a symlink),
you don't need further configuration.
If you install software there, you don't need further configuration.
(NB: @file{~/common-lisp/} is only included in the default configuration
starting with ASDF 3.1.1 or later)
@item
If you're using some tool to install software (e.g. Quicklisp),
......@@ -615,16 +625,6 @@ If necessary, you can reset the source-registry configuration with:
(asdf:clear-source-registry)
@end lisp
@c FIXME: too specific. Push this down to discussion of dumping an
@c image?
@c And you probably should do so before you dump your Lisp image,
@c if the configuration may change
@c between the machine where you save it at the time you save it
@c and the machine you resume it at the time you resume it.
@c Actually, you should use @code{(asdf:clear-configuration)}
@c before you dump your Lisp image, which includes the above.
@item
In earlier versions of ASDF, the system source registry was configured
using a global variable, @code{asdf:*central-registry*}.
......@@ -731,7 +731,7 @@ but it is supported for old users, and for users who want to programmatically
control what directories are added to the ASDF search path.
@node Configuring where ASDF stores object files, , Configuring ASDF to find your systems, Configuring ASDF
@node Configuring where ASDF stores object files, Resetting the ASDF configuration, Configuring ASDF to find your systems --- old style, Configuring ASDF
@section Configuring where ASDF stores object files
@findex clear-output-translations
......@@ -828,19 +828,15 @@ For that you may use the following function:
regarding source-registry or output-translations.
@end defun
If you use SBCL, CMUCL or SCL, you may use this snippet
so that the ASDF configuration be cleared automatically as you dump an image:
@example
#+(or cmu sbcl scl)
(pushnew 'clear-configuration
#+(or cmu scl) ext:*before-save-initializations*
#+sbcl sb-ext:*save-hooks*)
@end example
For compatibility with all Lisp implementations, however,
you might want instead your build script to explicitly call
@code{(asdf:clear-configuration)} at an appropriate moment before dumping.
This function is pushed onto the @code{uiop:*image-dump-hook*} by default,
which means that if you save an image using @code{uiop:dump-image},
or via @code{asdf:image-op} and @code{asdf:program-op},
it will be automatically called to clear your configuration.
If for some reason you prefer to call your implementation's underlying functionality,
be sure to call @code{clear-configuration} manually,
or push it into your implementation's equivalent of @code{uiop:*image-dump-hook*},
e.g. @code{sb-ext:*save-hooks*} on SBCL, or @code{ext:*before-save-initializations*}
on CMUCL and SCL, etc.
@node Using ASDF, Defining systems with defsystem, Configuring ASDF, Top
@chapter Using ASDF
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.0.94: Another System Definition Facility.
;;; This is ASDF 3.1.0.103: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -867,7 +867,7 @@ UNINTERN -- Remove symbols here from PACKAGE."
 
;;;; Early meta-level tweaks
 
#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks sbcl scl)
#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl)
(eval-when (:load-toplevel :compile-toplevel :execute)
;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode
;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie.
......@@ -1349,34 +1349,6 @@ the two results passed to STRCAT always reconstitute the original string"
(when x (c +crlf+) (c +lf+) (c +cr+) (values x nil)))))
 
 
;;; CLOS
(with-upgradability ()
(defun coerce-class (class &key (package :cl) (super t) (error 'error))
"Coerce CLASS to a class that is subclass of SUPER if specified,
or invoke ERROR handler as per CALL-FUNCTION.
A keyword designates the name a symbol, which when found in PACKAGE, designates a class.
A string is read as a symbol while in PACKAGE, the symbol designates a class.
A class object designates itself.
NIL designates itself (no class).
A symbol otherwise designates a class by name."
(let* ((normalized
(typecase class
(keyword (find-symbol* class package nil))
(string (symbol-call :uiop :safe-read-from-string class :package package))
(t class)))
(found
(etypecase normalized
((or standard-class built-in-class) normalized)
((or null keyword) nil)
(symbol (find-class normalized nil nil)))))
(or (and found
(or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
found)
(call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
(deftype stamp () '(or real boolean)))
......@@ -1475,6 +1447,36 @@ When CALL-NOW-P is true, also call the function immediately."
(when call-now-p (call-function hook))))
 
 
;;; CLOS
(with-upgradability ()
(defun coerce-class (class &key (package :cl) (super t) (error 'error))
"Coerce CLASS to a class that is subclass of SUPER if specified,
or invoke ERROR handler as per CALL-FUNCTION.
A keyword designates the name a symbol, which when found in either PACKAGE, designates a class.
-- for backward compatibility, *PACKAGE* is also accepted for now, but this may go in the future.
A string is read as a symbol while in PACKAGE, the symbol designates a class.
A class object designates itself.
NIL designates itself (no class).
A symbol otherwise designates a class by name."
(let* ((normalized
(typecase class
(keyword (or (find-symbol* class package nil)
(find-symbol* class *package* nil)))
(string (symbol-call :uiop :safe-read-from-string class :package package))
(t class)))
(found
(etypecase normalized
((or standard-class built-in-class) normalized)
((or null keyword) nil)
(symbol (find-class normalized nil nil)))))
(or (and found
(or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
found)
(call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
;;; Hash-tables
(with-upgradability ()
(defun ensure-gethash (key table default)
......@@ -1564,10 +1566,10 @@ with later being determined by a lexicographical comparison of minor numbers."
#+clisp 'system::$format-control
#+clozure 'ccl::format-control
#+(or cmu scl) 'conditions::format-control
#+ecl 'si::format-control
#+(or ecl mkcl) 'si::format-control
#+(or gcl lispworks) 'conditions::format-string
#+sbcl 'sb-kernel:format-control
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl) nil
"Name of the slot for FORMAT-CONTROL in simple-condition")
 
(defun match-condition-p (x condition)
......@@ -1651,7 +1653,7 @@ keywords explicitly."
(defun os-windows-p ()
"Is the underlying operating system Microsoft Windows?"
(or #+abcl (featurep :windows)
#+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32)) t))
#+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32 mingw64)) t))
 
(defun os-genera-p ()
"Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?"
......@@ -2060,8 +2062,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; See CLHS make-pathname and 19.2.2.2.3.
;; This will be :unspecific if supported, or NIL if not.
(defparameter *unspecific-pathname-type*
#+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl) :unspecific
#+(or clisp ecl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil
#+(or abcl allegro clozure cmu genera lispworks sbcl scl) :unspecific
#+(or clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil
"Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
 
(defun make-pathname* (&rest keys &key (directory nil)
......@@ -2159,8 +2161,9 @@ when merging, making or parsing pathnames"
;; But CMUCL decides to die on NIL.
;; MCL has issues with make-pathname, nil and defaulting
(declare (ignorable defaults))
#.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil
:host (or #+cmu lisp::*unix-host*)
#.`(make-pathname* :directory nil :name nil :type nil :version nil
:device (or #+(and mkcl unix) :unspecific)
:host (or #+cmu lisp::*unix-host* #+(and mkcl unix) "localhost")
#+scl ,@'(:scheme nil :scheme-specific-part nil
:username nil :password nil :parameters nil :query nil :fragment nil)
;; the default shouldn't matter, but we really want something physical
......@@ -2193,11 +2196,11 @@ when merging, making or parsing pathnames"
(or (and (null p1) (null p2))
(and (pathnamep p1) (pathnamep p2)
(and (=? pathname-host)
(=? pathname-device)
#-(and mkcl unix) (=? pathname-device)
(=? normalize-pathname-directory-component pathname-directory)
(=? pathname-name)
(=? pathname-type)
(=? pathname-version)))))))
#-mkcl (=? pathname-version)))))))
 
(defun absolute-pathname-p (pathspec)
"If PATHSPEC is a pathname or namestring object that parses as a pathname
......@@ -3299,7 +3302,7 @@ in an atomic way if the implementation allows."
`(,dd directory-pathname) ;; requires SBCL 1.0.44 or later
`(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
#+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
#-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl xcl)
#-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks mkcl sbcl scl xcl)
(error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera
 
(defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error))
......@@ -4004,7 +4007,7 @@ Upon success, the KEEP form is evaluated and the file is is deleted unless it ev
,@(when directory `(:directory ,directory))
,@(when prefix `(:prefix ,prefix))
,@(when suffix `(:suffix ,suffix))
,@(when type `(:suffix ,type))
,@(when type `(:type ,type))
,@(when keep `(:keep ,keep))
,@(when after `(:after `#',afterf))
,@(when element-type `(:element-type ,element-type))
......@@ -4163,7 +4166,7 @@ This is designed to abstract away the implementation specific quit forms."
(let ((debug:*debug-print-level* *print-level*)
(debug:*debug-print-length* *print-length*))
(debug:backtrace (or count most-positive-fixnum) stream))
#+ecl
#+(or ecl mkcl)
(let* ((top (si:ihs-top))
(repeats (if count (min top count) top))
(backtrace (loop :for ihs :from 0 :below top
......@@ -4278,9 +4281,10 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+gcl si:*command-args*
#+(or genera mcl) 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 clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl)
#-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "raw-command-line-arguments not implemented yet"))
 
(defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
......@@ -4308,10 +4312,10 @@ return a string that for the name with which the program was invoked, i.e. argv[
Otherwise, return NIL."
(cond
((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !
;; NB: not currently available on ABCL, Corman, Genera, MCL, MKCL
;; NB: not currently available on ABCL, Corman, Genera, MCL
(or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)
(first (raw-command-line-arguments))
#+ecl (si:argv 0)))
#+ecl (si:argv 0) #+mkcl (mkcl:argv 0)))
(t ;; argv[0] is the name of the interpreter.
;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8.
(getenvp "__CL_ARGV0"))))
......@@ -4460,18 +4464,19 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
'dump-image filename (nth-value 1 (implementation-type))))
 
(defun create-image (destination object-files
&key kind output-name prologue-code epilogue-code
(defun create-image (destination lisp-object-files
&key kind output-name prologue-code epilogue-code extra-object-files
(prelude () preludep) (postlude () postludep)
(entry-point () entry-point-p) build-args)
(declare (ignorable destination object-files kind output-name prologue-code epilogue-code
prelude preludep postlude postludep entry-point entry-point-p build-args))
(declare (ignorable destination lisp-object-files extra-object-files kind output-name
prologue-code epilogue-code prelude preludep postlude postludep
entry-point entry-point-p build-args))
"On ECL, create an executable at pathname DESTINATION from the specified OBJECT-FILES and options"
;; Is it meaningful to run these in the current environment?
;; only if we also track the object files that constitute the "current" image,
;; and otherwise simulate dump-image, including quitting at the end.
#-ecl (error "~S not implemented for your implementation (yet)" 'create-image)
#+ecl
#-(or ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image)
#+(or ecl mkcl)
(let ((epilogue-forms
(append
(when epilogue-code `(,epilogue-code))
......@@ -4482,20 +4487,26 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
((:image)
(setf kind :program) ;; to ECL, it's just another program.
`((setf *image-dumped-p* t)
;; fall through should be equivalent to: (si::top-level t) (quit)
))
(si::top-level #+ecl t) (quit)))
((:program)
`((setf *image-dumped-p* :executable)
(shell-boolean-exit
(restore-image))))))))
(check-type kind (member :dll :lib :static-library :program :object :fasl :program))
(apply 'c::builder
kind (pathname destination)
:lisp-files object-files
:init-name (c::compute-init-name (or output-name destination) :kind kind)
:prologue-code prologue-code
:epilogue-code (when epilogue-forms `(progn ,@epilogue-forms))
build-args))))
#+ecl (check-type kind (member :dll :lib :static-library :program :object :fasl))
(apply #+ecl 'c::builder #+ecl kind
#+mkcl (ecase kind
((:dll) 'compiler::build-shared-library)
((:lib :static-library) 'compiler::build-static-library)
((:fasl) 'compiler::build-bundle)
((:program) 'compiler::build-program))
(pathname destination)
#+ecl :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+ecl extra-object-files)
#+ecl :init-name #+ecl (c::compute-init-name (or output-name destination) :kind kind)
(append
(when prologue-code `(:prologue-code ,prologue-code))
(when epilogue-forms `(:epilogue-code (progn ,@epilogue-forms)))
#+mkcl (when extra-object-files `(:object-files ,extra-object-files))
build-args)))))
 
 
;;; Some universal image restore hooks
......@@ -4847,6 +4858,7 @@ for the implementation's underlying run-program function"
#+os-unix (list command)
#+os-windows
(string
#+mkcl (list "cmd" '#:/c command)
;; NB: We do NOT add cmd /c here. You might want to.
#+(or allegro clisp) command
;; On ClozureCL for Windows, we assume you are using
......@@ -4856,7 +4868,7 @@ for the implementation's underlying run-program function"
;; NB: On other Windows implementations, this is utterly bogus
;; except in the most trivial cases where no quoting is needed.
;; Use at your own risk.
#-(or allegro clisp clozure) (list "cmd" "/c" command))
#-(or allegro clisp clozure mkcl) (list "cmd" "/c" command))
#+os-windows
(list
#+allegro (escape-windows-command command)
......@@ -4883,8 +4895,8 @@ argument to pass to the internal RUN-PROGRAM"
((eql :interactive)
#+allegro nil
#+clisp :terminal
#+(or clozure cmu ecl sbcl scl) t)
#+(or allegro clozure cmu ecl lispworks sbcl scl)
#+(or clozure cmu ecl mkcl sbcl scl) t)
#+(or allegro clozure cmu ecl lispworks mkcl sbcl scl)
((eql :output)
(if (eq role :error-output)
:output
......@@ -4915,12 +4927,12 @@ to be normalized by %NORMALIZE-IO-SPECIFIER.
It returns a process-info plist with possible keys:
PROCESS, EXIT-CODE, INPUT-STREAM, OUTPUT-STREAM, BIDIR-STREAM, ERROR-STREAM."
;; NB: these implementations have unix vs windows set at compile-time.
(declare (ignorable if-input-does-not-exist if-output-exists if-error-output-exists))
(declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists))
(assert (not (and wait (member :stream (list input output error-output)))))
#-(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl)
#-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl)
(progn command keys directory
(error "run-program not available"))
#+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl)
#+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl)
(let* ((%command (%normalize-command command))
(%input (%normalize-io-specifier input :input))
(%output (%normalize-io-specifier output :output))
......@@ -4940,7 +4952,7 @@ It returns a process-info plist with possible keys:
#+os-windows :show-window #+os-windows (if interactive nil :hide)
:allow-other-keys t keys))
#-allegro
(with-current-directory (#-sbcl directory)
(with-current-directory (#-(or sbcl mkcl) directory)
#+clisp
(flet ((run (f x &rest args)
(multiple-value-list
......@@ -4952,11 +4964,11 @@ It returns a process-info plist with possible keys:
#+os-windows (string (run 'ext:run-shell-command %command))
(list (run 'ext:run-program (car %command)
:arguments (cdr %command)))))
#+(or clozure cmu ecl sbcl scl)
(#-ecl progn #+ecl multiple-value-list
#+(or clozure cmu ecl mkcl sbcl scl)
(#-(or ecl mkcl) progn #+(or ecl mkcl) multiple-value-list
(apply
'#+(or cmu ecl scl) ext:run-program
#+clozure ccl:run-program #+sbcl sb-ext:run-program
#+clozure ccl:run-program #+sbcl sb-ext:run-program #+mkcl mk-ext:run-program
(car %command) (cdr %command)
:input %input
:output %output
......@@ -4964,7 +4976,7 @@ It returns a process-info plist with possible keys:
:wait wait
:allow-other-keys t
(append
#+(or clozure cmu sbcl scl)
#+(or clozure cmu mkcl sbcl scl)
`(:if-input-does-not-exist ,if-input-does-not-exist
:if-output-exists ,if-output-exists
:if-error-exists ,if-error-output-exists)
......@@ -5031,8 +5043,8 @@ It returns a process-info plist with possible keys:
#+clozure (ccl:external-process-error-stream process*)
#+(or cmu scl) (ext:process-error process*)
#+sbcl (sb-ext:process-error process*))))
#+ecl
(destructuring-bind (stream code process) process*
#+(or ecl mkcl)
(destructuring-bind #+ecl (stream code process) #+mkcl (stream process code) process*
(let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
(cond
((zerop mode))
......@@ -5059,8 +5071,9 @@ It returns a process-info plist with possible keys:
#+clozure (ccl::external-process-pid process)
#+ecl (si:external-process-pid process)
#+(or cmu scl) (ext:process-pid process)
#+mkcl (mkcl:process-id process)
#+sbcl (sb-ext:process-pid process)
#-(or allegro cmu sbcl scl) (error "~S not implemented" '%process-info-pid)))
#-(or allegro cmu mkcl sbcl scl) (error "~S not implemented" '%process-info-pid)))
 
(defun %wait-process-result (process-info)
(or (getf process-info :exit-code)
......@@ -5084,7 +5097,8 @@ It returns a process-info plist with possible keys:
(system:pipe-exit-status stream :wait t)
(if-let ((f (find-symbol* :pid-exit-status :system nil)))
(funcall f process :wait t)))
#+sbcl (sb-ext:process-exit-code process)))))
#+sbcl (sb-ext:process-exit-code process)
#+mkcl (mkcl:join-process process)))))
 
(defun %check-result (exit-code &key command process ignore-error-status)
(unless ignore-error-status
......@@ -5184,7 +5198,7 @@ It returns a process-info plist with possible keys:
(defun %use-run-program (command &rest keys
&key input output error-output ignore-error-status &allow-other-keys)
;; helper for RUN-PROGRAM when using %run-program
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl)
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl)
(progn
command keys input output error-output ignore-error-status ;; ignore
(error "Not implemented on this platform"))
......@@ -5294,11 +5308,7 @@ It returns a process-info plist with possible keys:
(ext:system %command))
#+gcl (system:system %command)
#+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
#+mkcl ;; PROBABLY BOGUS -- ask jcb
(multiple-value-bind (io process exit-code)
(mkcl:run-program #+windows %command #+windows ()
#-windows "/bin/sh" #-windows (list "-c" %command)
:input t :output t))
#+mkcl (mkcl:system %command)
#+xcl (system:%run-shell-command %command))))
 
(defun %use-system (command &rest keys
......@@ -5377,7 +5387,7 @@ RUN-PROGRAM returns 3 values:
2- either 0 if the subprocess exited with success status,
or an indication of failure via the EXIT-CODE of the process"
(declare (ignorable ignore-error-status))
#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl)
#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
(error "RUN-PROGRAM not implemented for this Lisp")
(flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive))))
(apply (if (or force-shell
......@@ -5385,7 +5395,7 @@ or an indication of failure via the EXIT-CODE of the process"
#+clisp (eq error-output :interactive)
#+(or abcl clisp) (eq :error-output :output)
#+(and lispworks os-unix) (%interactivep input output error-output)
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) t)
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
'%use-system '%use-run-program)
command
:input (default input inputp output)
......@@ -5459,16 +5469,17 @@ This can help you produce more deterministic output for FASLs."))
"Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS")
(defun get-optimization-settings ()
"Get current compiler optimization settings, ready to PROCLAIM again"
#-(or clisp clozure cmu ecl sbcl scl)
#-(or clisp clozure cmu ecl mkcl sbcl scl)
(warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type))
#+clozure (ccl:declaration-information 'optimize nil)
#+(or clisp cmu ecl sbcl scl)
#+(or clisp cmu ecl mkcl sbcl scl)
(let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
#.`(loop :for x :in settings
,@(or #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*))
#+mkcl '(:for v :in '(si::*speed* si::*space* si::*safety* si::*debug*))
#+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity)))
:for y = (or #+clisp (gethash x system::*optimize*)
#+(or ecl) (symbol-value v)
#+(or ecl mkcl) (symbol-value v)
#+(or cmu scl) (funcall f c::*default-cookie*)
#+sbcl (cdr (assoc x sb-c::*policy*)))
:when y :collect (list x y))))
......@@ -6523,6 +6534,8 @@ directive.")
:uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image
:uiop/run-program :uiop/lisp-build
:uiop/configuration :uiop/backward-driver))
#+mkcl (provide :uiop)
;;;; -------------------------------------------------------------------------
;;;; Handle upgrade as forward- and backward-compatibly as possible
;; See https://bugs.launchpad.net/asdf/+bug/485687
......@@ -6559,15 +6572,6 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(defvar *asdf-version* nil)
;; We need to clear systems from versions yet older than the below:
(defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component.
(defmacro defparameter* (var value &optional docstring)
(let* ((name (string-trim "*" var))
(valfun (intern (format nil "%~A-~A-~A" :compute name :value)))
(clearfun (intern (format nil "%~A-~A" :clear name))))
`(progn
(defun ,valfun () ,value)
(defvar ,var (,valfun) ,@(ensure-list docstring))
(defun ,clearfun () (setf ,var (,valfun)))
(register-hook-function '*post-upgrade-cleanup-hook* ',clearfun))))
(defvar *verbose-out* nil)
(defun asdf-message (format-string &rest format-args)
(when *verbose-out* (apply 'format *verbose-out* format-string format-args)))
......@@ -6576,6 +6580,14 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(defun upgrading-p (&optional (oldest-compatible-version *oldest-forward-compatible-asdf-version*))
(and *previous-asdf-versions*
(version< (first *previous-asdf-versions*) oldest-compatible-version)))
(defmacro defparameter* (var value &optional docstring (version *oldest-forward-compatible-asdf-version*))
(let* ((name (string-trim "*" var))
(valfun (intern (format nil "%~A-~A-~A" :compute name :value))))
`(progn
(defun ,valfun () ,value)
(defvar ,var (,valfun) ,@(ensure-list docstring))
(when (upgrading-p ,version)
(setf ,var (,valfun))))))
(defmacro when-upgrading ((&key (version *oldest-forward-compatible-asdf-version*)
(upgrading-p `(upgrading-p ,version)) when) &body body)
"A wrapper macro for code that should only be run when upgrading a
......@@ -6593,7 +6605,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.1.0.94")
(asdf-version "3.1.0.103")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......@@ -7093,7 +7105,8 @@ in which the system specification (.asd file) is located."
(uiop/package:define-package :asdf/cache
(:use :uiop/common-lisp :uiop :asdf/upgrade)
(:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
#:consult-asdf-cache #:do-asdf-cache #:normalize-namestring
#:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache
#:do-asdf-cache #:normalize-namestring
#:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
(in-package :asdf/cache)
 
......@@ -7111,6 +7124,10 @@ in which the system specification (.asd file) is located."
(setf (gethash key *asdf-cache*) value-list)
value-list)))
 
(defun unset-asdf-cache-entry (key)
(when *asdf-cache*
(remhash key *asdf-cache*)))
(defun consult-asdf-cache (key &optional thunk)
(if *asdf-cache*
(multiple-value-bind (results foundp) (gethash key *asdf-cache*)
......@@ -7122,14 +7139,15 @@ in which the system specification (.asd file) is located."
(defmacro do-asdf-cache (key &body body)
`(consult-asdf-cache ,key #'(lambda () ,@body)))
 
(defun call-with-asdf-cache (thunk &key override)
(if (and *asdf-cache* (not override))
(funcall thunk)
(let ((*asdf-cache* (make-hash-table :test 'equal)))
(funcall thunk))))
(defun call-with-asdf-cache (thunk &key override key)
(let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk)))
(if (and *asdf-cache* (not override))
(funcall fun)
(let ((*asdf-cache* (make-hash-table :test 'equal)))
(funcall fun)))))
 
(defmacro with-asdf-cache ((&key override) &body body)
`(call-with-asdf-cache #'(lambda () ,@body) :override ,override))
(defmacro with-asdf-cache ((&key key override) &body body)
`(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key))
 
(defun normalize-namestring (pathname)
(let ((resolved (resolve-symlinks*
......@@ -7158,21 +7176,21 @@ in which the system specification (.asd file) is located."
(uiop/package:define-package :asdf/find-system
(:recycle :asdf/find-system :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade
:asdf/component :asdf/system :asdf/cache)
:asdf/cache :asdf/component :asdf/system)
(:export
#:remove-entry-from-registry #:coerce-entry-to-directory
#:coerce-name #:primary-system-name #:coerce-filename
#:find-system #:locate-system #:load-asd #:with-system-definitions
#:find-system #:locate-system #:load-asd
#:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems
#:missing-component #:missing-requires #:missing-parent
#:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error
#:load-system-definition-error #:error-name #:error-pathname #:error-condition
#:*system-definition-search-functions* #:search-for-system-definition
#:*central-registry* #:probe-asd #:sysdef-central-registry-search
#:find-system-if-being-defined #:*systems-being-defined*
#:find-system-if-being-defined
#:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed
#:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems*
#:clear-defined-systems #:*defined-systems*
#:clear-defined-system #:clear-defined-systems #:*defined-systems*
#:*immutable-systems*
;; defined in source-registry, but specially mentioned here:
#:initialize-source-registry #:sysdef-source-registry-search))
......@@ -7243,15 +7261,18 @@ of which is a system object.")
(get-file-stamp file))
system)))))
 
(defun clear-defined-system (system)