From 81438c4879cd3bd7d7bcea7b00fc5f20346b761f Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 17 Mar 2014 16:01:34 -0400
Subject: [PATCH] Some cleanups after MKCL support.

---
 asdf.asd                     |  2 +-
 bundle.lisp                  | 18 ++++++++----------
 test/hello-world-example.asd | 32 ++++++++++++--------------------
 test/hello.lisp              |  3 +--
 uiop/image.lisp              |  2 +-
 5 files changed, 23 insertions(+), 34 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index 940485c7..2c941b75 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -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"))
diff --git a/bundle.lisp b/bundle.lisp
index 27696b57..15226f81 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -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
diff --git a/test/hello-world-example.asd b/test/hello-world-example.asd
index d7deb19f..90aa5556 100644
--- a/test/hello-world-example.asd
+++ b/test/hello-world-example.asd
@@ -1,22 +1,14 @@
 ;; Example executable program
 
-#-mkcl
-(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))
-  :epilogue-code (progn
-                   (setq uiop/image:*image-dumped-p* :executable)
-                   (uiop/image:restore-image :entry-point (read-from-string "hello:entry-point"))))
-
+#.`(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
+     ,@`(: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)
+                          (setq uiop/image:*lisp-interaction* nil)
+                          (uiop/image:restore-image :entry-point (read-from-string "hello:entry-point")))))
diff --git a/test/hello.lisp b/test/hello.lisp
index edae1073..7bcdaf9c 100644
--- a/test/hello.lisp
+++ b/test/hello.lisp
@@ -12,5 +12,4 @@
   t)
 
 (defun entry-point ()
-  (apply 'main *command-line-arguments*)
-  #+mkcl (quit))
+  (apply 'main *command-line-arguments*))
diff --git a/uiop/image.lisp b/uiop/image.lisp
index c7100266..b6a884e2 100644
--- a/uiop/image.lisp
+++ b/uiop/image.lisp
@@ -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)))
-- 
GitLab