Commit c52a4f83 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fixes and refactoring of asdf/bundle and uiop/image for ECL.

Testing the latest cl-launch with ECL showed massive bitrot in the bundle support for ECL.
* Make better use of ASDF3's class hierarchy in redefining asdf/bundle,
  by removing and adding the mixins: goodbye bundle-compile-op and monolithic-,
  hello link-op and gather-op. Also, reinstate bundle-system as a class
  to hold prologue and epilogue (but do we need these, now with portable ASDF3 image support?)
* rename binary-op to deliver-asd-op, same for monolithic-
* Introduce image-op as a superclass of program-op,
  for dumping an executable image with the regular top-level.
* Redo the way operation flags are or aren't propagated:
  gather-op explicitly does not pass the flags,
  so toplevel options are for the toplevel build only
  -- though they belong to the system, not the operation.
  Therefore get rid of no-ld-flags-op -- if there are flags to pass,
  they should be passed explicitly in gather-op;
  or more likely, they might be slots in the system, or the plan,
  or special variables for the current session.
  OPERATE tries harder to preserve the original-initargs,
  which are not clobbered by asdf/bundle's initialize-instance anymore.
* Punt for command-line-arguments on LispWorks,
  so the user has a slight chance of setting them.
parent df7d114c
":" ; exec cl-launch "$0" "$@" ":" ; exec cl-launch "$0" "$@"
#| -*- Lisp -*- #| -*- Lisp -*-
Usage: cl-launch -l lispworks install-asdf-as-module Usage: make && cl-launch -l lispworks bin/install-asdf-as-module
This script will install the current version of ASDF This script will install the current version of ASDF
as a module pre-compiled for your implementation, as a module pre-compiled for your implementation,
......
...@@ -13,8 +13,8 @@ ...@@ -13,8 +13,8 @@
#:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op
#:lib-op #:monolithic-lib-op #:lib-op #:monolithic-lib-op
#:dll-op #:monolithic-dll-op #:dll-op #:monolithic-dll-op
#:binary-op #:monolithic-binary-op #:deliver-asd-op #:monolithic-deliver-asd-op
#:program-op #:compiled-file #:precompiled-system #:prebuilt-system #:program-op #:image-op #:compiled-file #:precompiled-system #:prebuilt-system
#:user-system-p #:user-system #:trivial-system-p #:user-system-p #:user-system #:trivial-system-p
#+ecl #:make-build #+ecl #:make-build
#:register-pre-built-system #:register-pre-built-system
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
(in-package :asdf/bundle) (in-package :asdf/bundle)
(with-upgradability () (with-upgradability ()
(defclass bundle-op (operation) (defclass bundle-op (basic-compile-op)
((build-args :initarg :args :initform nil :accessor bundle-op-build-args) ((build-args :initarg :args :initform nil :accessor bundle-op-build-args)
(name-suffix :initarg :name-suffix :initform nil) (name-suffix :initarg :name-suffix :initform nil)
(bundle-type :initform :no-output-file :reader bundle-type) (bundle-type :initform :no-output-file :reader bundle-type)
...@@ -30,79 +30,104 @@ ...@@ -30,79 +30,104 @@
#+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p) #+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p)
#+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p))) #+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p)))
(defclass bundle-compile-op (bundle-op basic-compile-op) (defclass monolithic-op (operation) ()
() (:documentation "A MONOLITHIC operation operates on a system *and all of its
(:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files")) dependencies*. So, for example, a monolithic concatenate operation will
concatenate together a system's components and all of its dependencies, but a
simple concatenate operation will concatenate only the components of the system
itself.")) ;; operation on a system and its dependencies
(defclass monolithic-bundle-op (monolithic-op bundle-op)
;; Old style way of specifying prologue and epilogue on ECL: in the monolithic operation
((prologue-code :accessor prologue-code)
(epilogue-code :accessor epilogue-code)))
(defclass bundle-system (system)
;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system
((prologue-code :accessor prologue-code)
(epilogue-code :accessor epilogue-code)))
(defmethod prologue-code ((x t)) nil)
(defmethod epilogue-code ((x t)) nil)
(defclass link-op (bundle-op) ()
(:documentation "Abstract operation for linking files together"))
(defclass gather-op (bundle-op)
((gather-op :initform nil :allocation :class :reader gather-op))
(:documentation "Abstract operation for gathering many input files from a system"))
(defun operation-monolithic-p (op)
(typep op 'monolithic-op))
(defmethod component-depends-on ((o gather-op) (s system))
(let* ((mono (operation-monolithic-p o))
(deps
(required-components
s :other-systems mono :component-type (if mono 'system '(not system))
:goal-operation (find-operation o 'load-op)
:keep-operation 'compile-op)))
;; NB: the explicit make-operation on ECL and MKCL
;; ensures that we drop the original-initargs and its magic flags when recursing.
`((,(make-operation (or (gather-op o) (if mono 'lib-op 'compile-op))) ,@deps)
,@(call-next-method))))
;; create a single fasl for the entire library ;; create a single fasl for the entire library
(defclass basic-fasl-op (bundle-compile-op) (defclass basic-fasl-op (bundle-op)
((bundle-type :initform :fasl))) ((bundle-type :initform :fasl)))
(defclass prepare-fasl-op (sideway-operation) (defclass prepare-fasl-op (sideway-operation)
((sideway-operation :initform 'load-fasl-op :allocation :class))) ((sideway-operation :initform #+ecl 'load-fasl-op #-ecl 'load-op :allocation :class)))
(defclass fasl-op (basic-fasl-op selfward-operation)
(defclass lib-op (link-op gather-op non-propagating-operation)
((bundle-type :initform :lib))
(:documentation "compile the system and produce linkable (.a) library for it."))
(defclass fasl-op (basic-fasl-op selfward-operation #+ecl link-op #-ecl gather-op)
((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class))) ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class)))
(defclass load-fasl-op (basic-load-op selfward-operation) (defclass load-fasl-op (basic-load-op selfward-operation)
((selfward-operation :initform '(prepare-op fasl-op) :allocation :class))) ((selfward-operation :initform '(prepare-op fasl-op) :allocation :class)))
;; NB: since the monolithic-op's can't be sideway-operation's, ;; NB: since the monolithic-op's can't be sideway-operation's,
;; if we wanted lib-op, dll-op, binary-op to be sideway-operation's, ;; if we wanted lib-op, dll-op, deliver-asd-op to be sideway-operation's,
;; we'd have to have the monolithic-op not inherit from the main op, ;; 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-fasl-op above. ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above.
(defclass no-ld-flags-op (operation) ()) (defclass dll-op (link-op gather-op non-propagating-operation)
(defclass lib-op (bundle-compile-op no-ld-flags-op non-propagating-operation)
((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
(:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it."
#-(or ecl mkcl) "just compile the system"))
(defclass dll-op (bundle-compile-op no-ld-flags-op non-propagating-operation)
((bundle-type :initform :dll)) ((bundle-type :initform :dll))
(:documentation "compile the system and produce dynamic (.so/.dll) library for it.")) (:documentation "compile the system and produce dynamic (.so/.dll) library for it."))
(defclass binary-op (basic-compile-op selfward-operation) (defclass deliver-asd-op (basic-compile-op selfward-operation)
((selfward-operation :initform '(fasl-op lib-op) :allocation :class)) ((selfward-operation :initform '(fasl-op #+(or ecl mkcl) lib-op) :allocation :class))
(:documentation "produce fasl and asd files for the system")) (:documentation "produce an asd file for delivering the system as a single fasl"))
(defclass monolithic-op (operation) ()
(:documentation "A MONOLITHIC operation operates on a system *and all of its
dependencies*. So, for example, a monolithic concatenate operation will
concatenate together a system's components and all of its dependencies, but a
simple concatenate operation will concatenate only the components of the system
itself.")) ;; operation on a system and its dependencies
(defclass monolithic-bundle-op (monolithic-op bundle-op)
((prologue-code :accessor monolithic-op-prologue-code)
(epilogue-code :accessor monolithic-op-epilogue-code)))
(defclass monolithic-bundle-compile-op (monolithic-bundle-op bundle-compile-op)
()
(:documentation "Abstract operation for ways to bundle the outputs of compiling
*Lisp* files over a system, and all of its dependencies."))
(defclass monolithic-binary-op (monolithic-op binary-op) (defclass monolithic-deliver-asd-op (monolithic-bundle-op deliver-asd-op)
((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op) :allocation :class)) ((selfward-operation :initform '(monolithic-fasl-op #+(or ecl mkcl) monolithic-lib-op)
:allocation :class))
(:documentation "produce fasl and asd files for combined system and dependencies.")) (:documentation "produce fasl and asd files for combined system and dependencies."))
(defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op non-propagating-operation) () (defclass monolithic-fasl-op (monolithic-bundle-op basic-fasl-op
#+ecl link-op gather-op non-propagating-operation)
((gather-op :initform #+(or ecl mkcl) 'lib-op #-(or ecl mkcl) 'fasl-op :allocation :class))
(:documentation "Create a single fasl for the system and its dependencies.")) (:documentation "Create a single fasl for the system and its dependencies."))
(defclass monolithic-lib-op (monolithic-bundle-compile-op non-propagating-operation no-ld-flags-op) (defclass monolithic-lib-op (monolithic-bundle-op lib-op non-propagating-operation) ()
((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file)) (:documentation "Create a single linkable library for the system and its dependencies."))
(:documentation #+(or ecl mkcl) "Create a single linkable library for the system and its dependencies."
#-(or ecl mkcl) "Compile a system and its dependencies."))
(defclass monolithic-dll-op (monolithic-bundle-compile-op non-propagating-operation no-ld-flags-op) (defclass monolithic-dll-op (monolithic-bundle-op dll-op non-propagating-operation)
((bundle-type :initform :dll)) ((bundle-type :initform :dll))
(:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies.")) (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies."))
;; Fare reports that the PROGRAM-OP doesn't need any propagation on MKCL or (defclass image-op (monolithic-bundle-op selfward-operation
;; ECL because the necessary dependency wrangling is done by other, earlier #+ecl link-op #+(or ecl mkcl) gather-op)
;; operations. [2014/01/20:rpg] ((bundle-type :initform :image)
(defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op non-propagating-operation) (selfward-operation :initform '(#-ecl load-op) :allocation :class))
#-(or mkcl ecl) (monolithic-bundle-op selfward-operation) (:documentation "create an image file from the system and its dependencies"))
((bundle-type :initform :program)
#-(or mkcl ecl) (selfward-operation :initform 'load-op)) (defclass program-op (image-op)
((bundle-type :initform :program))
(:documentation "create an executable file from the system and its dependencies")) (:documentation "create an executable file from the system and its dependencies"))
(defun bundle-pathname-type (bundle-type) (defun bundle-pathname-type (bundle-type)
...@@ -111,22 +136,22 @@ itself.")) ;; operation on a system and its dependencies ...@@ -111,22 +136,22 @@ itself.")) ;; operation on a system and its dependencies
((or null string) bundle-type) ((or null string) bundle-type)
((eql :fasl) #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb") ((eql :fasl) #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb")
#+ecl #+ecl
((member :binary :dll :lib :shared-library :static-library :program :object :program) ((member :dll :lib :shared-library :static-library :program :object :program)
(compile-file-type :type bundle-type)) (compile-file-type :type bundle-type))
((eql :binary) "image") ((member :image) "image")
((eql :dll) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) ((eql :dll) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib"))) ((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib")))
((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe")))))
(defun bundle-output-files (o c) (defun bundle-output-files (o c)
(when (input-files o c) (let ((bundle-type (bundle-type o)))
(let ((bundle-type (bundle-type o))) (unless (or (eq bundle-type :no-output-file) ;; NIL already means something regarding type.
(unless (eq bundle-type :no-output-file) ;; NIL already means something regarding type. (and (null (input-files o c)) (not (member bundle-type '(:image :program)))))
(let ((name (or (component-build-pathname c) (let ((name (or (component-build-pathname c)
(format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix)))) (format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix))))
(type (bundle-pathname-type bundle-type))) (type (bundle-pathname-type bundle-type)))
(values (list (subpathname (component-pathname c) name :type type)) (values (list (subpathname (component-pathname c) name :type type))
(eq (type-of o) (component-build-operation c)))))))) (eq (type-of o) (component-build-operation c)))))))
(defmethod output-files ((o bundle-op) (c system)) (defmethod output-files ((o bundle-op) (c system))
(bundle-output-files o c)) (bundle-output-files o c))
...@@ -157,9 +182,6 @@ itself.")) ;; operation on a system and its dependencies ...@@ -157,9 +182,6 @@ itself.")) ;; operation on a system and its dependencies
;;; The different targets are defined by specialization. ;;; The different targets are defined by specialization.
;;; ;;;
(with-upgradability () (with-upgradability ()
(defun operation-monolithic-p (op)
(typep op 'monolithic-op))
(defmethod initialize-instance :after ((instance bundle-op) &rest initargs (defmethod initialize-instance :after ((instance bundle-op) &rest initargs
&key (name-suffix nil name-suffix-p) &key (name-suffix nil name-suffix-p)
&allow-other-keys) &allow-other-keys)
...@@ -169,25 +191,17 @@ itself.")) ;; operation on a system and its dependencies ...@@ -169,25 +191,17 @@ itself.")) ;; operation on a system and its dependencies
(unless (typep instance 'program-op) (unless (typep instance 'program-op)
(if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames (if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames
(when (typep instance 'monolithic-bundle-op) (when (typep instance 'monolithic-bundle-op)
(destructuring-bind (&rest original-initargs (destructuring-bind (&key lisp-files prologue-code epilogue-code
&key lisp-files prologue-code epilogue-code
&allow-other-keys) &allow-other-keys)
(operation-original-initargs instance) (operation-original-initargs instance)
(setf (operation-original-initargs instance) (setf (prologue-code instance) prologue-code
(remove-plist-keys '(:lisp-files :epilogue-code :prologue-code) original-initargs) (epilogue-code instance) epilogue-code)
(monolithic-op-prologue-code instance) prologue-code
(monolithic-op-epilogue-code instance) epilogue-code)
#-ecl (assert (null (or lisp-files epilogue-code prologue-code))) #-ecl (assert (null (or lisp-files epilogue-code prologue-code)))
#+ecl (setf (bundle-op-lisp-files instance) lisp-files))) #+ecl (setf (bundle-op-lisp-files instance) lisp-files)))
(setf (bundle-op-build-args instance) (setf (bundle-op-build-args instance)
(remove-plist-keys '(:type :monolithic :name-suffix) (remove-plist-keys
(operation-original-initargs instance)))) '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files)
(operation-original-initargs instance))))
(defmethod bundle-op-build-args :around ((o no-ld-flags-op))
#+xcl (declare (ignorable o))
(let ((args (call-next-method)))
(remf args :ld-flags)
args))
(defun bundlable-file-p (pathname) (defun bundlable-file-p (pathname)
(let ((type (pathname-type pathname))) (let ((type (pathname-type pathname)))
...@@ -216,18 +230,6 @@ itself.")) ;; operation on a system and its dependencies ...@@ -216,18 +230,6 @@ itself.")) ;; operation on a system and its dependencies
;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL ;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL
;;; ;;;
(with-upgradability () (with-upgradability ()
(defmethod component-depends-on ((o bundle-compile-op) (c system))
`(,(if (operation-monolithic-p o)
`(#-(or ecl mkcl) fasl-op #+(or ecl mkcl) lib-op
,@(required-components c :other-systems t :component-type 'system
:goal-operation (find-operation o 'load-op)
:keep-operation 'compile-op))
`(compile-op
,@(required-components c :other-systems nil :component-type '(not system)
:goal-operation (find-operation o 'load-op)
:keep-operation 'compile-op)))
,@(call-next-method)))
(defmethod component-depends-on :around ((o bundle-op) (c component)) (defmethod component-depends-on :around ((o bundle-op) (c component))
(if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c))) (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c)))
`((,op ,c)) `((,op ,c))
...@@ -242,23 +244,24 @@ itself.")) ;; operation on a system and its dependencies ...@@ -242,23 +244,24 @@ itself.")) ;; operation on a system and its dependencies
(loop :for f :in (funcall key sub-o sub-c) (loop :for f :in (funcall key sub-o sub-c)
:when (funcall test f) :do (collect f)))))) :when (funcall test f) :do (collect f))))))
(defmethod input-files ((o bundle-compile-op) (c system)) (defmethod input-files ((o bundle-op) (c system))
(unless (eq (bundle-type o) :no-output-file) (unless (eq (bundle-type o) :no-output-file)
(direct-dependency-files o c :test 'bundlable-file-p :key 'output-files))) (direct-dependency-files o c :test 'bundlable-file-p :key 'output-files)))
(defun select-bundle-operation (type &optional monolithic) (defun select-bundle-operation (type &optional monolithic)
(ecase type (ecase type
((:binary)
(if monolithic 'monolithic-binary-op 'binary-op))
((:dll :shared-library) ((:dll :shared-library)
(if monolithic 'monolithic-dll-op 'dll-op)) (if monolithic 'monolithic-dll-op 'dll-op))
((:lib :static-library) ((:lib :static-library)
(if monolithic 'monolithic-lib-op 'lib-op)) (if monolithic 'monolithic-lib-op 'lib-op))
((:fasl) ((:fasl)
(if monolithic 'monolithic-fasl-op 'fasl-op)) (if monolithic 'monolithic-fasl-op 'fasl-op))
((:image)
'image-op)
((:program) ((:program)
'program-op))) 'program-op)))
;; This is originally from asdf-ecl.lisp. Does anyone use it?
(defun make-build (system &rest args &key (monolithic nil) (type :fasl) (defun make-build (system &rest args &key (monolithic nil) (type :fasl)
(move-here nil move-here-p) (move-here nil move-here-p)
&allow-other-keys) &allow-other-keys)
...@@ -273,7 +276,7 @@ itself.")) ;; operation on a system and its dependencies ...@@ -273,7 +276,7 @@ itself.")) ;; operation on a system and its dependencies
(system (find-system system)) (system (find-system system))
(files (and system (output-files operation system)))) (files (and system (output-files operation system))))
(if (or move-here (and (null move-here-p) (if (or move-here (and (null move-here-p)
(member operation-name '(:program :binary)))) (member operation-name '(:program :image))))
(loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path)) (loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path))
:for f :in files :for f :in files
:for new-f = (make-pathname :name (pathname-name f) :for new-f = (make-pathname :name (pathname-name f)
...@@ -348,11 +351,11 @@ itself.")) ;; operation on a system and its dependencies ...@@ -348,11 +351,11 @@ itself.")) ;; operation on a system and its dependencies
;;; PREBUILT SYSTEM CREATOR ;;; PREBUILT SYSTEM CREATOR
;;; ;;;
(with-upgradability () (with-upgradability ()
(defmethod output-files ((o binary-op) (s system)) (defmethod output-files ((o deliver-asd-op) (s system))
(list (make-pathname :name (component-name s) :type "asd" (list (make-pathname :name (component-name s) :type "asd"
:defaults (component-pathname s)))) :defaults (component-pathname s))))
(defmethod perform ((o binary-op) (s system)) (defmethod perform ((o deliver-asd-op) (s system))
(let* ((inputs (input-files o s)) (let* ((inputs (input-files o s))
(fasl (first inputs)) (fasl (first inputs))
(library (second inputs)) (library (second inputs))
...@@ -394,7 +397,7 @@ itself.")) ;; operation on a system and its dependencies ...@@ -394,7 +397,7 @@ itself.")) ;; operation on a system and its dependencies
(terpri s))))) (terpri s)))))
#-(or ecl mkcl) #-(or ecl mkcl)
(defmethod perform ((o bundle-compile-op) (c system)) (defmethod perform ((o basic-fasl-op) (c system))
(let* ((input-files (input-files o c)) (let* ((input-files (input-files o c))
(fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp)) (fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp))
(non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp)) (non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp))
...@@ -405,8 +408,8 @@ itself.")) ;; operation on a system and its dependencies ...@@ -405,8 +408,8 @@ itself.")) ;; operation on a system and its dependencies
(when non-fasl-files (when non-fasl-files
(error "On ~A, asdf/bundle can only bundle FASL files, but these were also produced: ~S" (error "On ~A, asdf/bundle can only bundle FASL files, but these were also produced: ~S"
(implementation-type) non-fasl-files)) (implementation-type) non-fasl-files))
(when (and (typep o 'monolithic-bundle-op) (when (or (prologue-code o) (epilogue-code o)
(or (monolithic-op-prologue-code o) (monolithic-op-epilogue-code o))) (prologue-code c) (epilogue-code c))
(error "prologue-code and epilogue-code are not supported on ~A" (error "prologue-code and epilogue-code are not supported on ~A"
(implementation-type))) (implementation-type)))
(with-staging-pathname (output-file) (with-staging-pathname (output-file)
...@@ -439,8 +442,7 @@ itself.")) ;; operation on a system and its dependencies ...@@ -439,8 +442,7 @@ itself.")) ;; operation on a system and its dependencies
(defmethod input-files :around ((o program-op) (c system)) (defmethod input-files :around ((o program-op) (c system))
(let ((files (call-next-method)) (let ((files (call-next-method))
(plan (traverse-sub-actions o c :plan-class 'sequential-plan))) (plan (traverse-sub-actions o c :plan-class 'sequential-plan)))
(unless (or (and (find-system :uiop nil) (unless (or (and (system-source-directory :uiop)
(system-source-directory :uiop)
(plan-operates-on-p plan '("uiop"))) (plan-operates-on-p plan '("uiop")))
(and (system-source-directory :asdf) (and (system-source-directory :asdf)
(plan-operates-on-p plan '("asdf")))) (plan-operates-on-p plan '("asdf"))))
...@@ -452,23 +454,20 @@ itself.")) ;; operation on a system and its dependencies ...@@ -452,23 +454,20 @@ itself.")) ;; operation on a system and its dependencies
#+ecl #+ecl
(with-upgradability () (with-upgradability ()
(defmethod perform ((o bundle-compile-op) (c system)) (defmethod perform ((o link-op) (c system))
(let* ((object-files (input-files o c)) (let* ((object-files (input-files o c))
(output (output-files o c)) (output (output-files o c))
(bundle (first output)) (bundle (first output))
(targetp (eq (type-of o) (component-build-operation c)))
(kind (bundle-type o))) (kind (bundle-type o)))
(when output (when output
(create-image (apply 'create-image
bundle (append object-files (bundle-op-lisp-files o)) bundle (append object-files (bundle-op-lisp-files o))
:kind kind :kind kind
:entry-point (component-entry-point c) :prologue-code (or (prologue-code o) (when targetp (prologue-code c)))
:prologue-code :epilogue-code (or (epilogue-code o) (when targetp (epilogue-code c)))
(when (typep o 'monolithic-bundle-op) :build-args (bundle-op-build-args o)
(monolithic-op-prologue-code o)) (when targetp `(:entry-point ,(component-entry-point c))))))))
:epilogue-code
(when (typep o 'monolithic-bundle-op)
(monolithic-op-epilogue-code o))
:build-args (bundle-op-build-args o))))))
#+mkcl #+mkcl
(with-upgradability () (with-upgradability ()
...@@ -482,7 +481,7 @@ itself.")) ;; operation on a system and its dependencies ...@@ -482,7 +481,7 @@ itself.")) ;; operation on a system and its dependencies
(defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys) (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys)
(declare (ignore force verbose version)) (declare (ignore force verbose version))
(apply #'operate 'binary-op system args))) (apply #'operate 'deliver-asd-op system args)))
#+(and (not asdf-use-unsafe-mac-bundle-op) #+(and (not asdf-use-unsafe-mac-bundle-op)
(or (and ecl darwin) (or (and ecl darwin)
......
...@@ -40,8 +40,8 @@ ...@@ -40,8 +40,8 @@
#:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system
#+ecl #:make-build #+ecl #:make-build
#:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op
#:lib-op #:dll-op #:binary-op #:program-op #:lib-op #:dll-op #:deliver-asd-op #:program-op #:image-op
#:monolithic-lib-op #:monolithic-dll-op #:monolithic-binary-op #:monolithic-lib-op #:monolithic-dll-op #:monolithic-deliver-asd-op
#:concatenate-source-op #:concatenate-source-op
#:load-concatenated-source-op #:load-concatenated-source-op
#:compile-concatenated-source-op #:compile-concatenated-source-op
......
...@@ -58,6 +58,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: ...@@ -58,6 +58,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(operation-name (reify-symbol (etypecase operation (operation-name (reify-symbol (etypecase operation
(operation (type-of operation)) (operation (type-of operation))
(symbol operation)))) (symbol operation))))
(operation-initargs (operation-original-initargs operation))
(component-path (typecase component (component-path (typecase component
(component (component-find-path component)) (component (component-find-path component))
(t component)))) (t component))))
...@@ -69,7 +70,9 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: ...@@ -69,7 +70,9 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
;; its function may have been redefined, its symbol uninterned, its package deleted. ;; its function may have been redefined, its symbol uninterned, its package deleted.
(return-from operate (return-from operate
(apply (find-symbol* 'operate :asdf) (apply (find-symbol* 'operate :asdf)
(unreify-symbol operation-name) (apply (find-symbol* 'make-operation :asdf)
(unreify-symbol operation-name)
:original-initargs operation-initargs operation-initargs)
component-path keys)))) component-path keys))))
;; Setup proper bindings around any operate call. ;; Setup proper bindings around any operate call.
(with-system-definitions () (with-system-definitions ()
......
...@@ -7,7 +7,9 @@ ...@@ -7,7 +7,9 @@
(defun main (&rest arguments) (defun main (&rest arguments)
(format t "hello, world~%") (format t "hello, world~%")
(when arguments (when arguments
(format t "You passed ~D arguments:~%~{ ~S~%~}" (length arguments) arguments))) (format t "You passed ~D arguments:~%~{ ~S~%~}" (length arguments) arguments))
;; Return success!
t)
(defun entry-point () (defun entry-point ()
(apply 'main *command-line-arguments*)) (apply 'main *command-line-arguments*))
...@@ -29,7 +29,6 @@ ...@@ -29,7 +29,6 @@
(when (version< version-nums "1.2.0") (when (version< version-nums "1.2.0")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0))) (leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
(defparameter *bundle-1* (output-file 'fasl-op :test-asdf/bundle-1)) (defparameter *bundle-1* (output-file 'fasl-op :test-asdf/bundle-1))
(defparameter *bundle-2* (output-file 'fasl-op :test-asdf/bundle-2)) (defparameter *bundle-2* (output-file 'fasl-op :test-asdf/bundle-2))
(defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-asdf/bundle-2)) (defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-asdf/bundle-2))
......
...@@ -11,31 +11,32 @@ ...@@ -11,31 +11,32 @@
(defparameter *good-classes* (defparameter *good-classes*
'(build-op '(build-op
prepare-source-op compile-concatenated-source-op
prepare-op compile-op
prepare-fasl-op concatenate-source-op
load-op deliver-asd-op
monolithic-load-compiled-concatenated-source-op dll-op
prepare-fasl-op fasl-op
load-source-op image-op
lib-op
load-compiled-concatenated-source-op load-compiled-concatenated-source-op
monolithic-load-concatenated-source-op
load-concatenated-source-op load-concatenated-source-op
load-fasl-op load-fasl-op
compile-op load-op
compile-concatenated-source-op load-source-op
test-op
fasl-op
program-op
monolithic-compile-concatenated-source-op monolithic-compile-concatenated-source-op
monolithic-concatenate-source-op
monolithic-deliver-asd-op
monolithic-dll-op monolithic-dll-op
monolithic-binary-op
monolithic-fasl-op monolithic-fasl-op
dll-op
concatenate-source-op
monolithic-lib-op monolithic-lib-op
monolithic-concatenate-source-op monolithic-load-compiled-concatenated-source-op
lib-op) monolithic-load-concatenated-source-op
prepare-fasl-op
prepare-op
prepare-source-op