diff --git a/.gitignore b/.gitignore index 4a7c338733b8606c319aff7a3eea1e2ac2511141..e54d739f31b6a774886f8c31199419ac9d6b4f69 100644 --- a/.gitignore +++ b/.gitignore @@ -1,12 +1,8 @@ # really this is private to my build process -make/ -common-lisp.net -.vcs -init-lisp.lisp -website/changelog.xml push resbcl reccl +reecl # Temporary files from documentation build doc/asdf/ @@ -28,9 +24,7 @@ doc/asdf.vrs # We build these at various stages in the make process LICENSE -website/output/ tmp/ -lift-local.config *.dribble *.fasl *.dfsl @@ -38,5 +32,6 @@ lift-local.config *.fas *.lib *.o +*.a *.*fsl *.bak diff --git a/asdf-ecl.lisp b/asdf-ecl.lisp index acec80f7c51aae828945193b6c88776d16896aae..1430d9907b6de0fea7317483608910b2e56bd0ed 100644 --- a/asdf-ecl.lisp +++ b/asdf-ecl.lisp @@ -52,12 +52,12 @@ (prologue-code :accessor monolithic-op-prologue-code) (epilogue-code :accessor monolithic-op-epilogue-code))) -(defclass monolithic-fasl-op (fasl-op monolithic-bundle-op) ()) +(defclass monolithic-fasl-op (monolithic-bundle-op fasl-op) ()) -(defclass monolithic-lib-op (lib-op monolithic-bundle-op) +(defclass monolithic-lib-op (monolithic-bundle-op lib-op) ((type :initform :lib))) -(defclass monolithic-dll-op (dll-op monolithic-bundle-op) +(defclass monolithic-dll-op (monolithic-bundle-op dll-op) ((type :initform :dll))) (defclass program-op (monolithic-bundle-op) @@ -141,6 +141,7 @@ ;;; with the static library of this module. ;;; (defmethod bundle-sub-operations ((o dll-op) c) + (declare (ignore o)) (list (cons (make-instance 'lib-op) c))) ;;; ;;; FASL FILES @@ -148,6 +149,7 @@ ;;; Gather the statically linked library of this component. ;;; (defmethod bundle-sub-operations ((o fasl-op) c) + (declare (ignore o)) (list (cons (make-instance 'lib-op) c))) (defmethod component-depends-on ((o bundle-op) (c system)) @@ -157,9 +159,11 @@ (component-name dep)))) (defmethod component-depends-on ((o lib-op) (c system)) + (declare (ignore o)) (list (list 'compile-op (component-name c)))) (defmethod component-depends-on ((o bundle-op) c) + (declare (ignore o c)) nil) (defmethod input-files ((o bundle-op) (c system)) @@ -173,17 +177,21 @@ (component-relative-pathname c))))) (defmethod output-files ((o fasl-op) (c system)) + (declare (ignore c)) (loop for file in (call-next-method) collect (make-pathname :type "fasb" :defaults file))) (defmethod perform ((o bundle-op) (c t)) + (declare (ignore o c)) t) (defmethod operation-done-p ((o bundle-op) (c source-file)) + (declare (ignore o c)) t) (defmethod perform ((o bundle-op) (c system)) - (let* ((object-files (remove "fas" (input-files o c) :key #'pathname-type :test #'string=)) + (let* ((object-files (remove "fas" (input-files o c) + :key #'pathname-type :test #'string=)) (output (output-files o c))) (ensure-directories-exist (first output)) (apply #'c::builder (bundle-op-type o) (first output) :lisp-files object-files @@ -197,6 +205,8 @@ (defun select-operation (monolithic type) (ecase type + ((:binary) + (if monolithic 'monolithic-binary-op 'binary-op)) ((:dll :shared-library) (if monolithic 'monolithic-dll-op 'dll-op)) ((:lib :static-library) @@ -206,37 +216,31 @@ ((:program) 'program-op))) - (defun make-build (system &rest args &key (monolithic nil) (type :fasl) (move-here nil move-here-p) &allow-other-keys) (let* ((operation-name (select-operation monolithic type)) + (move-here-path (if (and move-here + (typep move-here '(or pathname string))) + (pathname move-here) + (merge-pathnames "./asdf-output/"))) (operation (apply #'operate operation-name system (remove-keys '(monolithic type move-here) args))) (system (find-system system)) (files (and system (output-files operation system)))) - (print files) - (print move-here) - (if (or move-here - (and (null move-here-p) - (member operation-name '(:program)))) - (loop for path in files - for filename = (namestring (truename path)) - for new-path = (make-pathname :name (pathname-name path) - :type (pathname-type path) - :defaults *default-pathname-defaults*) - for new-filename = (namestring new-path) - for command = - #+windows - (format nil "move ~S ~S" filename new-filename) - #-windows - (format nil "mv ~S ~S" filename new-filename) - do (unless (equalp new-filename filename) - (when (plusp (si::system (print command))) - (error "Unable to move file~& ~S~&to new location~& ~S" - path new-path))) - collect new-path) + (if (or move-here (and (null move-here-p) + (member operation-name '(:program :binary)))) + (loop with dest-path = (truename (ensure-directories-exist move-here-path)) + for f in files + for new-f = (make-pathname :name (pathname-name f) + :type (pathname-type f) + :defaults dest-path) + do (progn + (when (probe-file new-f) + (delete-file new-f)) + (rename-file f new-f)) + collect new-f) files))) ;;; @@ -257,10 +261,12 @@ (component-depends-on (make-instance 'load-op) c))))) (defmethod input-files ((o load-fasl-op) (c system)) + (declare (ignore o)) (unless (trivial-system-p c) (output-files (make-instance 'fasl-op) c))) (defmethod perform ((o load-fasl-op) (c t)) + (declare (ignore o c)) nil) (defmethod perform ((o load-fasl-op) (c system)) @@ -287,14 +293,19 @@ :type "fas"))) (defmethod output-files (o (c compiled-file)) + (declare (ignore o c)) nil) (defmethod input-files (o (c compiled-file)) + (declare (ignore o c)) nil) (defmethod perform ((o load-op) (c compiled-file)) + (declare (ignore o)) (load (component-pathname c))) (defmethod perform ((o load-fasl-op) (c compiled-file)) + (declare (ignore o)) (load (component-pathname c))) (defmethod perform (o (c compiled-file)) + (declare (ignore o c)) nil) ;;; @@ -304,6 +315,7 @@ ((static-library :accessor prebuilt-system-static-library :initarg :lib))) (defmethod output-files ((o lib-op) (c prebuilt-system)) + (declare (ignore o)) (values (list (compile-file-pathname (prebuilt-system-static-library c) :type :lib)) t ; Advertise that we do not want this path renamed @@ -313,22 +325,89 @@ (car (output-files o c))) (defmethod component-depends-on ((o lib-op) (c prebuilt-system)) + (declare (ignore o c)) nil) (defmethod bundle-sub-operations ((o lib-op) (c prebuilt-system)) + (declare (ignore o c)) nil) (defmethod bundle-sub-operations ((o monolithic-lib-op) (c prebuilt-system)) + (declare (ignore o c)) (error "Prebuilt system ~S shipped with ECL can not be used in a monolithic library operation." c)) (defmethod bundle-sub-operations ((o monolithic-bundle-op) (c prebuilt-system)) + (declare (ignore o c)) nil) +;;; +;;; PREBUILT SYSTEM CREATOR +;;; + +(defclass binary-op (bundle-op) + ()) + +(defclass monolithic-binary-op (binary-op monolithic-bundle-op) + ()) + +(defun binary-op-dependencies (o s) + (let (lib-op fasl-op) + (if (bundle-op-monolithic-p o) + (setf lib-op 'monolithic-lib-op + fasl-op 'monolithic-fasl-op) + (setf lib-op 'lib-op + fasl-op 'fasl-op)) + (list (list (make-instance lib-op :args (bundle-op-build-args o)) + s) + (list (make-instance fasl-op :args (bundle-op-build-args o)) + s)))) + +(defmethod component-depends-on ((o binary-op) (s system)) + (loop for dep in (binary-op-dependencies o s) + append (apply #'component-depends-on dep))) + +(defmethod input-files ((o binary-op) (s system)) + (loop for dep in (binary-op-dependencies o s) + append (apply #'input-files dep))) + +(defmethod output-files ((o binary-op) (s system)) + (list* (merge-pathnames* (make-pathname :name (component-name s) + :type "asd") + (component-relative-pathname s)) + (loop for dep in (binary-op-dependencies o s) + append (apply #'output-files dep)))) + +(defmethod perform ((o binary-op) (s system)) + (let* ((dependencies (binary-op-dependencies o s)) + (library (first (apply #'output-files (first dependencies)))) + (fasl (first (apply #'output-files (second dependencies)))) + (filename (first (output-files o s))) + (name (component-name s)) + (name-keyword (intern (string name) (find-package :keyword)))) + (loop for dep in dependencies + do (apply #'perform dep)) + (with-open-file (s filename :direction :output :if-exists :supersede + :if-does-not-exist :create) + (format s ";;; Prebuilt ASDF definition for system ~A" name) + (format s ";;; Built for ~A ~A on a ~A/~A ~A" + (lisp-implementation-type) + (lisp-implementation-version) + (software-type) + (machine-type) + (software-version)) + (let ((*package* (find-package :keyword))) + (pprint `(defsystem ,name-keyword + :class asdf::prebuilt-system + :components ((:compiled-file ,(pathname-name fasl))) + :lib ,(make-pathname :name (pathname-name library) + :type (pathname-type library))) + s))))) + ;;; ;;; Final integration steps ;;; -(export '(make-build load-fasl-op)) +(export '(make-build load-fasl-op prebuilt-system)) (push '("fasb" . si::load-binary) si::*load-hooks*) (require 'cmp) diff --git a/asdf.lisp b/asdf.lisp index 60b8e66abe6877311cc19f212cdbeb740703de57..43b61894572f9a7986444075301ea0a041993795 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -63,7 +63,7 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.709" (1+ (length "VERSION")))) + (subseq "VERSION:1.710" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf @@ -278,7 +278,7 @@ (eval `(defparameter ,(intern (string versym) (find-package :asdf)) ,asdf-version)))))) -(in-package #:asdf) +(in-package :asdf) ;;;; ------------------------------------------------------------------------- ;;;; User-visible parameters