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

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

parent c26da0a3
Loading
Loading
Loading
Loading
+2 −7
Original line number Diff line number Diff line
# 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
+106 −27
Original line number Diff line number Diff line
@@ -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)
+2 −2
Original line number Diff line number Diff line
@@ -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