Loading bundle.lisp +17 −9 Original line number Diff line number Diff line Loading @@ -45,6 +45,7 @@ itself.")) ;; operation on a system and its dependencies ;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system ((prologue-code :initform nil :initarg :prologue-code :reader prologue-code) (epilogue-code :initform nil :initarg :epilogue-code :reader epilogue-code) (no-uiop :initform nil :initarg :no-uiop :reader no-uiop) (prefix-lisp-object-files :initarg :prefix-lisp-object-files :initform nil :accessor prefix-lisp-object-files) (postfix-lisp-object-files :initarg :postfix-lisp-object-files Loading @@ -56,6 +57,7 @@ itself.")) ;; operation on a system and its dependencies (defmethod prologue-code ((x t)) nil) (defmethod epilogue-code ((x t)) nil) (defmethod no-uiop ((x t)) nil) (defmethod prefix-lisp-object-files ((x t)) nil) (defmethod postfix-lisp-object-files ((x t)) nil) (defmethod extra-object-files ((x t)) nil) Loading Loading @@ -219,7 +221,8 @@ itself.")) ;; operation on a system and its dependencies #+ecl (setf (extra-object-files instance) lisp-files))) (setf (extra-build-args instance) (remove-plist-keys '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files) '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files :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) Loading Loading @@ -469,25 +472,29 @@ itself.")) ;; operation on a system and its dependencies ;; (setf *load-system-operation* 'load-bundle-op)) (defun asdf-library-pathname () #+ecl (compile-file-pathname "sys:asdf" :type :lib) #+ecl (compile-file-pathname "sys:asdf" :type :object) #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;asdf")) (defun compiler-library-pathname () #+ecl (compile-file-pathname "sys:cmp" :type :lib) #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:cmp")) (defun make-library-system (name pathname) (make-instance 'prebuilt-system :name name :static-library (resolve-symlinks* pathname))) (make-instance 'prebuilt-system :name (coerce-name name) :static-library (resolve-symlinks* pathname))) (defmethod component-depends-on :around ((o image-op) (c system)) (destructuring-bind ((lib-op . deps)) (call-next-method) (flet ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))) `((,lib-op #+mkcl ,@(unless (has-it-p "cmp") ,@(unless (or (no-uiop c) (has-it-p "cmp")) `(,(make-library-system "cmp" (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:cmp")))) ,@(unless (or (has-it-p "asdf") (has-it-p "uiop")) "cmp" (compiler-library-pathname)))) ,@(unless (or (no-uiop c) (has-it-p "uiop") (has-it-p "asdf")) `(,(cond ((system-source-directory :uiop) (find-system :uiop)) ((system-source-directory :asdf) (find-system :asdf)) (t (make-fake-asdf-system "asdf" (asdf-library-pathname)))))) (t (make-library-system "asdf" (asdf-library-pathname)))))) ,@deps))))) (defmethod perform ((o link-op) (c system)) Loading @@ -507,6 +514,7 @@ itself.")) ;; operation on a system and its dependencies :epilogue-code (or (epilogue-code o) (when programp (epilogue-code c))) :build-args (or (extra-build-args o) (when programp (extra-build-args c))) :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) Loading test/test-program.script +21 −3 Original line number Diff line number Diff line ;;; -*- Lisp -*- (DBG :foo (current-lisp-file-pathname)) #+mkcl (trace perform create-image component-depends-on) ;; compiler::build-shared-library compiler::build-static-library compiler::build-bundle compiler::build-program #+ecl (trace perform create-image c::builder component-depends-on) (unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t) (DBG "Creating images is not supported on your CL implementation") (leave-test "Skipping test" 0)) Loading Loading @@ -112,4 +109,25 @@ " \"b c\"" " \"d\"")) #+(or ecl mkcl) (progn (DBG "Now create an program without UIOP") (assert (probe-file (asdf/bundle::asdf-library-pathname))) (assert (probe-file (asdf/bundle::compiler-library-pathname))) (def-test-system hello-no-uiop :class program-system :no-uiop t :components ((:file "file1")) :epilogue-code (progn (format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop)) (format t "~:[But no TEST-PACKAGE :-(~;But TEST-PACKAGE~]!~%" (find-package :test-package)) #+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0))) (operate 'program-op 'hello-no-uiop :force t) (DBG :run (output-file 'program-op 'hello-no-uiop)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop))) :output :lines :error-output t) '("Look ma, no UIOP!" "But TEST-PACKAGE!"))) ;;; TODO: include a regular system dependency and a prebuilt-system in the executable. uiop/image.lisp +21 −17 Original line number Diff line number Diff line Loading @@ -419,7 +419,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (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) (entry-point () entry-point-p) build-args no-uiop) (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)) Loading @@ -429,7 +429,10 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ;; and otherwise simulate dump-image, including quitting at the end. #-(or ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image) #+(or ecl mkcl) (let ((epilogue-forms (let ((epilogue-code (if no-uiop epilogue-code (let ((forms (append (when epilogue-code `(,epilogue-code)) (when postludep `((setf *image-postlude* ',postlude))) Loading @@ -444,6 +447,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." `((setf *image-dumped-p* :executable) (shell-boolean-exit (restore-image)))))))) (when forms `(progn ,@forms)))))) #+ecl (check-type kind (member :dll :lib :static-library :program :object :fasl)) (apply #+ecl 'c::builder #+ecl kind #+mkcl (ecase kind Loading @@ -456,7 +460,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." #+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))) (when epilogue-code `(:epilogue-code ,epilogue-code)) #+mkcl (when extra-object-files `(:object-files ,extra-object-files)) build-args))))) Loading Loading
bundle.lisp +17 −9 Original line number Diff line number Diff line Loading @@ -45,6 +45,7 @@ itself.")) ;; operation on a system and its dependencies ;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system ((prologue-code :initform nil :initarg :prologue-code :reader prologue-code) (epilogue-code :initform nil :initarg :epilogue-code :reader epilogue-code) (no-uiop :initform nil :initarg :no-uiop :reader no-uiop) (prefix-lisp-object-files :initarg :prefix-lisp-object-files :initform nil :accessor prefix-lisp-object-files) (postfix-lisp-object-files :initarg :postfix-lisp-object-files Loading @@ -56,6 +57,7 @@ itself.")) ;; operation on a system and its dependencies (defmethod prologue-code ((x t)) nil) (defmethod epilogue-code ((x t)) nil) (defmethod no-uiop ((x t)) nil) (defmethod prefix-lisp-object-files ((x t)) nil) (defmethod postfix-lisp-object-files ((x t)) nil) (defmethod extra-object-files ((x t)) nil) Loading Loading @@ -219,7 +221,8 @@ itself.")) ;; operation on a system and its dependencies #+ecl (setf (extra-object-files instance) lisp-files))) (setf (extra-build-args instance) (remove-plist-keys '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files) '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files :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) Loading Loading @@ -469,25 +472,29 @@ itself.")) ;; operation on a system and its dependencies ;; (setf *load-system-operation* 'load-bundle-op)) (defun asdf-library-pathname () #+ecl (compile-file-pathname "sys:asdf" :type :lib) #+ecl (compile-file-pathname "sys:asdf" :type :object) #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;asdf")) (defun compiler-library-pathname () #+ecl (compile-file-pathname "sys:cmp" :type :lib) #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:cmp")) (defun make-library-system (name pathname) (make-instance 'prebuilt-system :name name :static-library (resolve-symlinks* pathname))) (make-instance 'prebuilt-system :name (coerce-name name) :static-library (resolve-symlinks* pathname))) (defmethod component-depends-on :around ((o image-op) (c system)) (destructuring-bind ((lib-op . deps)) (call-next-method) (flet ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))) `((,lib-op #+mkcl ,@(unless (has-it-p "cmp") ,@(unless (or (no-uiop c) (has-it-p "cmp")) `(,(make-library-system "cmp" (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:cmp")))) ,@(unless (or (has-it-p "asdf") (has-it-p "uiop")) "cmp" (compiler-library-pathname)))) ,@(unless (or (no-uiop c) (has-it-p "uiop") (has-it-p "asdf")) `(,(cond ((system-source-directory :uiop) (find-system :uiop)) ((system-source-directory :asdf) (find-system :asdf)) (t (make-fake-asdf-system "asdf" (asdf-library-pathname)))))) (t (make-library-system "asdf" (asdf-library-pathname)))))) ,@deps))))) (defmethod perform ((o link-op) (c system)) Loading @@ -507,6 +514,7 @@ itself.")) ;; operation on a system and its dependencies :epilogue-code (or (epilogue-code o) (when programp (epilogue-code c))) :build-args (or (extra-build-args o) (when programp (extra-build-args c))) :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) Loading
test/test-program.script +21 −3 Original line number Diff line number Diff line ;;; -*- Lisp -*- (DBG :foo (current-lisp-file-pathname)) #+mkcl (trace perform create-image component-depends-on) ;; compiler::build-shared-library compiler::build-static-library compiler::build-bundle compiler::build-program #+ecl (trace perform create-image c::builder component-depends-on) (unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t) (DBG "Creating images is not supported on your CL implementation") (leave-test "Skipping test" 0)) Loading Loading @@ -112,4 +109,25 @@ " \"b c\"" " \"d\"")) #+(or ecl mkcl) (progn (DBG "Now create an program without UIOP") (assert (probe-file (asdf/bundle::asdf-library-pathname))) (assert (probe-file (asdf/bundle::compiler-library-pathname))) (def-test-system hello-no-uiop :class program-system :no-uiop t :components ((:file "file1")) :epilogue-code (progn (format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop)) (format t "~:[But no TEST-PACKAGE :-(~;But TEST-PACKAGE~]!~%" (find-package :test-package)) #+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0))) (operate 'program-op 'hello-no-uiop :force t) (DBG :run (output-file 'program-op 'hello-no-uiop)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop))) :output :lines :error-output t) '("Look ma, no UIOP!" "But TEST-PACKAGE!"))) ;;; TODO: include a regular system dependency and a prebuilt-system in the executable.
uiop/image.lisp +21 −17 Original line number Diff line number Diff line Loading @@ -419,7 +419,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (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) (entry-point () entry-point-p) build-args no-uiop) (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)) Loading @@ -429,7 +429,10 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ;; and otherwise simulate dump-image, including quitting at the end. #-(or ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image) #+(or ecl mkcl) (let ((epilogue-forms (let ((epilogue-code (if no-uiop epilogue-code (let ((forms (append (when epilogue-code `(,epilogue-code)) (when postludep `((setf *image-postlude* ',postlude))) Loading @@ -444,6 +447,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." `((setf *image-dumped-p* :executable) (shell-boolean-exit (restore-image)))))))) (when forms `(progn ,@forms)))))) #+ecl (check-type kind (member :dll :lib :static-library :program :object :fasl)) (apply #+ecl 'c::builder #+ecl kind #+mkcl (ecase kind Loading @@ -456,7 +460,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." #+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))) (when epilogue-code `(:epilogue-code ,epilogue-code)) #+mkcl (when extra-object-files `(:object-files ,extra-object-files)) build-args))))) Loading