Commit 4673c683 authored by Robert Goldman's avatar Robert Goldman

Merge branch 'master' of common-lisp.net:asdf/asdf

* 'master' of common-lisp.net:asdf/asdf:
  Remove some ASDF 2 driver functions.
  Get rid of remnant ASDF 2 backward-compatibility
  Don't individually invalidate functions
  Bump version to 3.1.6.2
  Fix make wc.
  Stop supporting old asdf/foo aliases for uiop.
  Use #+cmucl instead of #+cmu
  Move all code out of header.lisp
  Include 3.1.5 and 3.1.6 in default upgrade tags.
  bundle: drop support for abcl < 1.3.0 (2014-03-14)
  Fix typo in Makefile for upgrade methods
parents 18316a11 039494bc
......@@ -62,4 +62,4 @@ build_asdf build/asdf.lisp: force
.PHONY: archive build-asdf bump bump-version check-all-results check-all-scripts-results check-all-upgrade-results clean debian-package doc ext-clear ext-init ext-reset ext-update extract extract-all-tagged-asdf extract-tagged-asdf fix-local-git-tags fix-remote-git-tags git-all-committed-p help install install-asdf link-archive load make-and-publish-archive make-archive makefile-targets merge-master-into-release publish-archive publish-debian-package push re show-commands t test test-all test-all-clean-load test-all-no-stop test-all-no-upgrade test-all-no-upgrade-no-stop test-all-scripts test-all-scripts-no-stop test-all-upgrade test-all-upgrade-no-stop test-ascii test-basic test-clean-load test-load-systems test-scripts test-upgrade u wc website
archive build-asdf bump bump-version check-all-results check-all-scripts-results check-all-upgrade-results clean debian-package doc ext-clear ext-init ext-reset ext-update extract extract-all-tagged-asdf extract-tagged-asdf fix-local-git-tags fix-remote-git-tags git-all-committed-p help install install-asdf link-archive load make-and-publish-archive make-archive makefile-targets merge-master-into-release publish-archive publish-debian-package push re show-commands t test test-all test-all-clean-load test-all-no-stop test-all-no-upgrade test-all-no-upgrade-no-stop test-all-scripts test-all-scripts-no-stop test-all-upgrade test-all-upgrade-no-stop test-ascii test-basic test-clean-load test-load-systems test-scripts test-upgrade u wc website: force
${MAKE_SCRIPT} l='$l' L='$L' u='$u' U='$u' v='$v' s='$s' t='$t' $@
${MAKE_SCRIPT} l='$l' L='$L' u='$u' U='$U' v='$v' s='$s' t='$t' $@
......@@ -292,6 +292,8 @@ so these would have to be fixed first.
And that's why I didn't do it.
It looks like SWANK can be fixed soon, though, so we'll see.
* Hunt systems that use obsolete APIs
* Get rid of component-properties
** directly use component-properties:
*** yaclml.asd => misguided :features for version comparison
......
......@@ -75,7 +75,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "3.1.6.1" ;; to be automatically updated by make bump-version
:version "3.1.6.2" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #+asdf3.1 package-inferred-system #-asdf3.1 system
......
......@@ -4,24 +4,6 @@
(uiop/package:define-package :asdf/backward-internals
(:recycle :asdf/backward-internals :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)
(:export ;; for internal use
#:make-sub-operation
#:load-sysdef #:make-temporary-package))
(:export))
(in-package :asdf/backward-internals)
(when-upgrading (:when (fboundp 'make-sub-operation))
(defun make-sub-operation (c o dep-c dep-o)
(declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
;;;; load-sysdef
(with-upgradability ()
(defun load-sysdef (name pathname)
(load-asd pathname :name name))
(defun make-temporary-package ()
;; For loading a .asd file, we don't make a temporary package anymore,
;; but use ASDF-USER. I'd like to have this function do this,
;; but since whoever uses it is likely to delete-package the result afterwards,
;; this would be a bad idea, so preserve the old behavior.
(make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf))))
......@@ -576,13 +576,3 @@ for all the linkable object files associated with the system or its dependencies
:extra-object-files (or (extra-object-files o) (when programp (extra-object-files c)))
:no-uiop (no-uiop c)
(when programp `(:entry-point ,(component-entry-point c))))))))
#+(and (not asdf-use-unsafe-mac-bundle-op)
(or (and clasp ecl darwin)
(and abcl darwin (not abcl-bundle-op-supported))))
(defmethod perform :before ((o basic-compile-bundle-op) (c component))
(unless (featurep :asdf-use-unsafe-mac-bundle-op)
(cerror "Continue after modifying *FEATURES*."
"BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~
To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~
Please report to ASDF-DEVEL if this works for you.")))
......@@ -74,7 +74,7 @@ another pathname in a degenerate way."))
;; condition objects, which in turn does inheritance of :report options at
;; run-time. fortunately, inheritance means we only need this kludge here in
;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.]
#+cmu (:report print-object))
#+cmucl (:report print-object))
(define-condition duplicate-names (system-definition-error)
((name :initarg :name :reader duplicate-names-name))
......
......@@ -65,7 +65,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@titlepage
@title ASDF: Another System Definition Facility
@subtitle Manual for Version 3.1.6.1
@subtitle Manual for Version 3.1.6.2
@c The following two commands start the copyright page.
@page
@vskip 0pt plus 1filll
......@@ -82,7 +82,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@node Top, Introduction, (dir), (dir)
@top ASDF: Another System Definition Facility
@ifnottex
Manual for Version 3.1.6.1
Manual for Version 3.1.6.2
@end ifnottex
......
......@@ -8,12 +8,12 @@
(in-package :asdf/footer)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+(or abcl clasp clisp clozure cmu ecl mkcl sbcl)
#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl)
(with-upgradability ()
(if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil)))
(eval `(pushnew 'module-provide-asdf
#+abcl sys::*module-provider-functions*
#+(or clasp cmu ecl) ext:*module-provider-functions*
#+(or clasp cmucl ecl) ext:*module-provider-functions*
#+clisp ,x
#+clozure ccl:*module-provider-functions*
#+mkcl mk-ext:*module-provider-functions*
......@@ -37,7 +37,7 @@
(and (first l) (register-preloaded-system (coerce-name name)))
(values-list l))))))))
#+cmu ;; Hook into the CMUCL herald.
#+cmucl ;; Hook into the CMUCL herald.
(with-upgradability ()
(defun herald-asdf (stream)
(format stream " ASDF ~A" (asdf-version)))
......
;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.6.1: Another System Definition Facility.
;;; This is ASDF 3.1.6.2: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -46,40 +46,3 @@
;;; we can't use defsystem to compile it. Hence, all in one file.
#+xcvb (module ())
(in-package :cl-user)
#+cmu
(eval-when (:load-toplevel :compile-toplevel :execute)
(setf ext:*gc-verbose* nil))
;;; pre 1.3.0 ABCL versions do not support the bundle-op on Mac OS X
#+abcl
(eval-when (:load-toplevel :compile-toplevel :execute)
(unless (and (member :darwin *features*)
(second (third (sys::arglist 'directory))))
(push :abcl-bundle-op-supported *features*)))
;; Punt on hard package upgrade: from ASDF1 always, and even from ASDF2 on most implementations.
(eval-when (:load-toplevel :compile-toplevel :execute)
(unless (member :asdf3 *features*)
(let* ((existing-version
(when (find-package :asdf)
(or (symbol-value (find-symbol (string :*asdf-version*) :asdf))
(let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf))))
(etypecase ver
(string ver)
(cons (format nil "~{~D~^.~}" ver))
(null "1.0"))))))
(first-dot (when existing-version (position #\. existing-version)))
(second-dot (when first-dot (position #\. existing-version :start (1+ first-dot))))
(existing-major-minor (subseq existing-version 0 second-dot))
(existing-version-number (and existing-version (read-from-string existing-major-minor)))
(away (format nil "~A-~A" :asdf existing-version)))
(when (and existing-version
(< existing-version-number
#+(or allegro clisp lispworks sbcl) 2.0
#-(or allegro clisp lispworks sbcl) 2.27))
(rename-package :asdf away)
(when *load-verbose*
(format t "~&; Renamed old ~A package away to ~A~%" :asdf away))))))
......@@ -180,7 +180,7 @@ after having found a .asd file? True by default.")
#+(or clasp ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory)))
:inherit-configuration
#+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
#+cmu (:tree #p"modules:")
#+cmucl (:tree #p"modules:")
#+scl (:tree #p"file://modules/")))
(defun default-user-source-registry ()
`(:source-registry
......
......@@ -22,12 +22,13 @@
(with-asdf-dir ()
(flet ((lisp-only (x) (remove "lisp" x :test-not 'equal :key 'pathname-type)))
(let ((uiop-files (mapcar #'(lambda (x) (subpathname "uiop/" x)) (lisp-only (uiop-files))))
(defsystem-files (lisp-only (asdf-defsystem-files))))
(defsystem-files (remove "build/asdf.lisp"
(lisp-only (asdf-defsystem-files)) :test 'equal)))
(run* `(pipe (wc ,@uiop-files) (sort -n)))
(terpri)
(run* `(pipe (wc header.lisp ,@defsystem-files) (sort -n)))
(run* `(pipe (wc ,@defsystem-files) (sort -n)))
(terpri)
(run* `(pipe (wc header.lisp ,@uiop-files ,@defsystem-files) (tail -n 1)))))))
(run* `(pipe (wc ,@uiop-files ,@defsystem-files) (tail -n 1)))))))
;;; debug the source registry that is being used to execute these tools.
......
......@@ -10,6 +10,8 @@
;; The 3.1 series provides the asdf3.1 feature, meaning users can rely on
;; all the stabilization work done in 3.0 so far, plus extra developments
;; in UIOP, package-inferred-system, and more robustification.
"3.1.6" ;; (2015-10-17) more bug fixes
"3.1.5" ;; (2015-07-21) more bug fixes
"3.1.4" ;; (2014-10-09) more bug fixes, source-registry cache
"3.1.3" ;; (2014-07-24) a bug fix release for 3.1.2
"3.1.2" ;; (2014-05-06) the first ASDF 3.1 release
......@@ -170,4 +172,3 @@ Use the preferred lisp implementation"
(return (success))))))
(defalias u test-upgrade)
......@@ -2,14 +2,11 @@
;;; Hacks for backward-compatibility of the driver
(uiop/package:define-package :uiop/backward-driver
(:nicknames :asdf/backward-driver)
(:recycle :uiop/backward-driver :asdf/backward-driver :asdf)
(:use :uiop/common-lisp :uiop/package :uiop/utility
:uiop/pathname :uiop/stream :uiop/os :uiop/image
:uiop/run-program :uiop/lisp-build :uiop/configuration)
(:export
#:coerce-pathname #:component-name-to-pathname-components
#+(or clasp ecl mkcl) #:compile-file-keeping-object
#:coerce-pathname
#:user-configuration-directories #:system-configuration-directories
#:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory
))
......@@ -20,27 +17,11 @@
(with-upgradability ()
(defun coerce-pathname (name &key type defaults)
;; For backward-compatibility only, for people using internals
;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb
;; Will be removed after 2014-01-16.
;; Reported users in quicklisp 2015-11: hu.dwim.asdf (removed in next release)
;; Will be removed after 2015-12.
;;(warn "Please don't use ASDF::COERCE-PATHNAME. Use ASDF/PATHNAME:PARSE-UNIX-NAMESTRING.")
(parse-unix-namestring name :type type :defaults defaults))
(defun component-name-to-pathname-components (unix-style-namestring
&key force-directory force-relative)
;; Will be removed after 2014-01-16.
;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS")
(multiple-value-bind (relabs path filename file-only)
(split-unix-namestring-directory-components
unix-style-namestring :ensure-directory force-directory)
(declare (ignore file-only))
(when (and force-relative (not (eq relabs :relative)))
(error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>")
unix-style-namestring))
(values relabs path filename)))
#+(or clasp ecl mkcl)
(defun compile-file-keeping-object (&rest args) (apply #'compile-file* args))
;; Backward compatibility for ASDF 2.27 to 3.1.4
(defun user-configuration-directories ()
"Return the current user's list of user configuration directories
......
......@@ -7,10 +7,9 @@
;;; from this package only common-lisp symbols are exported.
(uiop/package:define-package :uiop/common-lisp
(:nicknames :uoip/cl :asdf/common-lisp :asdf/cl)
(:nicknames :uoip/cl)
(:use :uiop/package)
(:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
(:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf)
#+allegro (:intern #:*acl-warn-save*)
#+cormanlisp (:shadow #:user-homedir-pathname)
#+cormanlisp
......@@ -22,7 +21,7 @@
#+mcl (:shadow #:user-homedir-pathname))
(in-package :uiop/common-lisp)
#-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl 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.
......@@ -30,17 +29,23 @@
;;;; Early meta-level tweaks
#+(or abcl allegro clasp clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl)
#+(or allegro clasp clisp cmucl ecl mkcl mkcl sbcl)
(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.
(when (and #+allegro (member :ics *features*)
#+(or clasp clisp cmu ecl mkcl) (member :unicode *features*)
#+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)
#+sbcl (member :sb-unicode *features*))
;; 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.
(pushnew :asdf-unicode *features*)))
#+allegro
(eval-when (:load-toplevel :compile-toplevel :execute)
;; We need to disable autoloading BEFORE any mention of package ASDF.
;; In particular, there must NOT be a mention of package ASDF in the defpackage of this file
;; or any previous file.
(setf excl::*autoload-package-name-alist*
(remove "asdf" excl::*autoload-package-name-alist*
:test 'equalp :key 'car))
(defparameter *acl-warn-save*
(when (boundp 'excl:*warn-on-nested-reader-conditionals*)
excl:*warn-on-nested-reader-conditionals*))
......@@ -64,7 +69,11 @@
(wait-on-semaphore (external-process-completed proc))))
(values (external-process-%exit-code proc)
(external-process-%status proc))))))
#+clozure (in-package :uiop/common-lisp)
#+clozure (in-package :uiop/common-lisp) ;; back in this package.
#+cmucl
(eval-when (:load-toplevel :compile-toplevel :execute)
(setf ext:*gc-verbose* nil))
#+cormanlisp
(eval-when (:load-toplevel :compile-toplevel :execute)
......
......@@ -2,8 +2,7 @@
;;;; Generic support for configuration files
(uiop/package:define-package :uiop/configuration
(:nicknames :asdf/configuration)
(:recycle :uiop/configuration :asdf/configuration :asdf)
(:recycle :uiop/configuration :asdf/configuration) ;; necessary to upgrade from 2.27.
(:use :uiop/common-lisp :uiop/utility
:uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build)
(:export
......
......@@ -2,7 +2,8 @@
;;;; Re-export all the functionality in UIOP
(uiop/package:define-package :uiop/driver
(:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils)
(:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't);
;; but asdf/driver is still used by swap-bytes, static-vectors.
(:use :uiop/common-lisp)
;; NB: not reexporting uiop/common-lisp
;; which include all of CL with compatibility modifications on select platforms,
......@@ -10,9 +11,8 @@
;; or :use (closer-common-lisp uiop), etc.
(:use-reexport
:uiop/package :uiop/utility
:uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image
:uiop/run-program :uiop/lisp-build
:uiop/configuration :uiop/backward-driver))
:uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image
:uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver))
;; Provide both lowercase and uppercase, to satisfy more people.
(provide "uiop") (provide "UIOP")
......@@ -2,8 +2,6 @@
;;;; Portability layer around Common Lisp filesystem access
(uiop/package:define-package :uiop/filesystem
(:nicknames :asdf/filesystem)
(:recycle :uiop/filesystem :asdf/pathname :asdf)
(:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname)
(:export
;; Native namestrings
......@@ -34,9 +32,9 @@
(when x
(let ((p (pathname x)))
#+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978
#+(or cmu scl) (ext:unix-namestring p nil)
#+(or cmucl scl) (ext:unix-namestring p nil)
#+sbcl (sb-ext:native-namestring p)
#-(or clozure cmu sbcl scl)
#-(or clozure cmucl sbcl scl)
(os-cond
((os-unix-p) (unix-namestring p))
(t (namestring p))))))
......@@ -135,10 +133,10 @@ or the original (parsed) pathname if it is false (the default)."
(if truename
(probe-file p)
(and
#+(or cmu scl) (unix:unix-stat (ext:unix-namestring p))
#+(or cmucl scl) (unix:unix-stat (ext:unix-namestring p))
#+(and lispworks unix) (system:get-file-stat p)
#+sbcl (sb-unix:unix-stat (sb-ext:native-namestring p))
#-(or cmu (and lispworks unix) sbcl scl) (file-write-date p)
#-(or cmucl (and lispworks unix) sbcl scl) (file-write-date p)
p))))))
(defun directory-exists-p (x)
......@@ -165,7 +163,7 @@ Try to override the defaults to not resolving symlinks, if implementation allows
(append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
#+(or clozure digitool) '(:follow-links nil)
#+clisp '(:circle t :if-does-not-exist :ignore)
#+(or cmu scl) '(:follow-links nil :truenamep nil)
#+(or cmucl scl) '(:follow-links nil :truenamep nil)
#+lispworks '(:link-transparency nil)
#+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
'(:resolve-symlinks nil))))))
......@@ -231,9 +229,9 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s
(let* ((directory (ensure-directory-pathname directory))
#-(or abcl cormanlisp genera xcl)
(wild (merge-pathnames*
#-(or abcl allegro cmu lispworks sbcl scl xcl)
#-(or abcl allegro cmucl lispworks sbcl scl xcl)
*wild-directory*
#+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*"
#+(or abcl allegro cmucl lispworks sbcl scl xcl) "*.*"
directory))
(dirs
#-(or abcl cormanlisp genera xcl)
......@@ -243,16 +241,16 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s
#+(or abcl xcl) (system:list-directory directory)
#+cormanlisp (cl::directory-subdirs directory)
#+genera (fs:directory-list directory))
#+(or abcl allegro cmu genera lispworks sbcl scl xcl)
#+(or abcl allegro cmucl genera lispworks sbcl scl xcl)
(dirs (loop :for x :in dirs
:for d = #+(or abcl xcl) (extensions:probe-directory x)
#+allegro (excl:probe-directory x)
#+(or cmu sbcl scl) (directory-pathname-p x)
#+(or cmucl sbcl scl) (directory-pathname-p x)
#+genera (getf (cdr x) :directory)
#+lispworks (lw:file-directory-p x)
:when d :collect #+(or abcl allegro xcl) d
#+genera (ensure-directory-pathname (first x))
#+(or cmu lispworks sbcl scl) x)))
#+(or cmucl lispworks sbcl scl) x)))
(filter-logical-directory-results
directory dirs
(let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory))
......@@ -549,7 +547,7 @@ NILs."
#+(or allegro clasp ecl mkcl) #p"SYS:"
;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!)
#+clozure #p"ccl:"
#+cmu (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:")))
#+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:")))
#+gcl system::*system-directory*
#+lispworks lispworks:*lispworks-directory*
#+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil))
......@@ -603,10 +601,10 @@ in an atomic way if the implementation allows."
#+allegro (excl:delete-directory directory-pathname)
#+clisp (ext:delete-directory directory-pathname)
#+clozure (ccl::delete-empty-directory directory-pathname)
#+(or cmu scl) (multiple-value-bind (ok errno)
#+(or cmucl scl) (multiple-value-bind (ok errno)
(unix:unix-rmdir (native-namestring directory-pathname))
(unless ok
#+cmu (error "Error number ~A when trying to delete directory ~A"
#+cmucl (error "Error number ~A when trying to delete directory ~A"
errno directory-pathname)
#+scl (error "~@<Error deleting ~S: ~A~@:>"
directory-pathname (unix:get-unix-error-msg errno))))
......@@ -619,7 +617,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 clasp clisp clozure cmu cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp digitool ecl gcl genera 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))
......@@ -653,7 +651,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
(error "~S was asked to delete ~S but the directory does not exist"
'delete-directory-tree directory-pathname))
(:ignore nil)))
#-(or allegro cmu clozure genera sbcl scl)
#-(or allegro cmucl clozure genera sbcl scl)
((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp,
;; except on implementations where we can prevent DIRECTORY from following symlinks;
;; instead spawn a standard external program to do the dirty work.
......
......@@ -2,8 +2,6 @@
;;;; Starting, Stopping, Dumping a Lisp image
(uiop/package:define-package :uiop/image
(:nicknames :asdf/image)
(:recycle :uiop/image :asdf/image :xcvb-driver)
(:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os)
(:export
#:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments*
......@@ -69,7 +67,7 @@ This is designed to abstract away the implementation specific quit forms."
#+clisp (ext:quit code)
#+clozure (ccl:quit code)
#+cormanlisp (win32:exitprocess code)
#+(or cmu scl) (unix:unix-exit code)
#+(or cmucl scl) (unix:unix-exit code)
#+gcl (system:quit code)
#+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
#+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
......@@ -80,7 +78,7 @@ This is designed to abstract away the implementation specific quit forms."
(cond
(exit `(,exit :code code :abort (not finish-output)))
(quit `(,quit :unix-status code :recklessly-p (not finish-output)))))
#-(or abcl allegro clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))
(defun die (code format &rest arguments)
......@@ -123,7 +121,7 @@ This is designed to abstract away the implementation specific quit forms."
#+clozure (ccl:print-call-history :count count :start-frame-number 1)
#+mcl (ccl:print-call-history :detailed-p nil)
(finish-output stream))
#+(or cmu scl)
#+(or cmucl scl)
(let ((debug:*debug-print-level* *print-level*)
(debug:*debug-print-length* *print-length*))
(debug:backtrace (or count most-positive-fixnum) stream))
......@@ -227,14 +225,14 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+(or clasp ecl) (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
#+clisp (coerce (ext:argv) 'list)
#+clozure ccl:*command-line-argument-list*
#+(or cmu scl) extensions:*command-line-strings*
#+(or cmucl scl) extensions:*command-line-strings*
#+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 clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl 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)))
......@@ -263,7 +261,7 @@ Otherwise, return NIL."
(cond
((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !
;; NB: not currently available on ABCL, Corman, Genera, MCL
(or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)
(or #+(or allegro clisp clozure cmucl gcl lispworks sbcl scl xcl)
(first (raw-command-line-arguments))
#+(or clasp ecl) (si:argv 0) #+mkcl (mkcl:argv 0)))
(t ;; argv[0] is the name of the interpreter.
......@@ -353,7 +351,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(setf *image-dump-hook* dump-hook)
(call-image-dump-hook)
(setf *image-restored-p* nil)
#-(or clisp clozure cmu lispworks sbcl scl)
#-(or clisp clozure cmucl lispworks sbcl scl)
(when executable
(error "Dumping an executable is not supported on this implementation! Aborting."))
#+allegro
......@@ -381,13 +379,13 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(funcall (fdefinition 'ccl::write-elf-symbols-to-file) path)
(dump path))
(dump t)))
#+(or cmu scl)
#+(or cmucl scl)
(progn
(ext:gc :full t)
(setf ext:*batch-mode* nil)
(setf ext::*gc-run-time* 0)
(apply 'ext:save-lisp filename
#+cmu :executable #+cmu t
#+cmucl :executable #+cmucl t
(when executable '(:init-function restore-image :process-command-line nil))))
#+gcl
(progn
......@@ -410,7 +408,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
#+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window.
;; the default is :console - only works with SBCL 1.1.15 or later.
(when application-type (list :application-type application-type)))))
#-(or allegro clisp clozure cmu gcl lispworks sbcl scl)
#-(or allegro clisp clozure cmucl gcl lispworks sbcl scl)
(error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
'dump-image filename (nth-value 1 (implementation-type))))
......
......@@ -2,8 +2,6 @@
;;;; Support to build (compile and load) Lisp files
(uiop/package:define-package :uiop/lisp-build
(:nicknames :asdf/lisp-build)
(:recycle :uiop/lisp-build :asdf/lisp-build :asdf)
(:use :uiop/common-lisp :uiop/package :uiop/utility
:uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image)
(:export
......@@ -66,7 +64,7 @@ This can help you produce more deterministic output for FASLs."))
#+clisp '() ;; system::*optimize* is a constant hash-table! (with non-constant contents)
#+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety*
ccl::*nx-debug* ccl::*nx-cspeed*)
#+(or cmu scl) '(c::*default-cookie*)
#+(or cmucl scl) '(c::*default-cookie*)
#+(and ecl (not clasp)) (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*))
#+clasp '()
#+gcl '(compiler::*speed* compiler::*space* compiler::*compiler-new-safety* compiler::*debug*)
......@@ -75,11 +73,11 @@ This can help you produce more deterministic output for FASLs."))
#+sbcl '(sb-c::*policy*)))
(defun get-optimization-settings ()
"Get current compiler optimization settings, ready to PROCLAIM again"
#-(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
(warn "~S does not support ~S. Please help me fix that."
'get-optimization-settings (implementation-type))
#+(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
(let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
#+(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
(let ((settings '(speed space safety debug compilation-speed #+(or cmucl scl) c::brevity)))
#.`(loop #+(or allegro clozure)
,@'(:with info = #+allegro (sys:declaration-information 'optimize)
#+clozure (ccl:declaration-information 'optimize nil))
......@@ -88,7 +86,7 @@ This can help you produce more deterministic output for FASLs."))
:for y = (or #+(or allegro clozure) (second (assoc x info)) ; normalize order
#+clisp (gethash x system::*optimize* 1)
#+(or abcl clasp ecl mkcl xcl) (symbol-value v)
#+(or cmu scl) (slot-value c::*default-cookie*
#+(or cmucl scl) (slot-value c::*default-cookie*
(case x (compilation-speed 'c::cspeed)
(otherwise x)))
#+lispworks (slot-value compiler::*optimization-level* x)
......@@ -130,7 +128,7 @@ This can help you produce more deterministic output for FASLs."))
(defvar *usual-uninteresting-conditions*
(append
;;#+clozure '(ccl:compiler-warning)
#+cmu '("Deleting unreachable code.")
#+cmucl '("Deleting unreachable code.")
#+lispworks '("~S being redefined in ~A (previously in ~A)."
"~S defined more than once in ~A.") ;; lispworks gets confused by eval-when.
#+sbcl
......@@ -315,7 +313,7 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co
:warning-type warning-type
:args (destructuring-bind (fun . more) args
(cons (symbolify-function-name fun) more))))))
#+(or cmu scl)
#+(or cmucl scl)
(defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit
;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
......@@ -367,7 +365,7 @@ WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings sup
(if-let (dw ccl::*outstanding-deferred-warnings*)
(let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
(ccl::deferred-warnings.warnings mdw))))
#+(or cmu scl)
#+(or cmucl scl)
(when lisp::*in-compilation-unit*
;; Try to send nothing through the pipe if nothing needs to be accumulated
`(,@(when c::*undefined-warnings*
......@@ -413,7 +411,7 @@ One of three functions required for deferred-warnings support in ASDF."
(setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t)))))
(appendf (ccl::deferred-warnings.warnings dw)
(mapcar 'unreify-deferred-warning reified-deferred-warnings)))
#+(or cmu scl)
#+(or cmucl scl)
(dolist (item reified-deferred-warnings)
;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
;; For *undefined-warnings*, the adjustment is a list of initargs.
......@@ -476,7 +474,7 @@ One of three functions required for deferred-warnings support in ASDF."
(if-let (dw ccl::*outstanding-deferred-warnings*)
(let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
(setf (ccl::deferred-warnings.warnings mdw) nil)))
#+(or cmu scl)
#+(or cmucl scl)
(when lisp::*in-compilation-unit*
(setf c::*undefined-warnings* nil
c::*compiler-error-count* 0
......
......@@ -2,8 +2,6 @@
;;;; Access to the Operating System
(uiop/package:define-package :uiop/os
(:nicknames :asdf/os)
(:recycle :uiop/os :asdf/os :asdf)
(:use :uiop/common-lisp :uiop/package :uiop/utility)
(:export
#:featurep #:os-unix-p #:os-macosx-p #:os-windows-p #:os-genera-p #:detect-os ;; features
......@@ -87,7 +85,7 @@ use getenvp to return NIL in such a case."
#+(or abcl clasp clisp ecl xcl) (ext:getenv x)
#+allegro (sys:getenv x)
#+clozure (ccl:getenv x)
#+cmu (unix:unix-getenv x)
#+cmucl (unix:unix-getenv x)
#+scl (cdr (assoc x ext:*environment-list* :test #'string=))
#+cormanlisp
(let* ((buffer (ct:malloc 1))
......@@ -108,7 +106,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 cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "~S is not supported on your implementation" 'getenv))
(defsetf getenv (x) (val)
......@@ -117,12 +115,12 @@ use getenvp to return NIL in such a case."
#+allegro `(setf (sys:getenv ,x) ,val)
#+clisp `(system::setenv ,x ,val)
#+clozure `(ccl:setenv ,x ,val)
#+cmu `(unix:unix-setenv ,x ,val 1)
#+cmucl `(unix:unix-setenv ,x ,val 1)
#+ecl `(ext:setenv ,x ,val)
#+lispworks `(hcl:setenv ,x ,val)
#+mkcl `(mkcl:setenv ,x ,val)
#+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))