Commit f127ffb8 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Patch from Jean-Claude Beaudoin adding MKCL support.

parent 52bce047
Loading
Loading
Loading
Loading
+3 −0
Original line number Diff line number Diff line
@@ -60,7 +60,9 @@ all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
# Making ASDF itself should be our first, default, target:
build/asdf.lisp: $(all_lisp)
	mkdir -p build
	rm -f $@
	cat $(all_lisp) > $@
	chmod -w $@ # try to prevent accidental editing.

# This quickly locates such mistakes as unbalanced parentheses:
load: build/asdf.lisp
@@ -120,6 +122,7 @@ clean:
	     fi; \
	done
	rm -rf build/ LICENSE test/try-reloading-dependency.asd test/hello-world-example asdf.lisp
	rm -rf test/hello-world-example.exe test/mkcl_*.dll # needed only on MS-Windows
	rm -rf .pc/ build-stamp debian/patches/ debian/debhelper.log debian/cl-asdf/ # debian crap
	${MAKE} -C doc clean

+58 −17
Original line number Diff line number Diff line
@@ -26,9 +26,7 @@
    ((build-args :initarg :args :initform nil :accessor bundle-op-build-args)
     (name-suffix :initarg :name-suffix :initform nil)
     (bundle-type :initform :no-output-file :reader bundle-type)
     #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files)
     #+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)))
     #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files)))

  (defclass monolithic-op (operation) ()
    (:documentation "A MONOLITHIC operation operates on a system *and all of its
@@ -47,6 +45,20 @@ itself.")) ;; operation on a system and its dependencies
    ((prologue-code :accessor prologue-code)
     (epilogue-code :accessor epilogue-code)))

  #+mkcl
  (defclass program (bundle-system)
    (
     (prologue-code :initarg :prologue-code :initform nil :accessor prologue-code)
     (epilogue-code :initarg :epilogue-code :initform nil :accessor epilogue-code)
     (prefix-lisp-object-files :initarg :prefix-lisp-object-files
                               :initform nil :accessor program-prefix-lisp-object-files)
     (postfix-lisp-object-files :initarg :postfix-lisp-object-files
                                :initform nil :accessor program-postfix-lisp-object-files)
     (object-files :initarg :object-files
                   :initform nil :accessor program-object-files)
     (extra-build-args :initarg :extra-build-args
                       :initform nil :accessor program-extra-build-args)))

  (defmethod prologue-code ((x t)) nil)
  (defmethod epilogue-code ((x t)) nil)

@@ -77,7 +89,7 @@ itself.")) ;; operation on a system and its dependencies
    ((bundle-type :initform :fasl)))

  (defclass prepare-fasl-op (sideway-operation)
    ((sideway-operation :initform #+ecl 'load-fasl-op #-ecl 'load-op :allocation :class)))
    ((sideway-operation :initform #+(or ecl mkcl) 'load-fasl-op #-(or ecl mkcl) 'load-op :allocation :class)))

  (defclass lib-op (link-op gather-op non-propagating-operation)
    ((bundle-type :initform :lib))
@@ -123,7 +135,7 @@ itself.")) ;; operation on a system and its dependencies
  (defclass image-op (monolithic-bundle-op selfward-operation
                      #+ecl link-op #+(or ecl mkcl) gather-op)
    ((bundle-type :initform :image)
     (selfward-operation :initform '(#-ecl load-op) :allocation :class))
     (selfward-operation :initform '(#-(or ecl mkcl) load-op) :allocation :class))
    (:documentation "create an image file from the system and its dependencies"))

  (defclass program-op (image-op)
@@ -139,8 +151,9 @@ itself.")) ;; operation on a system and its dependencies
      ((member :dll :lib :shared-library :static-library :program :object :program)
       (compile-file-type :type bundle-type))
      ((member :image) "image")
      ((eql :dll) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
      ((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib")))
      ((member :dll :shared-library) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
      ((member :lib :static-library) (cond ((os-unix-p) "a")
					   ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib"))))
      ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe")))))

  (defun bundle-output-files (o c)
@@ -189,14 +202,14 @@ itself.")) ;; operation on a system and its dependencies
    (unless name-suffix-p
      (setf (slot-value instance 'name-suffix)
            (unless (typep instance 'program-op)
              (if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames
              (if (operation-monolithic-p instance) "--all-systems" #-(or ecl mkcl) "--system")))) ; . no good for Logical Pathnames
    (when (typep instance 'monolithic-bundle-op)
      (destructuring-bind (&key lisp-files prologue-code epilogue-code
      (destructuring-bind (&key #-mkcl lisp-files prologue-code epilogue-code
                           &allow-other-keys)
          (operation-original-initargs instance)
        (setf (prologue-code instance) prologue-code
              (epilogue-code instance) epilogue-code)
        #-ecl (assert (null (or lisp-files epilogue-code prologue-code)))
        #-(or ecl mkcl) (assert (null (or lisp-files epilogue-code prologue-code)))
        #+ecl (setf (bundle-op-lisp-files instance) lisp-files)))
    (setf (bundle-op-build-args instance)
          (remove-plist-keys
@@ -208,7 +221,9 @@ itself.")) ;; operation on a system and its dependencies
      (declare (ignorable type))
      (or #+ecl (or (equalp type (compile-file-type :type :object))
                    (equalp type (compile-file-type :type :static-library)))
          #+mkcl (equalp type (compile-file-type :fasl-p nil))
          #+mkcl (or (equalp type (compile-file-type :fasl-p nil))
                     #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW
                     #+(and windows (not (or mingw32 mingw64))) (equalp type "lib"))
          #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type)))))

  (defgeneric* (trivial-system-p) (component))
@@ -344,7 +359,15 @@ itself.")) ;; operation on a system and its dependencies
    nil)

  (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system))
    nil))
    nil)

  #+mkcl
  (defmethod perform ((o fasl-op) (c prebuilt-system))
    nil)

  #+mkcl
  (defmethod output-files ((o lib-op) (c prebuilt-system))
    (list (prebuilt-system-static-library c))))


;;;
@@ -361,6 +384,7 @@ itself.")) ;; operation on a system and its dependencies
           (library (second inputs))
           (asd (first (output-files o s)))
           (name (if (and fasl asd) (pathname-name asd) (return-from perform)))
           (version (component-version s))
           (dependencies
             (if (operation-monolithic-p o)
                 (remove-if-not 'builtin-system-p
@@ -388,8 +412,9 @@ itself.")) ;; operation on a system and its dependencies
                (machine-type)
                (software-version))
        (let ((*package* (find-package :asdf-user)))
          (pprint `(defsystem ,name
          (pprint `(asdf/defsystem:defsystem ,name
                     :class prebuilt-system
                     :version ,version
                     :depends-on ,depends-on
                     :components ((:compiled-file ,(pathname-name fasl)))
                     ,@(when library `(:lib ,(file-namestring library))))
@@ -430,7 +455,7 @@ itself.")) ;; operation on a system and its dependencies
(asdf:load-system :precompiled-asdf-utils)
|#

#+(or ecl mkcl)
#+ecl
(with-upgradability ()
  (defun uiop-library-file ()
    (or (and (find-system :uiop nil)
@@ -447,8 +472,10 @@ itself.")) ;; operation on a system and its dependencies
                  (and (system-source-directory :asdf)
                       (plan-operates-on-p plan '("asdf"))))
        (pushnew (uiop-library-file) files :test 'pathname-equal))
      files))
      files)))

#+(or ecl mkcl)
(with-upgradability ()
  (defun register-pre-built-system (name)
    (register-system (make-instance 'system :name (coerce-name name) :source-file nil))))

@@ -477,14 +504,28 @@ itself.")) ;; operation on a system and its dependencies

#+mkcl
(with-upgradability ()
  (defmethod perform ((o dll-op) (s system))
    (apply #'compiler::build-shared-library (output-file o s)
           :lisp-object-files (input-files o s) (bundle-op-build-args o)))

  (defmethod perform ((o lib-op) (s system))
    (apply #'compiler::build-static-library (output-file o c)
    (apply #'compiler::build-static-library (output-file o s)
           :lisp-object-files (input-files o s) (bundle-op-build-args o)))

  (defmethod perform ((o basic-fasl-op) (s system))
    (apply #'compiler::build-bundle (output-file o c) ;; second???
    (apply #'compiler::build-bundle (output-file o s)
           :lisp-object-files (input-files o s) (bundle-op-build-args o)))

  (defmethod perform ((o program-op) (s system))
    (apply #'compiler::build-program (output-file o s)
           :lisp-object-files (append (program-prefix-lisp-object-files s)
                                      (input-files o s)
                                      (program-postfix-lisp-object-files s))
           :object-files (program-object-files s)
           :prologue-code (prologue-code s)
           :epilogue-code (epilogue-code s)
           (program-extra-build-args s)))

  (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys)
    (declare (ignore force verbose version))
    (apply #'operate 'deliver-asd-op system args)))
+1 −1
Original line number Diff line number Diff line
@@ -20,7 +20,7 @@

  #+(or ecl mkcl)
  (progn
    (pushnew '("fasb" . si::load-binary) si:*load-hooks* :test 'equal :key 'car)
    (pushnew '("fasb" . si::load-binary) si::*load-hooks* :test 'equal :key 'car)

    #+(or (and ecl win32) (and mkcl windows))
    (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal)
+1 −1
Original line number Diff line number Diff line
@@ -155,8 +155,8 @@ system names to pathnames of .asd files")
  (defun wrapping-source-registry ()
    `(:source-registry
      #+(or ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory)))
      #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
      :inherit-configuration
      #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
      #+cmu (:tree #p"modules:")
      #+scl (:tree #p"file://modules/")))
  (defun default-source-registry ()
+10 −0
Original line number Diff line number Diff line
@@ -9,3 +9,13 @@ int sample_function()
	return 42;
}
")

#+mkcl
(ffi:clines "
extern MKCL_DLLEXPORT int sample_function(void);

int sample_function(void)
{
	return 42;
}
")
Loading