From 0653be203724285e1590426b139354251e3df35d Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Wed, 1 Jul 2015 08:01:28 -0400
Subject: [PATCH] Add a default-image feature

Use it for allegro variants on Windows.
Also, use the console application build.exe on Windows (or buildi.exe as
appropriate) so that it's possible to capture Lisp standard output,
at the expense of not being able to run multithreaded code.
---
 allegro-variants.lisp | 18 ++++++++++++------
 lisp-invocation.asd   |  2 +-
 lisp-invocation.lisp  |  6 ++++--
 non-special.lisp      |  1 +
 4 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/allegro-variants.lisp b/allegro-variants.lisp
index 1750428..940480c 100644
--- a/allegro-variants.lisp
+++ b/allegro-variants.lisp
@@ -19,8 +19,12 @@ locations, you may simply specify the Allegro install directories using these va
   "Return a list of possible Allegro variants based on built-in information
 and environment variables.  The returned list is made up of argument lists for
 REGISTER-LISP-IMPLEMENTATION."
+  ;; Beware that on Windows, we use the non-multithreaded console application build.exe
+  ;; so that we may have console I/O on the existing stdin and stdout, that we may capture.
   (while-collecting (c)
-    (loop :for (smpvar smpname smpfullname) :in `(("" "" "") ("S" :_s " (SMP)")) :do
+    (loop
+      :with windowsp = (os-windows-p)
+      :for (smpvar smpname smpfullname) :in `(("" "" "") ("S" :_s " (SMP)")) :do
       (loop
         :for (bitsvar bitsname bitsfullname) :in '(("" "" "") ("64" "_64" " (64-bit words)"))
         :for dirvar = (format nil "~:@(ALLEGRO~A~A~)" bitsvar smpvar)
@@ -33,9 +37,14 @@ REGISTER-LISP-IMPLEMENTATION."
               :for fullname = (strcat "Allegro CL"
                                       casefullname charfullname bitsfullname smpfullname)
               :for executable = (format nil "~(~alisp~a~)" caseexe charname) :do
+              :for (exepath imgpath) = (if windowsp
+                                           (list (subpathname dir (if (emptyp charfullname) "buildi.exe" "build.exe"))
+                                                 (subpathname dir executable :type "dxl"))
+                                           (list (subpathname dir executable) nil))
                 (c `(,allegro-variant
                      :fullname ,fullname
-                     :name ,(native-namestring (subpathname dir executable))
+                     :name ,(native-namestring exepath)
+                     :default-image ,(native-namestring imgpath)
                      :feature :allegro ;; do we want a more discriminating feature expression?
                      :flags ("-qq")
                      :eval-flag "-e"
@@ -46,10 +55,7 @@ REGISTER-LISP-IMPLEMENTATION."
                      :image-executable-p nil
                      :standalone-executable nil
                      :argument-control t
-                     :disable-debugger ("-batch" ; see also -#D -#C -#!
-                                        ,@(when (and (os-windows-p)
-                                                     (not (getenvp "ALLEGRO_NOISY")))
-                                            '("+c")))
+                     :disable-debugger ("-batch") ; see also -#D -#C -#!
                      :quit-format "(excl:exit ~A :quiet t)"
                      :dump-format "(progn (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) (excl:dumplisp :name ~A :suppress-allegro-cl-banner t))"))))))))
 
diff --git a/lisp-invocation.asd b/lisp-invocation.asd
index e72fd21..60ab0ce 100644
--- a/lisp-invocation.asd
+++ b/lisp-invocation.asd
@@ -13,7 +13,7 @@
   (error "ASDF 3.1.2 required"))
 
 (defsystem "lisp-invocation"
-  :version "1.0.9"
+  :version "1.0.10"
   :author ("Francois-Rene Rideau")
   :maintainer "Francois-Rene Rideau"
   :licence "MIT"
diff --git a/lisp-invocation.lisp b/lisp-invocation.lisp
index ad91068..dc21b99 100644
--- a/lisp-invocation.lisp
+++ b/lisp-invocation.lisp
@@ -48,6 +48,7 @@
   arguments-end
   image-flag
   image-executable-p
+  default-image
   standalone-executable
   argument-control
   disable-debugger
@@ -100,16 +101,17 @@ followed by a plist of keywords and arguments."
     (&key (implementation-type (implementation-type))
        lisp-path
        (lisp-flags :default)
-       image-path
+       (image-path nil image-path-p)
        load
        eval
        arguments
        debugger
        cross-compile)
   (with-slots (name flags disable-debugger load-flag eval-flag
-	       image-flag image-executable-p standalone-executable
+	       image-flag default-image image-executable-p standalone-executable
 	       arguments-end argument-control)
       (get-lisp-implementation implementation-type)
+    (unless image-path-p (setf image-path default-image))
     (append
      (when (or (null image-path) (not image-executable-p))
        (ensure-list
diff --git a/non-special.lisp b/non-special.lisp
index dd3ae9b..a4acabc 100644
--- a/non-special.lisp
+++ b/non-special.lisp
@@ -1,3 +1,4 @@
+;; Composing command lines that don't use any special character.
 (defpackage :lisp-invocation/non-special
   (:use :common-lisp :uiop)
   (:export
-- 
GitLab