mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-04-27 19:50:44 -07:00
Implemented a new operation for building precompiled standalone systems.
This commit is contained in:
Juan Jose Garcia Ripoll
parent
9d43a9e9db
commit
062f864ab8
2 changed files with 108 additions and 24 deletions
|
|
@ -140,6 +140,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
|
||||
|
|
@ -147,6 +148,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))
|
||||
|
|
@ -156,9 +158,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))
|
||||
|
|
@ -172,17 +176,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
|
||||
|
|
@ -196,6 +204,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)
|
||||
|
|
@ -205,37 +215,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)))
|
||||
|
||||
;;;
|
||||
|
|
@ -256,10 +260,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))
|
||||
|
|
@ -286,14 +292,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)
|
||||
|
||||
;;;
|
||||
|
|
@ -303,6 +314,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
|
||||
|
|
@ -312,17 +324,82 @@
|
|||
(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))
|
||||
(pprint `(defsystem ,name-keyword
|
||||
:components ((:compiled-file ,(pathname-name fasl)))
|
||||
:lib ,(make-pathname :name (pathname-name library)
|
||||
:type (pathname-type library)))
|
||||
s))))
|
||||
|
||||
;;;
|
||||
;;; Final integration steps
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -40,12 +40,19 @@ ECL 10.3.2:
|
|||
are now stored both in FASL form and as statically linked libraries.
|
||||
|
||||
- ASDF:MAKE-BUILD now takes a new keyword argument, :MOVE-HERE, that allows
|
||||
moving the files that ASDF creates to the current directory.
|
||||
moving the files that ASDF creates to the current directory. :MOVE-HERE can
|
||||
be a flag, in which case the files are output at ./asdf-output/ or a
|
||||
pathname designator, in which case the directories are created.
|
||||
|
||||
- Gray streams implement a new generic function, GRAY:STREAM-FILE-DESCRIPTOR
|
||||
which is used by SERVE-EVENT to gather the system identifier which is used
|
||||
to wait on input from the device.
|
||||
|
||||
- ASDF:MAKE-BUILD admits a new type, :BINARY, which creates a standalone
|
||||
system (*.asd) accompanied by two binary files, statically linked library
|
||||
(.a or .lib), and a FASL (*.fasb). This can be used, to replace existing
|
||||
systems with precompiled ones.
|
||||
|
||||
ECL 10.3.1:
|
||||
===========
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue