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

Some cleanups after MKCL support.

parent 41ad564b

asdf.asd

+1 −1
Original line number Diff line number Diff line
@@ -58,7 +58,7 @@ 
   (:file "source-registry" :depends-on ("find-system"))

   (:file "backward-internals" :depends-on ("lisp-action" "operate"))

   (:file "parse-defsystem" :depends-on ("backward-internals" "cache" "system"))

   (:file "bundle" :depends-on ("lisp-action" "operate"))

   (:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem"))

   (:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle"))

   (:file "backward-interface" :depends-on ("operate" "output-translations"))

   (:file "package-system" :depends-on ("system" "find-system" "parse-defsystem"))

bundle.lisp

+8 −10
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
  (:recycle :asdf/bundle :asdf)

  (:use :uiop/common-lisp :uiop :asdf/upgrade

   :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation

   :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate)

   :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem)

  (:export

   #:bundle-op #:bundle-op-build-args #:bundle-type

   #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files
@@ -47,8 +47,7 @@ itself.")) ;; operation on a system and its dependencies 


  #+mkcl

  (defclass program (bundle-system)

    (

     (prologue-code :initarg :prologue-code :initform nil :accessor prologue-code)

    ((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)
@@ -205,12 +204,12 @@ itself.")) ;; operation on a system and its dependencies 
            (unless (typep instance 'program-op)

              (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 #-mkcl lisp-files prologue-code epilogue-code

      (destructuring-bind (&key lisp-files prologue-code epilogue-code

                           &allow-other-keys)

          (operation-original-initargs instance)

        (setf (prologue-code instance) prologue-code

              (epilogue-code instance) epilogue-code)

        #-(or ecl mkcl) (assert (null (or lisp-files epilogue-code prologue-code)))

        #-ecl (assert (null (or lisp-files #-mkcl epilogue-code #-mkcl prologue-code)))

        #+ecl (setf (bundle-op-lisp-files instance) lisp-files)))

    (setf (bundle-op-build-args instance)

          (remove-plist-keys
@@ -357,20 +356,19 @@ itself.")) ;; operation on a system and its dependencies 
    nil)



  (defmethod perform ((o basic-fasl-op) (c prebuilt-system))

    nil))

    nil)



  (defmethod perform ((o lib-op) (c prebuilt-system))

    nil)



  (defmethod perform ((o dll-op) (c prebuilt-system))

    nil))

    nil)



  (defmethod component-depends-on ((o gather-op) (c prebuilt-system))

    nil)



  (defmethod output-files ((o lib-op) (c prebuilt-system))

    (values (list (prebuilt-system-static-library c)) t))



    (values (list (prebuilt-system-static-library c)) t)))





;;;
@@ -415,7 +413,7 @@ itself.")) ;; operation on a system and its dependencies 
                (machine-type)

                (software-version))

        (let ((*package* (find-package :asdf-user)))

          (pprint `(asdf/defsystem:defsystem ,name

          (pprint `(defsystem ,name

                     :class prebuilt-system

                     :version ,version

                     :depends-on ,depends-on

test/hello-world-example.asd

+12 −20
Original line number Diff line number Diff line 
;; Example executable program



#-mkcl

(defsystem :hello-world-example

#.`(defsystem :hello-world-example

     ;; :build-operation program-op ; this would cause the executable output in same directory :-/

     :entry-point "hello:entry-point"

     :depends-on (:uiop)

  :components ((:file "hello")))



#+mkcl

(defsystem :hello-world-example

  :class asdf/bundle::program

  :build-operation program-op

  :entry-point "hello:entry-point"

  :depends-on (:uiop)

     :components ((:file "hello"))

  :prefix-lisp-object-files #.(list (namestring (truename (translate-logical-pathname #P"SYS:cmp.a"))))

  :extra-build-args #.(or #-windows '(:use-mkcl-shared-libraries nil))

     #+mkcl

     ,@`(:prefix-lisp-object-files (,(namestring (truename (translate-logical-pathname #P"SYS:cmp.a"))))

         :extra-build-args ,(or #-windows '(:use-mkcl-shared-libraries nil))

         :epilogue-code (progn

                          (setq uiop/image:*image-dumped-p* :executable)

                   (uiop/image:restore-image :entry-point (read-from-string "hello:entry-point"))))

                          (setq uiop/image:*lisp-interaction* nil)

                          (uiop/image:restore-image :entry-point (read-from-string "hello:entry-point")))))

test/hello.lisp

+1 −2
Original line number Diff line number Diff line
@@ -12,5 +12,4 @@ 
  t)



(defun entry-point ()

  (apply 'main *command-line-arguments*)

  #+mkcl (quit))
 
  (apply 'main *command-line-arguments*))

uiop/image.lisp

+1 −1
Original line number Diff line number Diff line
@@ -264,7 +264,7 @@ return a string that for the name with which the program was invoked, i.e. argv[ 
Otherwise, return NIL."

    (cond

      ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !

       ;; NB: not currently available on ABCL, Corman, Genera, MCL, MKCL

       ;; NB: not currently available on ABCL, Corman, Genera, MCL

       (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)

           (first (raw-command-line-arguments))

           #+ecl (si:argv 0) #+mkcl (mkcl:argv 0)))