Skip to content
Snippets Groups Projects
Commit e24c1db0 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.32.21: more robust bundling on ECL.

parent 178b344b
No related branches found
No related tags found
No related merge requests found
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.32.20" ;; to be automatically updated by make bump-version :version "2.32.21" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
...@@ -30,8 +30,12 @@ ...@@ -30,8 +30,12 @@
#+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)
()
(:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files"))
;; create a single fasl for the entire library ;; create a single fasl for the entire library
(defclass basic-fasl-op (bundle-op basic-compile-op) (defclass basic-fasl-op (bundle-compile-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))) ((sideway-operation :initform 'load-fasl-op)))
...@@ -45,19 +49,19 @@ ...@@ -45,19 +49,19 @@
;; 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.
;; On ECL: compile the system and produce linkable ".a" library for it. (defclass lib-op (bundle-compile-op)
;; On others: just compile the system. ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
(defclass lib-op (bundle-op basic-compile-op) (:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it."
((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))) #-(or ecl mkcl) "just compile the system"))
(defclass dll-op (bundle-op basic-compile-op) (defclass dll-op (bundle-op basic-compile-op)
;; Link together all the dynamic library used by this system into a single one. ((bundle-type :initform :dll))
((bundle-type :initform :dll))) (:documentation "Link together all the dynamic library used by this system into a single one."))
(defclass binary-op (bundle-op basic-compile-op selfward-operation) (defclass binary-op (bundle-op basic-compile-op selfward-operation)
;; On ECL: produce lib and fasl for the system. ((selfward-operation :initform '(lib-op fasl-op)))
;; On "normal" Lisps: produce just the fasl. (:documentation #+(or ecl mkcl) "produce lib and fasl for the system."
((selfward-operation :initform '(lib-op fasl-op)))) #-(or ecl mkcl) "produce a fasl for the system"))
(defclass monolithic-op (operation) ()) ;; operation on a system and its dependencies (defclass monolithic-op (operation) ()) ;; operation on a system and its dependencies
...@@ -65,27 +69,34 @@ ...@@ -65,27 +69,34 @@
((prologue-code :accessor monolithic-op-prologue-code) ((prologue-code :accessor monolithic-op-prologue-code)
(epilogue-code :accessor monolithic-op-epilogue-code))) (epilogue-code :accessor monolithic-op-epilogue-code)))
(defclass monolithic-binary-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation) (defclass monolithic-bundle-compile-op (monolithic-bundle-op bundle-compile-op)
;; On ECL: produce lib and fasl for combined system and dependencies. ()
;; On "normal" Lisps: produce an image file from system and dependencies. (:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files over all systems"))
((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op))))
;; Create a single fasl for the system and its dependencies. (defclass monolithic-binary-op (monolithic-bundle-compile-op sideway-operation selfward-operation)
(defclass monolithic-fasl-op (monolithic-bundle-op basic-fasl-op) ()) ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op)))
(:documentation
#+ecl "produce lib and fasl for combined system and dependencies."
#-ecl "produce an image file from system and dependencies (not implemented)."))
(defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op) ()
(:documentation "Create a single fasl for the system and its dependencies."))
(defclass monolithic-lib-op (monolithic-bundle-op basic-compile-op) (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op)
;; ECL: Create a single linkable library for the system and its dependencies. ((bundle-type :initform :lib))
((bundle-type :initform :lib))) (: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-op basic-compile-op sideway-operation selfward-operation) (defclass monolithic-dll-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation)
((bundle-type :initform :dll) ((bundle-type :initform :dll)
(selfward-operation :initform 'dll-op) (selfward-operation :initform 'dll-op)
(sideway-operation :initform 'dll-op))) (sideway-operation :initform 'dll-op)))
(defclass program-op (monolithic-bundle-op selfward-operation) (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op)
;; All: create an executable file from the system and its dependencies #-(or mkcl ecl) (monolithic-bundle-op selfward-operation)
((bundle-type :initform :program) ((bundle-type :initform :program)
(selfward-operation :initform #+(or mkcl ecl) 'monolithic-lib-op #-(or mkcl ecl) 'load-op))) #-(or mkcl ecl) (selfward-operation :initform #-(or mkcl ecl) 'load-op))
(:documentation "create an executable file from the system and its dependencies"))
(defun bundle-pathname-type (bundle-type) (defun bundle-pathname-type (bundle-type)
(etypecase bundle-type (etypecase bundle-type
...@@ -101,13 +112,14 @@ ...@@ -101,13 +112,14 @@
((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)
(let ((bundle-type (bundle-type o))) (when (input-files o c)
(unless (eq bundle-type :no-output-file) ;; NIL already means something regarding type. (let ((bundle-type (bundle-type o)))
(let ((name (or (component-build-pathname c) (unless (eq bundle-type :no-output-file) ;; NIL already means something regarding type.
(format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix)))) (let ((name (or (component-build-pathname c)
(type (bundle-pathname-type bundle-type))) (format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix))))
(values (list (subpathname (component-pathname c) name :type type)) (type (bundle-pathname-type bundle-type)))
(eq (type-of o) (component-build-operation c))))))) (values (list (subpathname (component-pathname c) name :type type))
(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))
...@@ -202,36 +214,16 @@ ...@@ -202,36 +214,16 @@
;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL ;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL
;;; ;;;
(with-upgradability () (with-upgradability ()
(defmethod component-depends-on ((o monolithic-lib-op) (c system)) (defmethod component-depends-on ((o bundle-compile-op) (c system))
(declare (ignorable o)) `(,(if (operation-monolithic-p o)
`((lib-op ,@(required-components c :other-systems t :component-type 'system `(#-(or ecl mkcl) fasl-op #+(or ecl mkcl) lib-op
:goal-operation (find-operation o 'load-op) ,@(required-components c :other-systems t :component-type 'system
:keep-operation 'compile-op)) :goal-operation (find-operation o 'load-op)
,@(call-next-method))) :keep-operation 'compile-op))
`(compile-op
,@(required-components c :other-systems nil :component-type '(not system)
(defmethod component-depends-on ((o monolithic-fasl-op) (c system)) :goal-operation (find-operation o 'load-op)
(declare (ignorable o)) :keep-operation 'compile-op)))
`((#-(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-fasl-op)
:keep-operation 'fasl-op))
,@(call-next-method)))
(defmethod component-depends-on ((o lib-op) (c system))
(declare (ignorable o))
`((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)))
#-ecl
(defmethod component-depends-on ((o fasl-op) (c system))
`(,@(component-depends-on (find-operation o 'lib-op) c)
,@(call-next-method)))
(defmethod component-depends-on ((o dll-op) c)
`(,@(component-depends-on (find-operation o 'lib-op) c)
,@(call-next-method))) ,@(call-next-method)))
(defmethod component-depends-on :around ((o bundle-op) (c component)) (defmethod component-depends-on :around ((o bundle-op) (c component))
...@@ -249,7 +241,7 @@ ...@@ -249,7 +241,7 @@
(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-op) (c system)) (defmethod input-files ((o bundle-compile-op) (c system))
(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)
...@@ -311,7 +303,8 @@ ...@@ -311,7 +303,8 @@
nil) nil)
(defmethod perform ((o load-fasl-op) (c system)) (defmethod perform ((o load-fasl-op) (c system))
(perform-lisp-load-fasl o c)) (when (input-files o c)
(perform-lisp-load-fasl o c)))
(defmethod mark-operation-done :after ((o load-fasl-op) (c system)) (defmethod mark-operation-done :after ((o load-fasl-op) (c system))
(mark-operation-done (find-operation o 'load-op) c))) (mark-operation-done (find-operation o 'load-op) c)))
...@@ -395,13 +388,13 @@ ...@@ -395,13 +388,13 @@
s))))) s)))))
#-(or ecl mkcl) #-(or ecl mkcl)
(defmethod perform ((o basic-fasl-op) (c system)) (defmethod perform ((o bundle-compile-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))
(output-files (output-files o c)) (output-files (output-files o c))
(output-file (first output-files))) (output-file (first output-files)))
(unless input-files (format t "WTF no input-files for ~S on ~S !???" o c)) ;;(unless input-files (format t "WTF no input-files for ~S on ~S !???" o c))
(when input-files (when input-files
(assert output-files) (assert output-files)
(when non-fasl-files (when non-fasl-files
...@@ -432,22 +425,23 @@ ...@@ -432,22 +425,23 @@
#+ecl #+ecl
(with-upgradability () (with-upgradability ()
(defmethod perform ((o bundle-op) (c system)) (defmethod perform ((o bundle-compile-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))
(kind (bundle-type o))) (kind (bundle-type o)))
(create-image (when output
bundle (append object-files (bundle-op-lisp-files o)) (create-image
:kind kind bundle (append object-files (bundle-op-lisp-files o))
:entry-point (component-entry-point c) :kind kind
:prologue-code :entry-point (component-entry-point c)
(when (typep o 'monolithic-bundle-op) :prologue-code
(monolithic-op-prologue-code o)) (when (typep o 'monolithic-bundle-op)
:epilogue-code (monolithic-op-prologue-code o))
(when (typep o 'monolithic-bundle-op) :epilogue-code
(monolithic-op-epilogue-code o)) (when (typep o 'monolithic-bundle-op)
:build-args (bundle-op-build-args o))))) (monolithic-op-epilogue-code o))
:build-args (bundle-op-build-args o))))))
#+mkcl #+mkcl
(with-upgradability () (with-upgradability ()
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.32.20: Another System Definition Facility. ;;; This is ASDF 2.32.21: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -2,11 +2,17 @@ ...@@ -2,11 +2,17 @@
#+lispworks (lispworks:load-all-patches) #+lispworks (lispworks:load-all-patches)
(load (make-pathname :name "script-support" :defaults *load-pathname*)) (load (make-pathname :name "script-support" :defaults *load-pathname*))
(load-asdf) (load-asdf)
(asdf-test::frob-packages)
#+ecl (require :cmp) #+ecl (require :cmp)
#+ecl (trace uiop:compile-file* uiop:load*)
(asdf-test::register-directory asdf-test::*asdf-directory*) ;; we need asdf-driver, and ECL can dump.
(asdf-test::register-directory asdf-test::*uiop-directory*)
(asdf:upgrade-asdf) ;; may recompile and rename away package asdf?
(asdf-test::frob-packages)
(with-test () (with-test ()
(register-directory *asdf-directory*) ;; we need asdf-driver, and ECL can dump. ;;(dolist (s '(:asdf :asdf/driver :asdf/defsystem :uiop)) (DBG :foo s (asdf::builtin-system-p (find-system s))))
(register-directory *uiop-directory*) (trace perform-plan perform)
(operate 'load-fasl-op :hello-world-example) (operate 'load-fasl-op :hello-world-example)
(operate 'program-op :hello-world-example)) (operate 'program-op :hello-world-example))
...@@ -64,3 +64,9 @@ ...@@ -64,3 +64,9 @@
(defsystem :test-asdf/test-source-directory-2 (defsystem :test-asdf/test-source-directory-2
:pathname "some/relative/pathname/with-file.type") :pathname "some/relative/pathname/with-file.type")
(defsystem :test-asdf/bundle-1
:components ((:file "file1") (:file "file3")))
(defsystem :test-asdf/bundle-2
:depends-on (:test-asdf/bundle-1) :components ((:file "file2")))
...@@ -8,26 +8,22 @@ ...@@ -8,26 +8,22 @@
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
(asdf:initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (asdf:initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(asdf:clear-system :test-bundle-1) (asdf:clear-system :test-asdf/bundle-1)
(asdf:clear-system :test-bundle-2) (asdf:clear-system :test-asdf/bundle-2)
(when (find-package :test-package) (delete-package :test-package)) (when (find-package :test-package) (delete-package :test-package))
(def-test-system :test-bundle-1
:components ((:file "file1") (:file "file3")))
(def-test-system :test-bundle-2
:depends-on (:test-bundle-1) :components ((:file "file2")))
#+(or abcl (and ecl ecl-bytecmp) gcl) #+(or abcl (and ecl ecl-bytecmp) gcl)
(leave-test "bundles not on this implementation" 0) (leave-test "bundles not on this implementation" 0)
(defparameter *bundle-1* (output-file 'fasl-op :test-bundle-1)) (defparameter *bundle-1* (output-file 'fasl-op :test-asdf/bundle-1))
(defparameter *bundle-2* (output-file 'fasl-op :test-bundle-2)) (defparameter *bundle-2* (output-file 'fasl-op :test-asdf/bundle-2))
(defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-bundle-2)) (defparameter *mono-bundle-2* (output-file 'monolithic-fasl-op :test-asdf/bundle-2))
(DBG :test-bundle *bundle-1* *bundle-2*) (DBG :test-bundle *bundle-1* *bundle-2*)
(assert-equal (list *bundle-2*) (assert-equal (list *bundle-2*)
(input-files 'load-fasl-op :test-bundle-2)) (input-files 'load-fasl-op :test-asdf/bundle-2))
(delete-file-if-exists *bundle-1*) (delete-file-if-exists *bundle-1*)
(delete-file-if-exists *bundle-2*) (delete-file-if-exists *bundle-2*)
(delete-file-if-exists *mono-bundle-2*) (delete-file-if-exists *mono-bundle-2*)
(operate 'load-fasl-op :test-bundle-2) (operate 'load-fasl-op :test-asdf/bundle-2)
(DBG "Check that the bundles were indeed created.") (DBG "Check that the bundles were indeed created.")
(assert (probe-file *bundle-2*)) (assert (probe-file *bundle-2*))
(assert (probe-file *bundle-1*)) (assert (probe-file *bundle-1*))
...@@ -35,5 +31,5 @@ ...@@ -35,5 +31,5 @@
(assert (symbol-value (find-symbol* :*file1* :test-package))) (assert (symbol-value (find-symbol* :*file1* :test-package)))
(assert (symbol-value (find-symbol* :*file3* :test-package))) (assert (symbol-value (find-symbol* :*file3* :test-package)))
(DBG "Now for the mono-fasl") (DBG "Now for the mono-fasl")
(operate 'monolithic-fasl-op :test-bundle-2) (operate 'monolithic-fasl-op :test-asdf/bundle-2)
(assert (probe-file *mono-bundle-2*)) (assert (probe-file *mono-bundle-2*))
...@@ -139,10 +139,11 @@ ...@@ -139,10 +139,11 @@
asdf/bundle:bundle-system asdf/bundle:bundle-system
asdf/bundle:register-pre-built-system asdf/bundle:register-pre-built-system
asdf/bundle:static-library asdf/bundle:static-library
asdf/os:parse-file-location-info uiop/lisp-build:sb-grovel-unknown-constant-condition
asdf/os:parse-windows-shortcut uiop/os:parse-file-location-info
asdf/os:read-little-endian uiop/os:parse-windows-shortcut
asdf/os:read-null-terminated-string uiop/os:read-little-endian
uiop/os:read-null-terminated-string
;; backward compatibility upgrade only ;; backward compatibility upgrade only
asdf/backward-internals:make-sub-operation asdf/backward-internals:make-sub-operation
asdf/find-system:contrib-sysdef-search asdf/find-system:contrib-sysdef-search
......
...@@ -15,6 +15,8 @@ ...@@ -15,6 +15,8 @@
#:compile-warned-warning #:compile-failed-warning #:compile-warned-warning #:compile-failed-warning
#:check-lisp-compile-results #:check-lisp-compile-warnings #:check-lisp-compile-results #:check-lisp-compile-warnings
#:*uninteresting-conditions* #:*uninteresting-compiler-conditions* #:*uninteresting-loader-conditions* #:*uninteresting-conditions* #:*uninteresting-compiler-conditions* #:*uninteresting-loader-conditions*
;; Types
#+sbcl #:sb-grovel-unknown-constant-condition
;; Functions & Macros ;; Functions & Macros
#:get-optimization-settings #:proclaim-optimization-settings #:get-optimization-settings #:proclaim-optimization-settings
#:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions
......
...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "2.32.20") (asdf-version "2.32.21")
(existing-version (asdf-version))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version))) (when (and existing-version (not (equal asdf-version existing-version)))
......
"2.32.20" "2.32.21"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment