Loading bundle.lisp +55 −32 Original line number Diff line number Diff line Loading @@ -8,7 +8,7 @@ :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) (:export #:bundle-op #:bundle-type #:program-system #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files #:bundle-system #:bundle-pathname-type #:direct-dependency-files #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p #:basic-compile-bundle-op #:prepare-bundle-op #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op Loading Loading @@ -66,7 +66,8 @@ itself.")) ;; operation on a system and its dependencies (:documentation "Abstract operation for linking files together")) (defclass gather-op (bundle-op) ((gather-op :initform nil :allocation :class :reader gather-op)) ((gather-op :initform nil :allocation :class :reader gather-op) (gather-type :initform :no-output-file :allocation :class :reader gather-type)) (:documentation "Abstract operation for gathering many input files from a system")) (defun operation-monolithic-p (op) Loading @@ -86,7 +87,9 @@ itself.")) ;; operation on a system and its dependencies ;; create a single fasl for the entire library (defclass basic-compile-bundle-op (bundle-op) ((bundle-type :initform :fasl))) ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object :allocation :class) (bundle-type :initform :fasl :allocation :class))) (defclass prepare-bundle-op (sideway-operation) ((sideway-operation Loading @@ -94,7 +97,8 @@ itself.")) ;; operation on a system and its dependencies :allocation :class))) (defclass lib-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :lib)) ((gather-type :initform :object :allocation :class) (bundle-type :initform :lib :allocation :class)) (:documentation "Compile the system and produce linkable (.a) library for it. Compare with DLL-OP.")) Loading @@ -120,24 +124,35 @@ faster and more resource efficient.")) ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above. (defclass dll-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :dll)) ((gather-type :initform :object :allocation :class) (bundle-type :initform :dll :allocation :class)) (:documentation "compile the system and produce dynamic (.so/.dll) library for it. Compare with LIB-OP.")) (defclass deliver-asd-op (basic-compile-op selfward-operation) ((selfward-operation :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) :allocation :class)) ((selfward-operation ;; TODO: implement link-op on all implementations, and make that ;; '(compile-bundle-op lib-op #-(or clasp ecl mkcl) dll-op) :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) :allocation :class)) (:documentation "produce an asd file for delivering the system as a single fasl")) (defclass monolithic-deliver-asd-op (monolithic-bundle-op deliver-asd-op) ((selfward-operation ;; TODO: implement link-op on all implementations, and make that ;; '(monolithic-compile-bundle-op monolithic-lib-op #-(or clasp ecl mkcl) monolithic-dll-op) :initform '(monolithic-compile-bundle-op #+(or clasp ecl mkcl) monolithic-lib-op) :allocation :class)) (:documentation "produce fasl and asd files for combined system and dependencies.")) (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation) ((gather-op :initform #+(or clasp ecl mkcl) 'lib-op #-(or clasp ecl mkcl) 'compile-bundle-op :allocation :class)) ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op :allocation :class) (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library :allocation :class)) (:documentation "Create a single fasl for the system and its dependencies.")) (defclass monolithic-load-bundle-op (monolithic-bundle-op load-bundle-op) Loading @@ -148,12 +163,13 @@ Compare with LIB-OP.")) (:documentation "Create a single linkable library for the system and its dependencies.")) (defclass monolithic-dll-op (monolithic-bundle-op dll-op non-propagating-operation) ((bundle-type :initform :dll)) ((gather-type :initform :static-library :allocation :class)) (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies.")) (defclass image-op (monolithic-bundle-op selfward-operation #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op) ((bundle-type :initform :image) #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class) (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) Loading @@ -163,17 +179,29 @@ Compare with LIB-OP.")) (defun bundle-pathname-type (bundle-type) (etypecase bundle-type ((eql :no-output-file) nil) ;; should we error out instead? ((or null string) bundle-type) ((eql :fasl) #-(or clasp ecl mkcl) (compile-file-type) #+(or clasp ecl mkcl) "fasb") #+(or clasp ecl) ((member :dll :lib :shared-library :static-library :program :object :program) (compile-file-type :type bundle-type)) ((member :image) #+allegro "dxl" #+(and clisp os-windows) "exe" #-(or allegro (and clisp os-windows)) "image") ((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) ((member :lib :static-library) (os-cond ((os-unix-p) "a") ((or null string) ;; pass through nil or string literal bundle-type) ((eql :no-output-file) ;; marker for a bundle-type that has NO output file (error "No output file, therefore no pathname type")) ((eql :fasl) ;; the type of a fasl #-(or clasp ecl mkcl) (compile-file-type) ; on image-based platforms, used as input and output #+(or clasp ecl mkcl) "fasb") ; on C-linking platforms, only used as output for system bundles ((member :image) #+allegro "dxl" #+(and clisp os-windows) "exe" #-(or allegro (and clisp os-windows)) "image") ;; NB: on CLASP and ECL these implementations, we better agree with ;; (compile-file-type :type bundle-type)) ((eql :object) ;; the type of a linkable object file (os-cond ((os-unix-p) "o") ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "o" "obj")))) ((member :lib :static-library) ;; the type of a linkable library (os-cond ((os-unix-p) "a") ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) ((eql :program) (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) ((member :dll :shared-library) ;; the type of a shared library (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) ((eql :program) ;; the type of an executable program (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) (defun bundle-output-files (o c) (let ((bundle-type (bundle-type o))) Loading Loading @@ -238,16 +266,6 @@ Compare with LIB-OP.")) :force :force-not :plan-class) ;; TODO: refactor so we don't mix plan and operation arguments (operation-original-initargs instance)))) (defun bundlable-file-p (pathname) (let ((type (pathname-type pathname))) (declare (ignorable type)) (or #+(or clasp ecl) (or (equalp type (compile-file-type :type :object)) (equalp type (compile-file-type :type :static-library))) #+mkcl (or (equalp type (compile-file-type :fasl-p nil)) #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW #+(and windows (not (or mingw32 mingw64))) (equalp type "lib")) #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) (defgeneric* (trivial-system-p) (component)) (defun user-system-p (s) Loading Loading @@ -276,9 +294,14 @@ Compare with LIB-OP.")) (loop :for f :in (funcall key sub-o sub-c) :when (funcall test f) :do (collect f)))))) (defun pathname-type-equal-function (type) #'(lambda (p) (equal (pathname-type p) type))) (defmethod input-files ((o gather-op) (c system)) (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 :key 'output-files :test (pathname-type-equal-function (bundle-pathname-type (gather-type o)))))) (defun select-bundle-operation (type &optional monolithic) (ecase type Loading lisp-action.lisp +7 −1 Original line number Diff line number Diff line Loading @@ -89,7 +89,13 @@ &optional #+(or clasp ecl mkcl) object-file #+clisp lib-file warnings-file) outputs warnings-file &rest rest) outputs ;; Allow for extra outputs that are not of type warnings-file ;; The way we do it is kludgy. In ASDF4, output-files shall not be positional. (declare (ignore rest)) (when warnings-file (unless (equal (pathname-type warnings-file) (warnings-file-type)) (setf warnings-file nil))) (call-with-around-compile-hook c #'(lambda (&rest flags) (apply 'compile-file* input-file Loading plan.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -224,7 +224,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (latest-in (stamps-latest (cons dep-stamp in-stamps)))) (when (and missing-in (not just-done)) (return (values t nil)))) ;; collect timestamps from outputs, and exit early if any is missing (let* ((out-files (output-files o c)) (let* ((out-files (remove-if 'null (output-files o c))) (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) (earliest-out (stamps-earliest out-stamps))) Loading test/test-bundle.script +10 −3 Original line number Diff line number Diff line Loading @@ -49,28 +49,35 @@ (operate 'monolithic-compile-bundle-op :test-asdf/bundle-2) (assert (probe-file *mono-bundle-2*)) ;;; Test dll-op and monolithic-dll-op on ECL and MKCL #+(or ecl mkcl) (progn (DBG "On ECL and MKCL, test dll-op and monolithic-dll-op") #+ecl (trace c::builder) (require 'sockets) ;; Test the pre-compiled system feature ;; Test that we didn't break require for non-asdf modules (DBG "Test the pre-compiled system feature") (require 'sockets) (progn (DBG "Test that we didn't break require for non-asdf modules") (pop #+ecl ext:*module-provider-functions* #+mkcl mk-ext:*module-provider-functions*) (require 'serve-event)) (DBG "Create a DLL via dll-op") (operate 'dll-op :test-asdf/dll-test) (DBG "Load the DLL") (let ((dll (first (output-files 'dll-op :test-asdf/dll-test)))) (si:load-foreign-module dll) (DBG "Load a library that knows how to use the DLL") (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) (operate 'load-op :test-asdf/dll-user))) (DBG "Test that the DLL works") (assert-equal (test-package::sample-function) 42) (DBG "Create a DLL via monolithic-dll-op") (nest #+(and mkcl windows) (let* ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1))) (compiler::*builder-default-libraries* (list (namestring lib))))) (operate 'monolithic-dll-op :test-asdf/monodll)) (DBG "Use and test that DLL") (let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll)))) (si:load-foreign-module dll) (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) Loading Loading
bundle.lisp +55 −32 Original line number Diff line number Diff line Loading @@ -8,7 +8,7 @@ :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) (:export #:bundle-op #:bundle-type #:program-system #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files #:bundle-system #:bundle-pathname-type #:direct-dependency-files #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p #:basic-compile-bundle-op #:prepare-bundle-op #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op Loading Loading @@ -66,7 +66,8 @@ itself.")) ;; operation on a system and its dependencies (:documentation "Abstract operation for linking files together")) (defclass gather-op (bundle-op) ((gather-op :initform nil :allocation :class :reader gather-op)) ((gather-op :initform nil :allocation :class :reader gather-op) (gather-type :initform :no-output-file :allocation :class :reader gather-type)) (:documentation "Abstract operation for gathering many input files from a system")) (defun operation-monolithic-p (op) Loading @@ -86,7 +87,9 @@ itself.")) ;; operation on a system and its dependencies ;; create a single fasl for the entire library (defclass basic-compile-bundle-op (bundle-op) ((bundle-type :initform :fasl))) ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object :allocation :class) (bundle-type :initform :fasl :allocation :class))) (defclass prepare-bundle-op (sideway-operation) ((sideway-operation Loading @@ -94,7 +97,8 @@ itself.")) ;; operation on a system and its dependencies :allocation :class))) (defclass lib-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :lib)) ((gather-type :initform :object :allocation :class) (bundle-type :initform :lib :allocation :class)) (:documentation "Compile the system and produce linkable (.a) library for it. Compare with DLL-OP.")) Loading @@ -120,24 +124,35 @@ faster and more resource efficient.")) ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above. (defclass dll-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :dll)) ((gather-type :initform :object :allocation :class) (bundle-type :initform :dll :allocation :class)) (:documentation "compile the system and produce dynamic (.so/.dll) library for it. Compare with LIB-OP.")) (defclass deliver-asd-op (basic-compile-op selfward-operation) ((selfward-operation :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) :allocation :class)) ((selfward-operation ;; TODO: implement link-op on all implementations, and make that ;; '(compile-bundle-op lib-op #-(or clasp ecl mkcl) dll-op) :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op) :allocation :class)) (:documentation "produce an asd file for delivering the system as a single fasl")) (defclass monolithic-deliver-asd-op (monolithic-bundle-op deliver-asd-op) ((selfward-operation ;; TODO: implement link-op on all implementations, and make that ;; '(monolithic-compile-bundle-op monolithic-lib-op #-(or clasp ecl mkcl) monolithic-dll-op) :initform '(monolithic-compile-bundle-op #+(or clasp ecl mkcl) monolithic-lib-op) :allocation :class)) (:documentation "produce fasl and asd files for combined system and dependencies.")) (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation) ((gather-op :initform #+(or clasp ecl mkcl) 'lib-op #-(or clasp ecl mkcl) 'compile-bundle-op :allocation :class)) ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op :allocation :class) (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library :allocation :class)) (:documentation "Create a single fasl for the system and its dependencies.")) (defclass monolithic-load-bundle-op (monolithic-bundle-op load-bundle-op) Loading @@ -148,12 +163,13 @@ Compare with LIB-OP.")) (:documentation "Create a single linkable library for the system and its dependencies.")) (defclass monolithic-dll-op (monolithic-bundle-op dll-op non-propagating-operation) ((bundle-type :initform :dll)) ((gather-type :initform :static-library :allocation :class)) (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies.")) (defclass image-op (monolithic-bundle-op selfward-operation #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op) ((bundle-type :initform :image) #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class) (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) Loading @@ -163,17 +179,29 @@ Compare with LIB-OP.")) (defun bundle-pathname-type (bundle-type) (etypecase bundle-type ((eql :no-output-file) nil) ;; should we error out instead? ((or null string) bundle-type) ((eql :fasl) #-(or clasp ecl mkcl) (compile-file-type) #+(or clasp ecl mkcl) "fasb") #+(or clasp ecl) ((member :dll :lib :shared-library :static-library :program :object :program) (compile-file-type :type bundle-type)) ((member :image) #+allegro "dxl" #+(and clisp os-windows) "exe" #-(or allegro (and clisp os-windows)) "image") ((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) ((member :lib :static-library) (os-cond ((os-unix-p) "a") ((or null string) ;; pass through nil or string literal bundle-type) ((eql :no-output-file) ;; marker for a bundle-type that has NO output file (error "No output file, therefore no pathname type")) ((eql :fasl) ;; the type of a fasl #-(or clasp ecl mkcl) (compile-file-type) ; on image-based platforms, used as input and output #+(or clasp ecl mkcl) "fasb") ; on C-linking platforms, only used as output for system bundles ((member :image) #+allegro "dxl" #+(and clisp os-windows) "exe" #-(or allegro (and clisp os-windows)) "image") ;; NB: on CLASP and ECL these implementations, we better agree with ;; (compile-file-type :type bundle-type)) ((eql :object) ;; the type of a linkable object file (os-cond ((os-unix-p) "o") ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "o" "obj")))) ((member :lib :static-library) ;; the type of a linkable library (os-cond ((os-unix-p) "a") ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) ((eql :program) (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) ((member :dll :shared-library) ;; the type of a shared library (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) ((eql :program) ;; the type of an executable program (os-cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) (defun bundle-output-files (o c) (let ((bundle-type (bundle-type o))) Loading Loading @@ -238,16 +266,6 @@ Compare with LIB-OP.")) :force :force-not :plan-class) ;; TODO: refactor so we don't mix plan and operation arguments (operation-original-initargs instance)))) (defun bundlable-file-p (pathname) (let ((type (pathname-type pathname))) (declare (ignorable type)) (or #+(or clasp ecl) (or (equalp type (compile-file-type :type :object)) (equalp type (compile-file-type :type :static-library))) #+mkcl (or (equalp type (compile-file-type :fasl-p nil)) #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW #+(and windows (not (or mingw32 mingw64))) (equalp type "lib")) #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) (defgeneric* (trivial-system-p) (component)) (defun user-system-p (s) Loading Loading @@ -276,9 +294,14 @@ Compare with LIB-OP.")) (loop :for f :in (funcall key sub-o sub-c) :when (funcall test f) :do (collect f)))))) (defun pathname-type-equal-function (type) #'(lambda (p) (equal (pathname-type p) type))) (defmethod input-files ((o gather-op) (c system)) (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 :key 'output-files :test (pathname-type-equal-function (bundle-pathname-type (gather-type o)))))) (defun select-bundle-operation (type &optional monolithic) (ecase type Loading
lisp-action.lisp +7 −1 Original line number Diff line number Diff line Loading @@ -89,7 +89,13 @@ &optional #+(or clasp ecl mkcl) object-file #+clisp lib-file warnings-file) outputs warnings-file &rest rest) outputs ;; Allow for extra outputs that are not of type warnings-file ;; The way we do it is kludgy. In ASDF4, output-files shall not be positional. (declare (ignore rest)) (when warnings-file (unless (equal (pathname-type warnings-file) (warnings-file-type)) (setf warnings-file nil))) (call-with-around-compile-hook c #'(lambda (&rest flags) (apply 'compile-file* input-file Loading
plan.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -224,7 +224,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (latest-in (stamps-latest (cons dep-stamp in-stamps)))) (when (and missing-in (not just-done)) (return (values t nil)))) ;; collect timestamps from outputs, and exit early if any is missing (let* ((out-files (output-files o c)) (let* ((out-files (remove-if 'null (output-files o c))) (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) (earliest-out (stamps-earliest out-stamps))) Loading
test/test-bundle.script +10 −3 Original line number Diff line number Diff line Loading @@ -49,28 +49,35 @@ (operate 'monolithic-compile-bundle-op :test-asdf/bundle-2) (assert (probe-file *mono-bundle-2*)) ;;; Test dll-op and monolithic-dll-op on ECL and MKCL #+(or ecl mkcl) (progn (DBG "On ECL and MKCL, test dll-op and monolithic-dll-op") #+ecl (trace c::builder) (require 'sockets) ;; Test the pre-compiled system feature ;; Test that we didn't break require for non-asdf modules (DBG "Test the pre-compiled system feature") (require 'sockets) (progn (DBG "Test that we didn't break require for non-asdf modules") (pop #+ecl ext:*module-provider-functions* #+mkcl mk-ext:*module-provider-functions*) (require 'serve-event)) (DBG "Create a DLL via dll-op") (operate 'dll-op :test-asdf/dll-test) (DBG "Load the DLL") (let ((dll (first (output-files 'dll-op :test-asdf/dll-test)))) (si:load-foreign-module dll) (DBG "Load a library that knows how to use the DLL") (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) (operate 'load-op :test-asdf/dll-user))) (DBG "Test that the DLL works") (assert-equal (test-package::sample-function) 42) (DBG "Create a DLL via monolithic-dll-op") (nest #+(and mkcl windows) (let* ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1))) (compiler::*builder-default-libraries* (list (namestring lib))))) (operate 'monolithic-dll-op :test-asdf/monodll)) (DBG "Use and test that DLL") (let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll)))) (si:load-foreign-module dll) (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) Loading