Commit ef75676b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

1.710: update asdf-ecl, make gcl happier with in-package, refresh gitignore.

parent c26da0a3
# 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
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment