anchor.diff:     #+os-windows escape-windows-command
      command stream))
   
  -(defun call-with-temporary-file
  -    (thunk &key
  -     prefix keep (direction :io)
  -     (element-type *default-element-type*)
  -     (external-format :default))
  -  (check-type direction (member :output :io))
  -  (loop
  -    :with prefix = (or prefix (format nil "~Axm" *tmp-directory-pathname*))
  -    :for counter :from (random (ash 1 32))
  -    :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do
  -     ;; TODO: on Unix, do something about umask
  -     ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
  -     ;; TODO: on Unix, use CFFI and mkstemp -- but the master is precisely meant to not depend on CFFI or on anything! Grrrr.
  -    (with-open-file (stream pathname
  -                            :direction direction
  -                            :element-type element-type :external-format external-format
  -                            :if-exists nil :if-does-not-exist :create)
  -      (when stream
  -        (return
  -          (if keep
  -              (funcall thunk stream pathname)
  -              (unwind-protect
  -                   (funcall thunk stream pathname)
  -                (ignore-errors (delete-file pathname)))))))))
  -
  -(defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp)
  -                                (pathname (gensym "PATHNAME") pathnamep)
  -                                prefix keep element-type external-format)
  -                               &body body)
  -  "Evaluate BODY where the symbols specified by keyword arguments
  -STREAM and PATHNAME are bound corresponding to a newly created temporary file
  -ready for I/O. Unless KEEP is specified, delete the file afterwards."
  -  (check-type stream symbol)
  -  (check-type pathname symbol)
  -  `(flet ((think (,stream ,pathname)
  -            ,@(unless pathnamep `((declare (ignore ,pathname))))
  -            ,@(unless streamp `((when ,stream (close ,stream))))
  -            ,@body))
  -     #-gcl (declare (dynamic-extent #'think))
  -     (call-with-temporary-file
  -      #'think
  -      ,@(when prefix `(:prefix ,prefix))
  -      ,@(when keep `(:keep ,keep))
  -      ,@(when element-type `(:element-type ,element-type))
  -      ,@(when external-format `(:external-format external-format)))))
  -
  +
  +;;;; ----- Running an external program -----
   ;;; Simple variant of run-program with no input, and capturing output
   ;;; On some implementations, may output to a temporary file...
   (defun run-program/process-output-stream (command output-processor
  
positive.code:         (use-run-program)
          (use-system))))
  
  (defun run-program/read-output-lines (command &rest keys)
    "Run a program and collect its output as lines (a list of strings)
  by calling RUN-PROGRAM/PROCESS-OUTPUT-STREAM with SLURP-STREAM-LINES
  
negative.code:   #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl)
    (error "~S is not supported on your implementation" 'getenv))
  
  (defun emptyp (x)
    "Predicate that is true for an empty sequence"
    (or (null x) (and (vectorp x) (zerop (length x)))))
  (defun getenvp (x)
    "Predicate that is true if the named variable is present in the libc environment"
    (not (emptyp (getenv x))))
  
  
  ;;;; ----- User-visible variables, 2: Control XCVB -----
  
  ;;; These variables are shared with XCVB itself.
  
  (defvar *lisp-implementation-type*
    ;; TODO: test on all OS and implementation platform combinations!
    #+abcl :abcl #+allegro :allegro
    #+clisp :clisp #+clozure :ccl #+cmu :cmucl #+cormanlisp :corman
    #+ecl :ecl #+gcl :gcl #+genera :genera
    #+lispworks-personal-edition :lispworks-personal
    #+(and lispworks (not lispworks-personal-edition)) :lispworks
    #+mcl :mcl #+sbcl :sbcl #+scl :scl #+xcl :xcl
    #-(or abcl allegro clisp clozure cmu cormanlisp
          ecl gcl genera lispworks mcl sbcl scl xcl)
    (error "Your Lisp implementation is not supported by the XCVB driver (yet). Please help.")
    "Type of Lisp implementation for the target system. A keyword.
    Default: same as XCVB itself.")
  
  (defvar *lisp-executable-pathname* nil
    "Path to the Lisp implementation to use for the target system.
    NIL, or a string.
    Default: what's in your PATH.")
  
  (defvar *lisp-image-pathname* nil
    "What path to a Lisp image do we need invoke the target Lisp with?
    Default: whatever's the default for your implementation.")
  
  (defvar *lisp-implementation-directory*
    (or #+clozure (namestring (ccl::ccl-directory))
        #+gcl (namestring system::*system-directory*)
        #+sbcl (namestring (sb-int:sbcl-homedir-pathname)))
    "Where is the home directory for the Lisp implementation,
    in case we need it to (require ...) special features?
    Default: whatever's the default for your implementation.")
  
  (defvar *lisp-flags* :default
    ;;; TODO: add support for overriding this feature at the command-line?
    "What options do we need invoke the target Lisp with?
  A list of strings, or the keyword :DEFAULT.")
  
  (defvar *features-defined* nil
    "What additional features to define in the target image")
  
  (defvar *features-undefined* nil
    "What additional features to undefine in the target image")
  
  (defvar *disable-cfasls* nil
    "Should we disable CFASL support when the target Lisp has it?")
  
  (defvar *xcvb-verbosity* 5
    "Level of verbosity of XCVB:
    0 - silent except for emergency
    5 - usual warnings
    9 - plenty of debug info")
  
  (defvar *lisp-allow-debugger* nil
    "Should we allow interactive debugging of failed build attempts?")
  
  (defvar *object-directory* nil
    "where to store object files.
  NIL: default to ~/.cache/xcvb/common-lisp/sbcl-1.0.47-x86/ or some such, see docs")
  
  (defvar *tmp-directory-pathname*
    (let* ((dir (or
                 #+os-unix
                 (format nil "~A/" (or (getenv "TMP") "/tmp"))
                 #+os-windows
                 (format nil "~A\\" (or (getenv "TEMP") (error "No temporary directory!")))))
           #+mcl (dir (probe-posix dir)))
      (pathname dir))
    "pathname of directory where to store temporary files")
  
  (defvar *use-base-image* t
    "Should we be using a base image for all builds?")
  
  
  ;;; These variables are specific to a master controlling XCVB as a slave.
  
  (defvar *xcvb-program* "xcvb"
    "Path to the XCVB binary (a string), OR t if you want to use an in-image XCVB")
  
  (defvar *source-registry* nil
    "CL source registry specification. A sexp or string.
  Will override the shell variable CL_SOURCE_REGISTRY when calling slaves.")
  
  (defvar *xcvb-setup* nil
    "Lisp file to load to setup the target build system, if any")
  
  (defvar *manifest* nil
    ;; Note that older versions are kept in the tail, documenting the command history,
    ;; without affecting the behavior of ASSOC on the alist.
    "an alist of the XCVB load commands executed in this image,
  with associated pathnames and tthsums.")
  
  
  ;;;; ---- More utilities -----
  
  ;;; To be portable to CCL and more, we need to explicitly flush stream buffers.
  
  (defun finish-outputs ()
    "Finish output on the main output streams.
  Useful for portably flushing I/O before user input or program exit."
    (dolist (s (list *stderr* *error-output* *standard-output* *trace-output*))
      (ignore-errors (finish-output s)))
    (values))
  
  (defun format! (stream format &rest args)
    "Just like format, but call finish-outputs before and after the output."
    (finish-outputs)
    (apply 'format stream format args)
    (finish-output stream))
  
  
  ;;; Pathname helpers
  
  (defun pathname-directory-pathname (pathname)
    "Pathname for the directory containing given PATHNAME"
    (make-pathname :name nil :type nil :version nil :defaults pathname))
  
  (defun native-namestring (x)
    "From a CL pathname, a namestring suitable for use by the OS shell"
    (let ((p (pathname x)))
      #+clozure (ccl:native-translated-namestring p)
      #+(or cmu scl) (ext:unix-namestring p nil)
      #+sbcl (sb-ext:native-namestring p)
      #-(or clozure cmu sbcl scl) (namestring p)))
  
  (defun parse-native-namestring (x)
    "From a native namestring suitable for use by the OS shell, a CL pathname"
    (check-type x string)
    #+clozure (ccl:native-to-pathname x)
    #+sbcl (sb-ext:parse-native-namestring x)
    #-(or clozure sbcl) (parse-namestring x))
  
  
  ;;; Output helpers
  
  (defgeneric call-with-output (x thunk)
    (:documentation ;; from fare-utils
     "Calls FUN with an actual stream argument, behaving like FORMAT with respect to stream'ing:
  If OBJ is a stream, use it as the stream.
  If OBJ is NIL, use a STRING-OUTPUT-STREAM as the stream, and return the resulting string.
  If OBJ is T, use *STANDARD-OUTPUT* as the stream.
  If OBJ is a string with a fill-pointer, use it as a string-output-stream.
  Otherwise, signal an error.")
    (:method ((x null) thunk)
      (declare (ignorable x))
      (with-output-to-string (s) (funcall thunk s)))
    (:method ((x (eql t)) thunk)
      (declare (ignorable x))
      (funcall thunk *standard-output*) nil)
    #-genera
    (:method ((x stream) thunk)
      (funcall thunk x) nil)
    (:method ((x string) thunk)
      (assert (fill-pointer x))
      (with-output-to-string (s x) (funcall thunk s)))
    (:method (x thunk)
      (declare (ignorable thunk))
      (cond
        #+genera
        ((typep x 'stream) (funcall thunk x) nil)
        (t (error "not a valid stream designator ~S" x)))))
  
  (defmacro with-output ((x &optional (value x)) &body body)
    "Bind X to an output stream, coercing VALUE (default: previous binding of X)
  as per FORMAT, and evaluate BODY within the scope of this binding."
    `(call-with-output ,value #'(lambda (,x) ,@body)))
  
  
  ;;; Input helpers
  
  (defvar *default-element-type* (or #+(or abcl xcl) 'character :default)
    "default element-type for open (depends on the current CL implementation)")
  
  (defun call-with-input-file (pathname thunk
                               &key (element-type *default-element-type*)
                               (external-format :default))
    "Open FILE for input with given options, call THUNK with the resulting stream."
    (with-open-file (s pathname :direction :input
                       :element-type element-type :external-format external-format
                       :if-does-not-exist :error)
      (funcall thunk s)))
  
  (defmacro with-input-file ((var pathname &rest keys &key element-type external-format) &body body)
    (declare (ignore element-type external-format))
    `(call-with-input-file ,pathname #'(lambda (,var) ,@body) ,@keys))
  
  
  ;;; Using temporary files
  
  (defun call-with-temporary-file
      (thunk &key
       prefix keep (direction :io)
       (element-type *default-element-type*)
       (external-format :default))
    (check-type direction (member :output :io))
    (loop
      :with prefix = (or prefix (format nil "~Axm" *tmp-directory-pathname*))
      :for counter :from (random (ash 1 32))
      :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do
       ;; TODO: on Unix, do something about umask
       ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
       ;; TODO: on Unix, use CFFI and mkstemp -- but the master is precisely meant to not depend on CFFI or on anything! Grrrr.
      (with-open-file (stream pathname
                              :direction direction
                              :element-type element-type :external-format external-format
                              :if-exists nil :if-does-not-exist :create)
        (when stream
          (return
            (if keep
                (funcall thunk stream pathname)
                (unwind-protect
                     (funcall thunk stream pathname)
                  (ignore-errors (delete-file pathname)))))))))
  
  (defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp)
                                  (pathname (gensym "PATHNAME") pathnamep)
                                  prefix keep element-type external-format)
                                 &body body)
    "Evaluate BODY where the symbols specified by keyword arguments
  STREAM and PATHNAME are bound corresponding to a newly created temporary file
  ready for I/O. Unless KEEP is specified, delete the file afterwards."
    (check-type stream symbol)
    (check-type pathname symbol)
    `(flet ((think (,stream ,pathname)
              ,@(unless pathnamep `((declare (ignore ,pathname))))
              ,@(unless streamp `((when ,stream (close ,stream))))
              ,@body))
       #-gcl (declare (dynamic-extent #'think))
       (call-with-temporary-file
        #'think
        ,@(when prefix `(:prefix ,prefix))
        ,@(when keep `(:keep ,keep))
        ,@(when element-type `(:element-type ,element-type))
        ,@(when external-format `(:external-format external-format)))))
  
  
  ;;; Reading helpers
  
  (defmacro with-safe-io-syntax ((&key (package :cl)) &body body)
    "Establish safe CL reader options around the evaluation of BODY"
    `(call-with-safe-io-syntax (lambda () ,@body) :package ,package))
  
  (defun call-with-safe-io-syntax (thunk &key (package :cl))
    (with-standard-io-syntax ()
      (let ((*package* (find-package package))
            (*print-readably* t)
            (*print-escape* t)
  	  (*read-eval* nil))
        (funcall thunk))))
  
  (defun read-function (string)
    "Read a form from a string in function context, return a function"
    (eval `(function ,(read-from-string string))))
  
  (defun read-first-file-form (pathname &key (package :cl) eof-error-p eof-value)
    "Reads the first form from the top of a file"
    (with-safe-io-syntax (:package package)
      (with-input-file (in pathname)
        (read in eof-error-p eof-value))))
  
  
  ;;; String utilities
  
  (defun string-prefix-p (prefix string)
    "Does STRING begin with PREFIX?"
    (let* ((x (string prefix))
           (y (string string))
           (lx (length x))
           (ly (length y)))
      (and (<= lx ly) (string= x y :end2 lx))))
  
  (defun string-suffix-p (string suffix)
    "Does STRING end with SUFFIX?"
    (let* ((x (string string))
           (y (string suffix))
           (lx (length x))
           (ly (length y)))
      (and (<= ly lx) (string= x y :start1 (- lx ly)))))
  
  (defun string-enclosed-p (prefix string suffix)
    "Does STRING begin with PREFIX and end with SUFFIX?"
    (and (string-prefix-p prefix string)
         (string-suffix-p string suffix)))
  
  
  ;;;; Slurping streams
  
  (defun copy-stream-to-stream (input output &key (element-type 'character))
    "Copy the contents of the INPUT stream into the OUTPUT stream,
  using WRITE-SEQUENCE and a sensibly sized buffer."
    (with-open-stream (input input)
      (loop :with length = 8192
        :for buffer = (make-array length :element-type element-type)
        :for end = (read-sequence buffer input)
        :until (zerop end)
        :do (write-sequence buffer output :end end)
        :do (when (< end length) (return)))))
  
  (defun copy-stream-to-stream-line-by-line (input output)
    "Copy the contents of the INPUT stream into the OUTPUT stream,
  reading contents line by line."
    (with-open-stream (input input)
      (loop :for (line eof) = (multiple-value-list (read-line input nil nil))
        :while line
        :do (progn
              (princ line output)
              (unless eof (terpri output))
              (finish-output output)
              (when eof (return))))))
  
  (defun slurp-stream-string (input &key (element-type 'character))
    "Read the contents of the INPUT stream as a string"
    (with-open-stream (input input)
      (with-output-to-string (output)
        (copy-stream-to-stream input output :element-type element-type))))
  
  (defun slurp-stream-lines (input)
    "Read the contents of the INPUT stream as a list of lines"
    (with-open-stream (input input)
      (loop :for l = (read-line input nil nil)
        :while l :collect l)))
  
  (defun slurp-stream-forms (input)
    "Read the contents of the INPUT stream as a list of forms"
    (with-open-stream (input input)
      (loop :with eof = '#:eof
        :for form = (read input nil eof)
        :until (eq form eof)
        :collect form)))
  
  (defun slurp-file-string (file &rest keys)
    "Open FILE with option KEYS, read its contents as a string"
    (apply 'call-with-input-file file 'slurp-stream-string keys))
  
  (defun slurp-file-lines (file &rest keys)
    "Open FILE with option KEYS, read its contents as a list of lines"
    (apply 'call-with-input-file file 'slurp-stream-lines keys))
  
  (defun slurp-file-forms (file &rest keys)
    "Open FILE with option KEYS, read its contents as a list of forms"
    (apply 'call-with-input-file file 'slurp-stream-forms keys))
  
  
  ;;;; ----- Current directory -----
  ;; TODO: make it work on all supported implementations
  
  (defun getcwd ()
    "Get the current working directory as per POSIX getcwd(3)"
    (or #+clisp (ext:default-directory)
        #+clozure (ccl:current-directory)
        #+sbcl (sb-posix:getcwd)
        (error "getcwd not supported on your implementation")))
  
  (defun chdir (x)
    "Change current directory, as per POSIX chdir(2)"
    (when (pathnamep x) (setf x (#-scl namestring #+scl posix-namestring x)))
    (or #+clisp (ext:cd x)
        #+clozure (setf (ccl:current-directory) x)
        #+sbcl (sb-posix:chdir x)
        (error "chdir not supported on your implementation")))
  
  (defun call-with-current-directory (dir thunk)
    (let* ((dir (truename (merge-pathnames (pathname-directory-pathname dir))))
           (*default-pathname-defaults* dir)
           (cwd (getcwd)))
      (chdir dir)
      (unwind-protect
           (funcall thunk)
        (chdir cwd))))
  
  (defmacro with-current-directory ((dir) &body body)
    "Call BODY while the POSIX current working directory is set to DIR"
    `(call-with-current-directory ,dir #'(lambda () ,@body)))
  
  
  ;;;; ---- Build and Execution control ----
  
  ;;; Optimization settings
  
  (defvar *previous-optimization-settings* nil)
  (defun get-optimization-settings ()
    "Get current compiler optimization settings, ready to PROCLAIM again"
  