From 052b3bbce0e9ce1bd4764b60d3a8454d90254559 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Fri, 11 Jan 2013 10:23:13 -0500
Subject: [PATCH] 2.26.74: move a bunch of functionality from xcvb-driver to
 asdf.

This notably includes the former xcvb-driver:run-program/,
a much better replacement for run-shell-command.
This also includes image initialization, dumping, quitting.
---
 Makefile                 |   2 +-
 action.lisp              |  19 +-
 asdf.asd                 |   2 +-
 backward-interface.lisp  | 140 +--------------
 bundle.lisp              |   5 +-
 compatibility.lisp       |   1 +
 component.lisp           |   5 +-
 concatenate-source.lisp  |   2 +-
 configuration.lisp       |   5 +-
 find-component.lisp      |   5 +-
 footer.lisp              |   2 +-
 generate-asdf.asd        |  11 +-
 header.lisp              |   2 +-
 image.lisp               | 243 ++++++++++++++++++++++++++
 interface.lisp           |   5 +-
 lisp-build.lisp          |  79 ++++++++-
 operate.lisp             |   3 +-
 operation.lisp           |   2 +-
 os.lisp                  | 199 +++++++++++++++------
 output-translations.lisp |  17 +-
 package.lisp             |  81 ++++-----
 pathname.lisp            |  29 +++-
 plan.lisp                |   5 +-
 run-program.lisp         | 363 +++++++++++++++++++++++++++++++++++++++
 source-registry.lisp     |   5 +-
 stream.lisp              | 190 ++++++++++++++++++++
 system.lisp              |   7 +-
 test/script-support.lisp |   8 -
 test/test1.script        |   4 +-
 upgrade.lisp             |   6 +-
 utility.lisp             |  92 ++++++++--
 31 files changed, 1227 insertions(+), 312 deletions(-)
 create mode 100644 image.lisp
 create mode 100644 run-program.lisp
 create mode 100644 stream.lisp

diff --git a/Makefile b/Makefile
index d3d85cf6..29bc7202 100644
--- a/Makefile
+++ b/Makefile
@@ -53,7 +53,7 @@ archive-copy: archive build/asdf.lisp
 
 build/asdf.lisp: $(wildcard *.lisp)
 	mkdir -p build
-	cat header.lisp package.lisp compatibility.lisp utility.lisp upgrade.lisp pathname.lisp os.lisp component.lisp system.lisp find-system.lisp find-component.lisp lisp-build.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp configuration.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp > $@
+	cat header.lisp package.lisp compatibility.lisp utility.lisp upgrade.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp component.lisp system.lisp find-system.lisp find-component.lisp lisp-build.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp configuration.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp > $@
 
 push:
 	git status
diff --git a/action.lisp b/action.lisp
index a972d20e..df7b54d5 100644
--- a/action.lisp
+++ b/action.lisp
@@ -3,12 +3,9 @@
 
 (asdf/package:define-package :asdf/action
   (:recycle :asdf/action :asdf)
-  (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os
+  (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build
    :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation)
   #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of)
-  (:fmakunbound
-   #:explain #:output-files #:perform #:perform-with-restarts
-   #:operation-done-p #:compute-action-stamp #:component-depends-on #:mark-operation-done)
   (:intern #:stamp #:done-p)
   (:export
    #:action
@@ -25,6 +22,11 @@
    #:perform #:perform-with-restarts #:retry #:accept))
 (in-package :asdf/action)
 
+(when-upgrade ()
+  (undefine-functions
+   '(explain output-files perform perform-with-restarts
+     operation-done-p compute-action-stamp component-depends-on mark-operation-done)))
+
 (deftype action () '(cons operation component)) ;; a step to be performed while building the system
 
 ;;;; self-description
@@ -111,6 +113,15 @@ You can put together sentences using this phrase."))
   (declare (ignorable o c))
   t)
 
+(defmethod output-files :around (operation component)
+  "Translate output files, unless asked not to"
+  operation component ;; hush genera, not convinced by declare ignorable(!)
+  (values
+   (multiple-value-bind (files fixedp) (call-next-method)
+     (if fixedp
+         files
+         (mapcar *output-translation-hook* files)))
+   t))
 (defmethod output-files ((o operation) (c component))
   (declare (ignorable o c))
   nil)
diff --git a/asdf.asd b/asdf.asd
index 16e1ef96..7e80e8d5 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -15,7 +15,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.73" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.74" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components ((:module "build" :components ((:file "asdf")))))
 
diff --git a/backward-interface.lisp b/backward-interface.lisp
index a4fcffc4..8caae230 100644
--- a/backward-interface.lisp
+++ b/backward-interface.lisp
@@ -3,8 +3,7 @@
 
 (asdf/package:define-package :asdf/backward-interface
   (:recycle :asdf/backward-interface :asdf)
-  (:fmakunbound #:component-load-dependencies)
-  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/run-program
    :asdf/upgrade :asdf/component :asdf/system :asdf/operation :asdf/action
    :asdf/lisp-build :asdf/operate :asdf/output-translations)
   (:export
@@ -19,7 +18,7 @@
    #:system-definition-pathname))
 (in-package :asdf/backward-interface)
 
-(defvar *asdf-verbose* nil) ; worked around by cl-protobufs. It was a mistake to introduce it. mea culpa -fare
+(when-upgrade () (undefine-function 'component-load-dependencies))
 
 (defun* component-load-dependencies (component)
   ;; Old deprecated name for the same thing. Please update your software.
@@ -109,28 +108,8 @@ call that function where you would otherwise have loaded and configured A-B-L.")
 
 ;;;; run-shell-command
 ;;
-;; run-shell-command functions for other lisp implementations will be
-;; gratefully accepted, if they do the same thing.
-;; If the docstring is ambiguous, send a bug report.
-;;
-;; WARNING! The function below is mostly dysfunctional.
-;; For instance, it will probably run fine on most implementations on Unix,
-;; which will hopefully use the shell /bin/sh (which we force in some cases)
-;; which is hopefully reasonably compatible with a POSIX *or* Bourne shell.
-;; But behavior on Windows may vary wildly between implementations,
-;; either relying on your having installed a POSIX sh, or going through
-;; the CMD.EXE interpreter, for a totally different meaning, depending on
-;; what is easily expressible in said implementation.
-;;
-;; We probably should move this functionality to its own system and deprecate
-;; use of it from the asdf package. However, this would break unspecified
-;; existing software, so until a clear alternative exists, we can't deprecate
-;; it, and even after it's been deprecated, we will support it for a few
-;; years so everyone has time to migrate away from it. -- fare 2009-12-01
-;;
-;; As a suggested replacement which is portable to all ASDF-supported
-;; implementations and operating systems except Genera, I recommend
-;; xcvb-driver's xcvb-driver:run-program/ and its derivatives.
+;; WARNING! The function below is dysfunctional and deprecated.
+;; Please use asdf/run-program:run-program/ instead.
 
 (defun* run-shell-command (control-string &rest args)
   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
@@ -138,113 +117,4 @@ synchronously execute the result using a Bourne-compatible shell, with
 output to *VERBOSE-OUT*.  Returns the shell's exit code."
   (let ((command (apply 'format nil control-string args)))
     (asdf-message "; $ ~A~%" command)
-
-    #+abcl
-    (ext:run-shell-command command :output *verbose-out*)
-
-    #+allegro
-    ;; will this fail if command has embedded quotes - it seems to work
-    (multiple-value-bind (stdout stderr exit-code)
-        (excl.osi:command-output
-         #-mswindows (vector "/bin/sh" "/bin/sh" "-c" command)
-         #+mswindows command ; BEWARE!
-         :input nil :whole nil
-         #+mswindows :show-window #+mswindows :hide)
-      (asdf-message "~{~&~a~%~}~%" stderr)
-      (asdf-message "~{~&~a~%~}~%" stdout)
-      exit-code)
-
-    #+clisp
-    ;; CLISP returns NIL for exit status zero.
-    (if *verbose-out*
-        (let* ((new-command (format nil "( ~A ) ; r=$? ; echo ; echo ASDF-EXIT-STATUS $r"
-                                    command))
-               (outstream (ext:run-shell-command new-command :output :stream :wait t)))
-            (multiple-value-bind (retval out-lines)
-                (unwind-protect
-                     (parse-clisp-shell-output outstream)
-                  (ignore-errors (close outstream)))
-              (asdf-message "~{~&~a~%~}~%" out-lines)
-              retval))
-        ;; there will be no output, just grab up the exit status
-        (or (ext:run-shell-command command :output nil :wait t) 0))
-
-    #+clozure
-    (nth-value 1
-               (ccl:external-process-status
-                (ccl:run-program
-                 (cond
-                   ((os-unix-p) "/bin/sh")
-                   ((os-windows-p) (strcat "CMD /C " command)) ; BEWARE!
-                   (t (error "Unsupported OS")))
-                 (if (os-unix-p) (list "-c" command) '())
-                 :input nil :output *verbose-out* :wait t)))
-
-    #+(or cmu scl)
-    (ext:process-exit-code
-     (ext:run-program
-      "/bin/sh"
-      (list "-c" command)
-      :input nil :output *verbose-out*))
-
-    #+cormanlisp
-    (win32:system command)
-
-    #+ecl ;; courtesy of Juan Jose Garcia Ripoll
-    (ext:system command)
-
-    #+gcl
-    (lisp:system command)
-
-    #+lispworks
-    (apply 'system:call-system-showing-output command
-           :show-cmd nil :prefix "" :output-stream *verbose-out*
-           (when (os-unix-p) '(:shell-type "/bin/sh")))
-
-    #+mcl
-    (ccl::with-cstrs ((%command command)) (_system %command))
-
-    #+mkcl
-    ;; This has next to no chance of working on basic Windows!
-    ;; Your best hope is that Cygwin or MSYS is somewhere in the PATH.
-    (multiple-value-bind (io process exit-code)
-        (apply #'mkcl:run-program #+windows "sh" #-windows "/bin/sh"
-                                  (list "-c" command)
-                                  :input nil :output t #|*verbose-out*|# ;; will be *verbose-out* when we support it
-                                  #-windows '(:search nil))
-      (declare (ignore io process))
-      exit-code)
-
-    #+sbcl
-    (sb-ext:process-exit-code
-     (apply 'sb-ext:run-program
-            #+win32 "sh" #-win32 "/bin/sh"
-            (list  "-c" command)
-            :input nil :output *verbose-out*
-            #+win32 '(:search t) #-win32 nil))
-
-    #+xcl
-    (ext:run-shell-command command)
-
-    #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl mkcl sbcl scl xcl)
-    (error "RUN-SHELL-COMMAND not implemented for this Lisp")))
-
-#+clisp
-(defun* parse-clisp-shell-output (stream)
-  "Helper function for running shell commands under clisp.  Parses a specially-
-crafted output string to recover the exit status of the shell command and a
-list of lines of output."
-  (loop :with status-prefix = "ASDF-EXIT-STATUS "
-    :with prefix-length = (length status-prefix)
-    :with exit-status = -1 :with lines = ()
-    :for line = (read-line stream nil nil)
-    :while line :do (push line lines) :finally
-    (let* ((last (car lines))
-           (status (and last (>= (length last) prefix-length)
-                        (string-equal last status-prefix :end1 prefix-length)
-                        (parse-integer last :start prefix-length :junk-allowed t))))
-      (when status
-        (setf exit-status status)
-        (pop lines) (when (equal "" (car lines)) (pop lines)))
-      (return (values exit-status (reverse lines))))))
-
+    (run-program/ command :force-shell t :output *verbose-out*)))
diff --git a/bundle.lisp b/bundle.lisp
index ce1f8f79..4609c96f 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -2,10 +2,9 @@
 ;;;; ASDF-Bundle
 
 (asdf/package:define-package :asdf/bundle
-  (:fmakunbound #:trivial-system-p)
   (:recycle :asdf/bundle :asdf)
   (:intern #:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library)
-  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/upgrade
    :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation
    :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate)
   (:export
@@ -23,6 +22,8 @@
    #:system-fasl))
 (in-package :asdf/bundle)
 
+(when-upgrade () (undefine-function 'trivial-system-p))
+
 (defclass bundle-op (operation)
   ((build-args :initarg :args :initform nil :accessor bundle-op-build-args)
    (name-suffix :initarg :name-suffix :initform nil)
diff --git a/compatibility.lisp b/compatibility.lisp
index 730ff407..fc906df8 100644
--- a/compatibility.lisp
+++ b/compatibility.lisp
@@ -14,6 +14,7 @@
   #+ecl (:export #:use-ecl-byte-compiler-p)
   #+genera (:import-from :scl #:boolean)
   #+genera (:export #:boolean #:ensure-directories-exist)
+  #+mcl (:export #:probe-posix #:current-user-homedir-pathname)
   (:export
    #:strcat #:compatfmt))
 (in-package :asdf/compatibility)
diff --git a/component.lisp b/component.lisp
index cbb84b7b..4bc3d67a 100644
--- a/component.lisp
+++ b/component.lisp
@@ -3,7 +3,6 @@
 
 (asdf/package:define-package :asdf/component
   (:recycle :asdf/component :asdf)
-  (:fmakunbound #:component-relative-pathname #:source-file-type)
   (:use :common-lisp :asdf/utility :asdf/pathname :asdf/upgrade)
   (:intern #:name #:version #:description #:long-description
            #:sibling-dependencies #:if-feature #:in-order-to #:inline-methods
@@ -28,6 +27,8 @@
    #:*default-encoding* #:*utf-8-external-format*))
 (in-package :asdf/component)
 
+(when-upgrade () (undefine-functions '(component-relative-pathname source-file-type)))
+
 (defgeneric* component-name (component)
   (:documentation "Name of the COMPONENT, unique relative to its parent"))
 (defgeneric* component-system (component)
@@ -48,7 +49,7 @@ another pathname in a degenerate way."))
 (defgeneric* version-satisfies (component version))
 (defgeneric* source-file-type (component system))
 
-(with-upgrade (:when (find-class 'component nil))
+(when-upgrade (:when (find-class 'component nil))
   (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
     (declare (ignorable c initargs)) (values)))
 
diff --git a/concatenate-source.lisp b/concatenate-source.lisp
index da3dc8e6..2a1a0b60 100644
--- a/concatenate-source.lisp
+++ b/concatenate-source.lisp
@@ -4,7 +4,7 @@
 (asdf/package:define-package :asdf/concatenate-source
   (:recycle :asdf/concatenate-source :asdf)
   (:intern #:translate-output-p #:concatenated-source-file)
-  (:use :common-lisp :asdf/utility :asdf/os
+  (:use :common-lisp :asdf/utility :asdf/stream
         :asdf/component :asdf/operation :asdf/system :asdf/find-system :asdf/defsystem
         :asdf/action :asdf/lisp-action :asdf/bundle)
   (:export
diff --git a/configuration.lisp b/configuration.lisp
index fe0ac956..d9988fcc 100644
--- a/configuration.lisp
+++ b/configuration.lisp
@@ -3,8 +3,7 @@
 
 (asdf/package:define-package :asdf/configuration
   (:recycle :asdf/configuration :asdf)
-  (:fmakunbound #:resolve-location)
-  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os)
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os :asdf/upgrade)
   (:export
    #:get-folder-path
    #:user-configuration-directories #:system-configuration-directories
@@ -18,6 +17,8 @@
    #:resolve-relative-location-component #:resolve-absolute-location-component))
 (in-package :asdf/configuration)
 
+(when-upgrade () (undefine-function 'resolve-location))
+
 (define-condition invalid-configuration ()
   ((form :reader condition-form :initarg :form)
    (location :reader condition-location :initarg :location)
diff --git a/find-component.lisp b/find-component.lisp
index 420417ff..3db1cffb 100644
--- a/find-component.lisp
+++ b/find-component.lisp
@@ -3,9 +3,8 @@
 
 (asdf/package:define-package :asdf/find-component
   (:recycle :asdf/find-component :asdf)
-  (:fmakunbound #:find-component)
   (:use :common-lisp :asdf/utility :asdf/os
-   :asdf/component :asdf/system :asdf/find-system)
+   :asdf/upgrade :asdf/component :asdf/system :asdf/find-system)
   (:export
    #:find-component
    #:resolve-dependency-name #:resolve-dependency-spec
@@ -17,6 +16,8 @@
    #:missing-required-by #:missing-version))
 (in-package :asdf/find-component)
 
+(when-upgrade () (undefine-function 'find-component))
+
 ;;;; Missing component conditions
 
 (define-condition missing-component-of-version (missing-component)
diff --git a/footer.lisp b/footer.lisp
index f956e356..6cf5ae6f 100644
--- a/footer.lisp
+++ b/footer.lisp
@@ -15,7 +15,7 @@
 ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
 
 #+(or abcl clisp clozure cmu ecl mkcl sbcl)
-(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom))))
+(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil))))
   (when x
     (eval `(pushnew 'module-provide-asdf
             #+abcl sys::*module-provider-functions*
diff --git a/generate-asdf.asd b/generate-asdf.asd
index 37465389..0ea8ab55 100644
--- a/generate-asdf.asd
+++ b/generate-asdf.asd
@@ -31,7 +31,11 @@
      (:file "compatibility" :depends-on ("package"))
      (:file "utility" :depends-on ("compatibility"))
      (:file "pathname" :depends-on ("utility"))
-     (:file "os" :depends-on ("pathname"))))
+     (:file "stream" :depends-on ("utility"))
+     (:file "os" :depends-on ("pathname" "streams"))
+     (:file "image" :depends-on ("os"))
+     (:file "run-program" :depends-on ("os"))
+     (:file "lisp-build" :depends-on ("pathname"))))
    (:module
     "code" :pathname "" :components
      (:file "upgrade")
@@ -39,7 +43,6 @@
      (:file "system" :depends-on ("component"))
      (:file "find-system" :depends-on ("system"))
      (:file "find-component" :depends-on ("find-system"))
-     (:file "lisp-build")
      (:file "operation")
      (:file "action" :depends-on ("find-component" "operation"))
      (:file "lisp-action" :depends-on ("action" "lisp-build"))
@@ -52,6 +55,6 @@
      (:file "defsystem" :depends-on ("backward-internals"))
      (:file "bundle" :depends-on ("lisp-action"))
      (:file "concatenate-source" :depends-on ("lisp-action"))
-     (:file "backward-interface" :depends-on ("lisp-action"))))
+     (:file "backward-interface" :depends-on ("lisp-action")))
    (:file "interface")
-   (:file "footer" :depends-on ("interface"))))
+   (:file "footer" :depends-on ("interface")))))
diff --git a/header.lisp b/header.lisp
index f0b92ed8..e472f143 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.73: Another System Definition Facility.
+;;; This is ASDF 2.26.74: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/image.lisp b/image.lisp
new file mode 100644
index 00000000..72c805a2
--- /dev/null
+++ b/image.lisp
@@ -0,0 +1,243 @@
+;;;; -------------------------------------------------------------------------
+;;;; Starting, Stopping, Dumping a Lisp image
+
+(asdf/package:define-package :asdf/image
+  (:recycle :asdf/image :xcvb-driver)
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os)
+  (:export
+   #:*arguments* #:*dumped* #:raw-command-line-arguments #:*command-line-arguments*
+   #:*debugging* #:*post-image-restart* #:*entry-point*
+   #:quit #:die #:print-backtrace #:bork #:with-coded-exit #:shell-boolean
+   #:register-image-resume-hook #:register-image-dump-hook
+   #:call-image-resume-hook #:call-image-dump-hook
+   #:initialize-asdf-utilities
+   #:resume #:do-resume #:dump-image 
+))
+(in-package :asdf/image)
+
+(defvar *debugging* nil
+  "Shall we print extra debugging information?")
+
+(defvar *arguments* nil
+  "Command-line arguments")
+
+(defvar *dumped* nil
+  "Is this a dumped image? As a standalone executable?")
+
+(defvar *image-resume-hook* nil
+  "Functions to call (in reverse order) when the image is resumed")
+
+(defvar *image-dump-hook* nil
+  "Functions to call (in order) when before an image is dumped")
+
+(defvar *post-image-restart* nil
+  "a string containing forms to read and evaluate when the image is restarted,
+but before the entry point is called.")
+
+(defvar *entry-point* nil
+  "a function with which to restart the dumped image when execution is resumed from it.")
+
+
+
+;;; Exiting properly or im-
+(defun quit (&optional (code 0) (finish-output t))
+  "Quits from the Lisp world, with the given exit status if provided.
+This is designed to abstract away the implementation specific quit forms."
+  (with-safe-io-syntax ()
+    (when finish-output ;; essential, for ClozureCL, and for standard compliance.
+      (ignore-errors (finish-outputs))))
+  #+(or abcl xcl) (ext:quit :status code)
+  #+allegro (excl:exit code :quiet t)
+  #+clisp (ext:quit code)
+  #+clozure (ccl:quit code)
+  #+cormanlisp (win32:exitprocess code)
+  #+(or cmu scl) (unix:unix-exit code)
+  #+ecl (si:quit code)
+  #+gcl (lisp:quit code)
+  #+genera (error "You probably don't want to Halt the Machine.")
+  #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
+  #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
+  #+mkcl (mk-ext:quit :exit-code code)
+  #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil))
+		 (quit (find-symbol* :quit :sb-ext nil)))
+	     (cond
+	       (exit `(,exit :code code :abort (not finish-output)))
+	       (quit `(,quit :unix-status code :recklessly-p (not finish-output)))))
+  #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
+  (error "xcvb driver: Quitting not implemented"))
+
+(defun die (format &rest arguments)
+  "Die in error with some error message"
+  (with-safe-io-syntax ()
+    (ignore-errors
+     (format! *stderr* "~&")
+     (apply #'format! *stderr* format arguments)
+     (format! *stderr* "~&")))
+  (quit 99))
+
+(defun print-backtrace (out)
+  "Print a backtrace (implementation-defined)"
+  (declare (ignorable out))
+  #+clozure (let ((*debug-io* out))
+	      (ccl:print-call-history :count 100 :start-frame-number 1)
+	      (finish-output out))
+  #+sbcl
+  (sb-debug:backtrace
+   #.(if (find-symbol* "*VERBOSITY*" "SB-DEBUG" nil) :stream 'most-positive-fixnum)
+   out))
+
+(defun bork (condition)
+  "Depending on whether *DEBUGGING* is set, enter debugger or die"
+  (with-safe-io-syntax ()
+    (ignore-errors (format! *stderr* "~&BORK:~%~A~%" condition)))
+  (cond
+    (*debugging*
+     (invoke-debugger condition))
+    (t
+     (with-safe-io-syntax ()
+       (ignore-errors (print-backtrace *stderr*)))
+     (die "~A" condition))))
+
+(defun call-with-coded-exit (thunk)
+  (handler-bind ((error 'bork))
+    (funcall thunk)
+    (quit 0)))
+
+(defmacro with-coded-exit ((&optional) &body body)
+  "Run BODY, BORKing on error and otherwise exiting with a success status"
+  `(call-with-coded-exit #'(lambda () ,@body)))
+
+(defun shell-boolean (x)
+  "Quit with a return code that is 0 iff argument X is true"
+  (quit (if x 0 1)))
+
+
+;;; Using hooks
+
+(defun* register-image-resume-hook (hook)
+  (pushnew hook *image-resume-hook*))
+
+(defun* register-image-dump-hook (hook)
+  (pushnew hook *image-dump-hook*))
+
+(defun* call-image-resume-hook ()
+  (call-functions (reverse *image-resume-hook*)))
+
+(defun* call-image-dump-hook ()
+  (call-functions *image-dump-hook*))
+
+
+;;; Build initialization
+
+(defun initialize-asdf-utilities ()
+  "Setup the XCVB environment with respect to debugging, profiling, performance"
+  (setf *temporary-directory* (default-temporary-directory)
+	*stderr* #-clozure *error-output* #+clozure ccl::*stderr*)
+  (values))
+
+
+;;; Proper command-line arguments
+
+(defun raw-command-line-arguments ()
+  "Find what the actual command line for this process was."
+  #+abcl ext:*command-line-argument-list* ; Use 1.0.0 or later!
+  #+allegro (sys:command-line-arguments) ; default: :application t
+  #+clisp (coerce (ext:argv) 'list)
+  #+clozure (ccl::command-line-arguments)
+  #+(or cmu scl) extensions:*command-line-strings*
+  #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
+  #+gcl si:*command-args*
+  #+lispworks sys:*line-arguments-list*
+  #+sbcl sb-ext:*posix-argv*
+  #+xcl system:*argv*
+  #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl xcl)
+  (error "raw-command-line-arguments not implemented yet"))
+
+(defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
+  "Extract user arguments from command-line invocation of current process.
+Assume the calling conventions of an XCVB-generated script
+if we are not called from a directly executable image dumped by XCVB."
+  #+abcl arguments
+  #-abcl
+  (let* (#-(or sbcl allegro)
+	 (arguments
+	  (if (eq *dumped* :executable)
+	      arguments
+	      (member "--" arguments :test 'string-equal))))
+    (rest arguments)))
+
+(defun do-resume (&key (post-image-restart *post-image-restart*) (entry-point *entry-point*))
+  (with-safe-io-syntax (:package :asdf)
+    (let ((*read-eval* t))
+      (when post-image-restart (load-string post-image-restart))))
+  (with-coded-exit ()
+    (when entry-point
+      (let ((ret (apply entry-point *arguments*)))
+	(if (typep ret 'integer)
+	    (quit ret)
+	    (quit 99))))))
+
+(defun resume ()
+  (setf *arguments* (command-line-arguments))
+  (do-resume))
+
+;;; Dumping an image
+
+#-ecl
+(defun dump-image (filename &key output-name executable pre-image-dump post-image-restart entry-point package)
+  (declare (ignorable filename output-name executable pre-image-dump post-image-restart entry-point))
+  (setf *dumped* (if executable :executable t))
+  (setf *package* (find-package (or package :cl-user)))
+  (with-safe-io-syntax ()
+    (let ((*read-eval* t))
+      (when pre-image-dump (load-string pre-image-dump))
+      (setf *entry-point* (when entry-point (read-function entry-point)))
+      (when post-image-restart (setf *post-image-restart* post-image-restart))))
+  #-(or clisp clozure cmu lispworks sbcl)
+  (when executable
+    (error "Dumping an executable is not supported on this implementation! Aborting."))
+  #+allegro
+  (progn
+    (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000
+    (excl:dumplisp :name filename :suppress-allegro-cl-banner t))
+  #+clisp
+  (apply #'ext:saveinitmem filename
+   :quiet t
+   :start-package *package*
+   :keep-global-handlers nil
+   :executable (if executable 0 t) ;--- requires clisp 2.48 or later, still catches --clisp-x
+   (when executable
+     (list
+      :norc t
+      :script nil
+      :init-function #'resume
+      ;; :parse-options nil ;--- requires a non-standard patch to clisp.
+      )))
+  #+clozure
+  (ccl:save-application filename :prepend-kernel t
+                        :toplevel-function (when executable #'resume))
+  #+(or cmu scl)
+  (progn
+   (ext:gc :full t)
+   (setf ext:*batch-mode* nil)
+   (setf ext::*gc-run-time* 0)
+   (apply 'ext:save-lisp filename #+cmu :executable #+cmu t
+          (when executable '(:init-function resume :process-command-line nil))))
+  #+gcl
+  (progn
+   (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t)
+   (si::save-system filename))
+  #+lispworks
+  (if executable
+      (lispworks:deliver 'resume filename 0 :interface nil)
+      (hcl:save-image filename :environment nil))
+  #+sbcl
+  (progn
+    ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself
+   (setf sb-ext::*gc-run-time* 0)
+   (apply 'sb-ext:save-lisp-and-die filename
+    :executable t ;--- always include the runtime that goes with the core
+    (when executable (list :toplevel #'resume :save-runtime-options t)))) ;--- only save runtime-options for standalone executables
+  #-(or allegro clisp clozure cmu gcl lispworks sbcl scl)
+  (die "Can't dump ~S: asdf doesn't support image dumping with this Lisp implementation.~%" filename))
+
diff --git a/interface.lisp b/interface.lisp
index f9b2d88b..6d996be5 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -11,7 +11,8 @@
    #:loaded-systems ; makes for annoying SLIME completion
    #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function
   (:use :common-lisp
-   :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade
+   :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname
+   :asdf/stream :asdf/os :asdf/run-program :asdf/upgrade
    :asdf/component :asdf/system :asdf/find-system :asdf/find-component
    :asdf/operation :asdf/action :asdf/lisp-build :asdf/lisp-action
    :asdf/configuration :asdf/output-translations :asdf/source-registry
@@ -136,6 +137,6 @@
    #:system-source-registry-directory))
 (in-package :asdf/interface)
 
-(with-upgrade (:when (fboundp 'make-sub-operation))
+(when-upgrade (:when (fboundp 'make-sub-operation))
   (defun* make-sub-operation (c o dep-c dep-o)
     (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
diff --git a/lisp-build.lisp b/lisp-build.lisp
index 184a1dde..986ec99a 100644
--- a/lisp-build.lisp
+++ b/lisp-build.lisp
@@ -3,16 +3,21 @@
 
 (asdf/package:define-package :asdf/lisp-build
   (:recycle :asdf/lisp-build :asdf)
-  (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os)
-  (:fmakunbound #:compile-file*)
+  (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os)
   (:export
    #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour*
-   #:*compile-file-function* #:compile-file* #:compile-file-pathname*
+   #:*compile-file-function* #:compile-file* #:compile-file-pathname* #:*output-translation-hook*
+   #:*optimization-settings*
+   #:*uninteresting-conditions* #:*uninteresting-load-conditions*
+   #:*fatal-conditions* #:*deferred-warnings*
    #+(or ecl mkcl) #:compile-file-keeping-object
    #:lispize-pathname #:fasl-type #:call-around-hook
+   #:*output-translation-hook*
    #:combine-fasls))
 (in-package :asdf/lisp-build)
 
+(eval-when (:compile-toplevel :load-toplevel :execute) (undefine-function 'compile-file*))
+
 (defvar *compile-file-warnings-behaviour*
   (or #+clisp :ignore :warn)
   "How should ASDF react if it encounters a warning when compiling a file?
@@ -27,6 +32,8 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
 (defvar *compile-file-function* 'compile-file*
   "Function used to compile lisp files.")
 
+(defvar *output-translation-hook* 'identity)
+
 (defun* lispize-pathname (input-file)
   (make-pathname :type "lisp" :defaults input-file))
 
@@ -75,7 +82,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
              (defaults (make-pathname
                         :type type :defaults (merge-pathnames* input-file))))
         (merge-pathnames* output-file defaults))
-      (funcall (find-symbol* :apply-output-translations :asdf/output-translations)
+      (funcall *output-translation-hook*
                (apply 'compile-file-pathname input-file
                       (if output-file keys (remove-keyword :output-file keys))))))
 
@@ -137,3 +144,67 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
       (ignore-errors (lispworks:delete-system :fasls-to-concatenate)))))
 
 
+;;; Optimization settings
+
+(defvar *optimization-settings* nil)
+(defvar *previous-optimization-settings* nil)
+(defun get-optimization-settings ()
+  "Get current compiler optimization settings, ready to PROCLAIM again"
+  (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
+    #-(or clisp clozure cmu ecl sbcl scl)
+    (warn "xcvb-driver::get-optimization-settings does not support your implementation. Please help me fix that.")
+    #.`(loop :for x :in settings
+         ,@(or #+clozure '(:for v :in '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety* ccl::*nx-debug* ccl::*nx-cspeed*))
+               #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*))
+               #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity)))
+         :for y = (or #+clisp (gethash x system::*optimize*)
+                      #+(or clozure ecl) (symbol-value v)
+                      #+(or cmu scl) (funcall f c::*default-cookie*)
+                      #+sbcl (cdr (assoc x sb-c::*policy*)))
+         :when y :collect (list x y))))
+(defun proclaim-optimization-settings ()
+  "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*"
+  (proclaim `(optimize ,@*optimization-settings*))
+  (let ((settings (get-optimization-settings)))
+    (unless (equal *previous-optimization-settings* settings)
+      (setf *previous-optimization-settings* settings))))
+
+
+;;; Condition control
+
+(defvar *uninteresting-conditions*
+  (append
+   #+sbcl
+   '(sb-c::simple-compiler-note
+     "&OPTIONAL and &KEY found in the same lambda list: ~S"
+     sb-int:package-at-variance
+     sb-kernel:uninteresting-redefinition
+     ;; the below four are controversial to include here;
+     ;; however there are issues with the asdf upgrade if they are not present
+     sb-kernel:redefinition-with-defun
+     sb-kernel:redefinition-with-defgeneric
+     sb-kernel:redefinition-with-defmethod
+     sb-kernel::redefinition-with-defmacro ; not exported by old SBCLs
+     sb-kernel:undefined-alien-style-warning
+     sb-ext:implicit-generic-function-warning
+     sb-kernel:lexical-environment-too-complex
+     "Couldn't grovel for ~A (unknown to the C compiler).")
+   ;;#+clozure '(ccl:compiler-warning)
+   '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.") ;; from closer2mop
+   )
+  "Conditions that may be skipped. type symbols, predicates or strings")
+
+(defvar *uninteresting-load-conditions*
+  (append
+   '("Overwriting already existing readtable ~S." ;; from named-readtables
+     #(#:finalizers-off-warning :asdf-finalizers)) ;; from asdf-finalizers
+   #+clisp '(clos::simple-gf-replacing-method-warning))
+  "Additional conditions that may be skipped while loading. type symbols, predicates or strings")
+
+(defvar *fatal-conditions*
+  '(serious-condition)
+  "Conditions to be considered fatal during compilation.")
+
+(defvar *deferred-warnings* ()
+  "Warnings the handling of which is deferred until the end of the compilation unit")
+
diff --git a/operate.lisp b/operate.lisp
index 6297d780..eaac6634 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -3,7 +3,6 @@
 
 (asdf/package:define-package :asdf/operate
   (:recycle :asdf/operate :asdf)
-  (:fmakunbound #:operate)
   (:use :common-lisp :asdf/utility :asdf/upgrade
         :asdf/component :asdf/system :asdf/operation :asdf/action
         :asdf/lisp-build :asdf/lisp-action #:asdf/plan
@@ -16,6 +15,8 @@
    #:upgrade-asdf #:cleanup-upgraded-asdf #:*post-upgrade-hook*))
 (in-package :asdf/operate)
 
+(when-upgrade () (undefine-function 'operate))
+
 (defgeneric* operate (operation-class system &key &allow-other-keys))
 
 (defun* cleanup-upgraded-asdf ()
diff --git a/operation.lisp b/operation.lisp
index 6aad910d..4db71eff 100644
--- a/operation.lisp
+++ b/operation.lisp
@@ -13,7 +13,7 @@
 
 ;;; Operation Classes
 
-(with-upgrade (:when (find-class 'operation nil))
+(when-upgrade (:when (find-class 'operation nil))
   (defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key)
     (declare (ignorable o slot-names initargs)) (values)))
 
diff --git a/os.lisp b/os.lisp
index eba02723..8067e9ac 100644
--- a/os.lisp
+++ b/os.lisp
@@ -3,69 +3,52 @@
 
 (asdf/package:define-package :asdf/os
   (:recycle :asdf/os :asdf)
-  (:use :cl :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname)
+  (:use :cl :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream)
   (:export
    #:featurep #:os-unix-p #:os-windows-p ;; features
-   #:read-file-forms ;; simple filesystem manipulation
-   #:copy-stream-to-stream #:concatenate-files ;; simple stream copy
    #:getenv ;; environment variables, and parsing them
    #:inter-directory-separator #:split-pathnames*
    #:getenv-pathname #:getenv-pathnames
    #:getenv-absolute-directory #:getenv-absolute-directories
    #:implementation-identifier ;; implementation identifier
    #:implementation-type #:operating-system #:architecture #:lisp-version-string
-   #:hostname #:user-homedir #:lisp-implementation-directory))
+   #:hostname #:user-homedir #:lisp-implementation-directory
+   #:getcwd #:chdir #:call-with-current-directory #:with-current-directory
+   #:*temporary-directory* #:temporary-directory #:default-temporary-directory #:with-temporary-file))
 (in-package :asdf/os)
 
 ;;; Features
-(defun* featurep (x &optional (features *features*))
-  (cond
-    ((atom x)
-     (and (member x features) t))
-    ((eq :not (car x))
-     (assert (null (cddr x)))
-     (not (featurep (cadr x) features)))
-    ((eq :or (car x))
-     (some #'(lambda (x) (featurep x features)) (cdr x)))
-    ((eq :and (car x))
-     (every #'(lambda (x) (featurep x features)) (cdr x)))
-    (t
-     (error "Malformed feature specification ~S" x))))
-
-(defun* os-unix-p ()
-  (featurep '(:or :unix :cygwin :darwin)))
-
-(defun* os-windows-p ()
-  (and (not (os-unix-p)) (featurep '(:or :win32 :windows :mswindows :mingw32))))
-
-;;; Simple filesystem manipulation
-(defun* read-file-forms (file)
-  (with-open-file (in file)
-    (loop :with eof = (list nil)
-     :for form = (read in nil eof)
-     :until (eq form eof)
-     :collect form)))
-
-;; Simple stream copy
-(defun* copy-stream-to-stream (input output &key (element-type 'character) (buffer-size 8192))
-  "Copy the contents of the INPUT stream into the OUTPUT stream,
-using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
-  (with-open-stream (input input)
-    (loop
-      :for buffer = (make-array (list buffer-size) :element-type element-type)
-      :for end = (read-sequence buffer input)
-      :until (zerop end)
-      :do (write-sequence buffer output :end end)
-          (when (< end buffer-size) (return)))))
-
-(defun* concatenate-files (inputs output)
-  (with-open-file (o output :element-type '(unsigned-byte 8)
-                            :direction :output :if-exists :rename-and-delete)
-    (dolist (input inputs)
-      (with-open-file (i input :element-type '(unsigned-byte 8)
-                               :direction :input :if-does-not-exist :error)
-        (copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun* featurep (x &optional (features *features*))
+    (cond
+      ((atom x)
+       (and (member x features) t))
+      ((eq :not (car x))
+       (assert (null (cddr x)))
+       (not (featurep (cadr x) features)))
+      ((eq :or (car x))
+       (some #'(lambda (x) (featurep x features)) (cdr x)))
+      ((eq :and (car x))
+       (every #'(lambda (x) (featurep x features)) (cdr x)))
+      (t
+       (error "Malformed feature specification ~S" x))))
 
+  (defun* os-unix-p ()
+    (featurep '(:or :unix :cygwin :darwin)))
+
+  (defun* os-windows-p ()
+    (and (not (os-unix-p)) (featurep '(:or :win32 :windows :mswindows :mingw32))))
+
+  (defun detect-os ()
+    (flet ((yes (yes) (pushnew yes *features*))
+           (no (no) (setf *features* (remove no *features*))))
+      (cond
+        ((os-unix-p) (yes :os-unix) (no :os-windows))
+        ((os-windows-p) (yes :os-windows) (no :os-unix))
+        (t (error "Congratulations for trying XCVB on an operating system~%~
+that is neither Unix, nor Windows.~%Now you port it.")))))
+
+  (detect-os))
 
 ;;;; Environment variables: getting them, and parsing them.
 
@@ -92,11 +75,16 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
           (let ((value (_getenv name)))
             (unless (ccl:%null-ptr-p value)
               (ccl:%get-cstring value))))
-  #+mkcl (#.(or (find-symbol* 'getenv :si) (find-symbol* 'getenv :mk-ext)) x)
+  #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
   #+sbcl (sb-ext:posix-getenv x)
   #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
   (error "~S is not supported on your implementation" 'getenv))
 
+(defun getenvp (x)
+  "Predicate that is true if the named variable is present in the libc environment,
+then returning the non-empty string value of the variable"
+  (let ((g (getenv x))) (and (not (emptyp g)) g)))
+
 (defun* inter-directory-separator ()
   (if (os-unix-p) #\: #\;))
 (defun* split-pathnames* (x want-absolute want-directory fmt &rest args)
@@ -226,10 +214,113 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
           (ignore-errors
            #+clozure #p"ccl:"
            #+(or ecl mkcl) #p"SYS:"
-           #+sbcl (aif (find-symbol* :sbcl-homedir-pathname :sb-int)
+           #+gcl system::*system-directory*
+           #+sbcl (aif (find-symbol* :sbcl-homedir-pathname :sb-int nil)
                        (funcall it)
                        (getenv-pathname "SBCL_HOME" :want-directory t)))))
     (if (and dir truename)
         (truename* dir)
         dir)))
- 
\ No newline at end of file
+
+
+;;; Current directory
+
+(defun getcwd ()
+  "Get the current working directory as per POSIX getcwd(3)"
+  (or #+clisp (ext:default-directory)
+      #+clozure (ccl:current-directory)
+      #+cmu (unix:unix-current-directory)
+      #+cormanlisp (pl::get-current-directory)
+      #+ecl (ext:getcwd)
+      #+mkcl (mk-ext:getcwd)
+      #+sbcl (sb-unix:posix-getcwd/)
+      (error "getcwd not supported on your implementation")))
+
+(defun chdir (x)
+  "Change current directory, as per POSIX chdir(2)"
+  #-(or clisp clozure) (when (pathnamep x) (setf x (native-namestring x)))
+  (or #+clisp (ext:cd x)
+      #+clozure (setf (ccl:current-directory) x)
+      #+cormanlisp (unless (zerop (win32::_chdir x))
+                     (error "Could not set current directory to ~A" x))
+      #+sbcl (symbol-call :sb-posix :chdir x)
+      (error "chdir not supported on your implementation")))
+
+(defun call-with-current-directory (dir thunk)
+  (if dir
+      (let* ((dir (truename (merge-pathnames (pathname-directory-pathname dir))))
+             (*default-pathname-defaults* dir)
+             (cwd (getcwd)))
+        (chdir dir)
+        (unwind-protect
+             (funcall thunk)
+          (chdir cwd)))
+      (funcall thunk)))
+
+(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)))
+
+
+;;; Using temporary files
+
+(defun* default-temporary-directory ()
+  (flet ((f (s v d) (format nil "~A~A" (or (getenvp v) d (error "No temporary directory!")) s)))
+    (let ((dir (cond
+                 ((os-unix-p) (f #\/ "TMPDIR" "/tmp"))
+                 ((os-windows-p) (f #\\ "TEMP" nil))))
+          #+mcl (dir (probe-posix dir)))
+      (or (parse-native-namestring dir) (default-directory)))))
+
+(defvar *temporary-directory* nil)
+
+(defun temporary-directory ()
+  (or *temporary-directory* (default-temporary-directory)))
+
+(defun call-with-temporary-file
+    (thunk &key
+     prefix keep (direction :io)
+     (element-type *default-stream-element-type*)
+     (external-format :default))
+  (check-type direction (member :output :io))
+  (loop
+    :with prefix = (or prefix (format nil "~Atmp" (native-namestring (temporary-directory))))
+    :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 direction 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 direction `(:direction ,direction))
+      ,@(when prefix `(:prefix ,prefix))
+      ,@(when keep `(:keep ,keep))
+      ,@(when element-type `(:element-type ,element-type))
+      ,@(when external-format `(:external-format external-format)))))
+
diff --git a/output-translations.lisp b/output-translations.lisp
index e059809c..12da8034 100644
--- a/output-translations.lisp
+++ b/output-translations.lisp
@@ -3,9 +3,7 @@
 
 (asdf/package:define-package :asdf/output-translations
   (:recycle :asdf/output-translations :asdf)
-  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/configuration :asdf/action)
-  (:fmakunbound #:apply-output-translations)
-  (:fmakunbound-setf #:output-translations)
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/upgrade :asdf/configuration)
   (:export
    #:invalid-output-translation
    #:output-translations #:output-translations-initialized-p
@@ -22,6 +20,8 @@
    ))
 (in-package :asdf/output-translations)
 
+(when-upgrade () (undefine-functions '(apply-output-translations (setf output-translations))))
+
 (define-condition invalid-output-translation (invalid-configuration warning)
   ((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
 
@@ -281,16 +281,6 @@ effectively disabling the output translation facility."
        :return (translate-pathname* p absolute-source destination root source)
        :finally (return p)))))
 
-(defmethod output-files :around (operation component)
-  "Translate output files, unless asked not to"
-  operation component ;; hush genera, not convinced by declare ignorable(!)
-  (values
-   (multiple-value-bind (files fixedp) (call-next-method)
-     (if fixedp
-         files
-         (mapcar #'apply-output-translations files)))
-   t))
-
 #+abcl
 (defun* translate-jar-pathname (source wildcard)
   (declare (ignore wildcard))
@@ -318,4 +308,5 @@ effectively disabling the output translation facility."
              (merge-pathnames* relative-source target-root)))
       (normalize-device (apply-output-translations target)))))
 
+(setf *output-translation-hook* 'apply-output-translations)
 (pushnew 'clear-output-translations *clear-configuration-hook*)
diff --git a/package.lisp b/package.lisp
index 71617f2f..e3c0f244 100644
--- a/package.lisp
+++ b/package.lisp
@@ -13,14 +13,14 @@
 (defpackage :asdf/package
   (:use :common-lisp)
   (:export
-   #:find-package* #:find-symbol* #:intern* #:unintern*
+   #:find-package* #:find-symbol* #:symbol-call #:intern* #:unintern*
+   #:symbol-shadowing-p #:rehome-symbol
+   #:delete-package* #:package-names #:packages-from-names
    #:symbol-name-package #:package-data
-   #:delete-package* #:ensure-package #:define-package))
+   #:ensure-package #:define-package))
 
 (in-package :asdf/package)
 
-(declaim (optimize (speed 0) (safety 3) #-gcl (debug 3)))
-
 (defmacro DBG (tag &rest exprs)
   "simple debug statement macro:
 outputs a tag plus a list of variable and their values, returns the last value"
@@ -38,6 +38,7 @@ outputs a tag plus a list of variable and their values, returns the last value"
          exprs)
       (apply 'values ,res)))))
 
+
 ;;;; General purpose package utilities
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
@@ -62,6 +63,11 @@ when the symbol is not found."
               (status (return (values symbol status)))
               (error (error "There is no symbol ~S in package ~S" name (package-name package))))))
         (values nil nil))))
+  (defun symbol-call (package name &rest args)
+    "Call a function associated with symbol of given name in given package,
+with given ARGS. Useful when the call is read before the package is loaded,
+or when loading the package is optional."
+    (apply (find-symbol* name package) args))
   (defun intern* (name package-designator &optional (error t))
     (intern (string name) (find-package* package-designator error)))
   (defun unintern* (name package-designator &optional (error t))
@@ -122,10 +128,25 @@ when the symbol is not found."
             (when (eq overwritten-symbol-status :external)
               (export symbol package))))
         (values overwritten-symbol overwritten-symbol-status))))
-  (defun symbol-name-package (symbol)
-    (cons (symbol-name symbol) (package-name (symbol-package symbol))))
+  (defun ensure-package-unused (package)
+    (loop :for p :in (package-used-by-list package) :do
+      (unuse-package package p)))
+  (defun delete-package* (package)
+    (let ((p (find-package package)))
+      (when p
+        (ensure-package-unused p)
+        (delete-package package))))
   (defun package-names (package)
     (cons (package-name package) (package-nicknames package)))
+  (defun packages-from-names (names)
+    (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)))
+
+
+;;; Communicable representation of symbol and package information
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (defun symbol-name-package (symbol)
+    (cons (symbol-name symbol) (package-name (symbol-package symbol))))
   (defun package-data (package-designator &key name-package (error t))
     (let ((package (find-package* package-designator error)))
       (when package
@@ -153,34 +174,16 @@ when the symbol is not found."
                        :use ,(sort-packages (package-use-list package))
                        :used-by ,(sort-packages (package-used-by-list package))))))))))
 
+
+;;; ensure-package, define-package
+
 (eval-when (:load-toplevel :compile-toplevel :execute)
-  (defun soft-upgrade-p (upgrade)
-    (ecase upgrade ((:soft nil) t) (:hard nil)))
-  (defun ensure-package-unused (package)
-    (loop :for p :in (package-used-by-list package) :do
-      (unuse-package package p)))
-  (defun delete-package* (package)
-    (let ((p (find-package package)))
-      (when p
-        (ensure-package-unused p)
-        (delete-package package))))
-  (defun ensure-package-fmakunbound (package symbols)
-    (loop :for name :in symbols
-          :for sym = (find-symbol* name package nil)
-          :when sym :do (fmakunbound sym)))
-  (defun ensure-package-fmakunbound-setf (package symbols)
-    (loop :for name :in symbols
-          :for sym = (find-symbol* name package nil)
-          :when sym :do (progn #-gcl (fmakunbound `(setf ,sym)))))
-  (defun packages-from-names (names)
-    (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
   (defun ensure-package (name &key
-                                upgrade
                                 nicknames documentation use
                                 shadow shadowing-import-from
                                 import-from export intern
                                 recycle mix reexport
-                                unintern fmakunbound fmakunbound-setf)
+                                unintern)
     (let* ((name (string name))
            (nicknames (mapcar #'string nicknames))
            (names (cons name nicknames))
@@ -292,7 +295,6 @@ when the symbol is not found."
                        (t (return)))
                      (when (eq ustat :external)
                        (ensure-exported name sym u))))))))
-        (assert (soft-upgrade-p upgrade))
         #-gcl (setf (documentation package t) documentation) #+gcl documentation
         (loop :for p :in discarded
               :for n = (remove-if #'(lambda (x) (member x names :test 'equal))
@@ -327,28 +329,24 @@ when the symbol is not found."
           (do-external-symbols (sym p) (ensure-mix sym p)))
         (loop :for (p . syms) :in import-from :do
           (dolist (sym syms) (ensure-import sym p)))
-        (loop :for p :in use :for sp = (string p) :for pp = (find-package sp) :do
+        (loop :for p :in use :for sp = (string p) :for pp = (find-package* sp) :do
           (do-external-symbols (sym pp) (ensure-inherited sym sp))
           (use-package pp package))
         (loop :for name :being :the :hash-keys :of exported :do
           (ensure-symbol name t))
-        (dolist (name (append intern fmakunbound fmakunbound-setf))
+       (dolist (name intern)
           (ensure-symbol (string name) t))
         (do-symbols (sym package)
           (ensure-symbol (symbol-name sym)))
         (loop :for name :being :the :hash-keys :of exported :do
           (ensure-export name package))
-        ;; do away with packages with conflicting (nick)names
-        ;; note from ASDF 2.26: ECL might not be liking an early fmakunbound (below #-ecl'ed)
-        (ensure-package-fmakunbound package fmakunbound)
-        (ensure-package-fmakunbound-setf package fmakunbound-setf)
         package))))
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (defun parse-define-package-form (package clauses)
     (loop
       :with use-p = nil :with recycle-p = nil
-      :with documentation = nil :with upgrade = nil
+      :with documentation = nil
       :for (kw . args) :in clauses
       :when (eq kw :nicknames) :append args :into nicknames :else
       :when (eq kw :documentation)
@@ -366,23 +364,14 @@ when the symbol is not found."
       :when (eq kw :mix) :append args :into mix :else
       :when (eq kw :reexport) :append args :into reexport :else
       :when (eq kw :unintern) :append args :into unintern :else
-      :when (eq kw :fmakunbound) :append args :into fmakunbound :else
-      :when (eq kw :fmakunbound-setf) :append args :into fmakunbound-setf :else
-      :when (eq kw :upgrade)
-        :do (unless (and (consp args) (null (cdr args)) (member (car args) '(:soft :hard)) (null upgrade))
-              (error "define-package: bad :upgrade directive"))
-            (setf upgrade (car args)) :else
       :do (error "unrecognized define-package keyword ~S" kw)
-      (progn fmakunbound fmakunbound-setf)
       :finally (return `(,package
                          :nicknames ,nicknames :documentation ,documentation
                          :use ,(if use-p use '(:common-lisp))
                          :shadow ,shadow :shadowing-import-from ,shadowing-import-from
                          :import-from ,import-from :export ,export :intern ,intern
                          :recycle ,(if recycle-p recycle (cons package nicknames))
-                         :mix ,mix :reexport ,reexport :unintern ,unintern
-                         ,@(when upgrade `(:upgrade ,upgrade))
-                         #|:fmakunbound ,fmakunbound :fmakunbound-setf ,fmakunbound-setf|#)))))
+                         :mix ,mix :reexport ,reexport :unintern ,unintern)))))
 
 (defmacro define-package (package &rest clauses)
   `(eval-when (:compile-toplevel :load-toplevel :execute)
diff --git a/pathname.lisp b/pathname.lisp
index 601fda3b..c09499dd 100644
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -3,9 +3,8 @@
 
 (asdf/package:define-package :asdf/pathname
   (:recycle :asdf/pathname :asdf)
-  (:fmakunbound #:translate-pathname*)
   #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks
-  (:use :common-lisp :asdf/utility)
+  (:use :common-lisp :asdf/compatibility :asdf/utility)
   (:export
    #:*resolve-symlinks*
    ;; Making and merging pathnames, portably
@@ -42,6 +41,7 @@
    #:delete-file-if-exists
    ;; Translate a pathname
    #:translate-pathname*
+   #:native-namestring #:parse-native-namestring
    ;; temporary 
    #:add-pathname-suffix #:tmpize-pathname
    #:call-with-staging-pathname #:with-staging-pathname
@@ -54,6 +54,8 @@
    #:parse-file-location-info #:parse-windows-shortcut))
 (in-package :asdf/pathname)
 
+(eval-when (:compile-toplevel :load-toplevel :execute) (fmakunbound 'translate-pathname*))
+
 ;;; User-visible parameters
 (defvar *resolve-symlinks* t
   "Determine whether or not ASDF resolves symlinks when defining systems.
@@ -270,7 +272,7 @@ with given pathname and if it exists return its truename."
       (pathname (unless (wild-pathname-p p)
                   #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks mkcl sbcl scl)
                         '(probe-file p)
-                        #+clisp (aif (find-symbol* '#:probe-pathname :ext)
+                        #+clisp (aif (find-symbol* '#:probe-pathname :ext nil)
                                      `(ignore-errors (,it p)))
                         #+gcl<2.7
                         '(or (probe-file p)
@@ -297,7 +299,7 @@ with given pathname and if it exists return its truename."
                              #+clozure '(:follow-links nil)
                              #+clisp '(:circle t :if-does-not-exist :ignore)
                              #+(or cmu scl) '(:follow-links nil :truenamep nil)
-                             #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl)
+                             #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
                                       '(:resolve-symlinks nil))))))
 
 (defun* filter-logical-directory-results (directory entries merger)
@@ -674,6 +676,25 @@ Host, device and version components are taken from DEFAULTS."
     (t
      (translate-pathname path absolute-source destination))))
 
+
+;;; Native vs Lisp syntax
+
+(defun native-namestring (x)
+  "From a CL pathname, a namestring suitable for use by the OS shell"
+  (let ((p (pathname x)))
+    #+clozure (let ((*default-pathname-defaults* #p"")) (ccl:native-translated-namestring p)) ; see ccl bug 978
+    #+(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))
+
+
 ;;; Temporary pathnames
 (defun* add-pathname-suffix (pathname suffix)
   (make-pathname :name (strcat (pathname-name pathname) suffix)
diff --git a/plan.lisp b/plan.lisp
index 13deebc8..60b71278 100644
--- a/plan.lisp
+++ b/plan.lisp
@@ -3,8 +3,7 @@
 
 (asdf/package:define-package :asdf/plan
   (:recycle :asdf/plan :asdf)
-  (:fmakunbound #:traverse #:perform-plan #:traverse-action)
-  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade
    :asdf/component :asdf/system :asdf/find-system :asdf/find-component
    :asdf/operation :asdf/action)
   #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of)
@@ -25,6 +24,8 @@
    #:perform-plan #:plan-operates-on-p))
 (in-package :asdf/plan)
 
+(when-upgrade () (undefine-functions '(traverse perform-plan traverse-action)))
+
 ;;;; Planned action status
 
 (defgeneric* plan-action-status (plan operation component)
diff --git a/run-program.lisp b/run-program.lisp
new file mode 100644
index 00000000..d24ad9e4
--- /dev/null
+++ b/run-program.lisp
@@ -0,0 +1,363 @@
+;;;; -------------------------------------------------------------------------
+;;;; run-program/ initially from xcvb-driver.
+
+(asdf/package:define-package :asdf/run-program
+  (:recycle :asdf/run-program :xcvb-driver)
+  (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os)
+  (:export
+   ;;; Escaping the command invocation madness
+   #:easy-sh-character-p #:escape-sh-token #:escape-sh-command
+   #:escape-windows-token #:escape-windows-command
+   #:escape-token #:escape-command
+
+   ;;; run-program/foo
+   #:run-program/
+   #:subprocess-error
+   #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process))
+(in-package :asdf/run-program)
+
+;;;; ----- Escaping strings for the shell -----
+
+(defun requires-escaping-p (token &key good-chars bad-chars)
+  "Does this token require escaping, given the specification of
+either good chars that don't need escaping or bad chars that do need escaping,
+as either a recognizing function or a sequence of characters."
+  (some
+   (cond
+     ((and good-chars bad-chars)
+      (error "only one of good-chars and bad-chars can be provided"))
+     ((functionp good-chars)
+      (complement good-chars))
+     ((functionp bad-chars)
+      bad-chars)
+     ((and good-chars (typep good-chars 'sequence))
+      (lambda (c) (not (find c good-chars))))
+     ((and bad-chars (typep bad-chars 'sequence))
+      (lambda (c) (find c bad-chars)))
+     (t (error "requires-escaping-p: no good-char criterion")))
+   token))
+
+(defun output-string (string &optional stream)
+  (if stream
+      (with-output (stream) (princ string stream))
+      string))
+
+(defun escape-token (token &key stream quote good-chars bad-chars escaper)
+  "Call the ESCAPER function on TOKEN string if it needs escaping as per
+REQUIRES-ESCAPING-P using GOOD-CHARS and BAD-CHARS, otherwise output TOKEN,
+using STREAM as output (or returning result as a string if NIL)"
+  (if (requires-escaping-p token :good-chars good-chars :bad-chars bad-chars)
+      (with-output (stream)
+        (apply escaper token stream (when quote `(:quote ,quote))))
+      (output-string token stream)))
+
+(defun escape-windows-token-within-double-quotes (x &optional s)
+  "Escape a string token X within double-quotes
+for use within a MS Windows command-line, outputing to S."
+  (labels ((issue (c) (princ c s))
+           (issue-backslash (n) (loop :repeat n :do (issue #\\))))
+    (loop
+      :initially (issue #\") :finally (issue #\")
+      :with l = (length x) :with i = 0
+      :for i+1 = (1+ i) :while (< i l) :do
+      (case (char x i)
+        ((#\") (issue-backslash 1) (issue #\") (setf i i+1))
+        ((#\\)
+         (let* ((j (and (< i+1 l) (position-if-not
+                                   (lambda (c) (eql c #\\)) x :start i+1)))
+                (n (- (or j l) i)))
+           (cond
+             ((null j)
+              (issue-backslash (* 2 n)) (setf i l))
+             ((and (< j l) (eql (char x j) #\"))
+              (issue-backslash (1+ (* 2 n))) (issue #\") (setf i (1+ j)))
+             (t
+              (issue-backslash n) (setf i j)))))
+        (otherwise
+         (issue (char x i)) (setf i i+1))))))
+
+(defun escape-windows-token (token &optional s)
+  "Escape a string TOKEN within double-quotes if needed
+for use within a MS Windows command-line, outputing to S."
+  (escape-token token :stream s :bad-chars #(#\space #\tab #\") :quote nil
+                :escaper 'escape-windows-token-within-double-quotes))
+
+(defun escape-sh-token-within-double-quotes (x s &key (quote t))
+  "Escape a string TOKEN within double-quotes
+for use within a POSIX Bourne shell, outputing to S;
+omit the outer double-quotes if key argument :QUOTE is NIL"
+  (when quote (princ #\" s))
+  (loop :for c :across x :do
+    (when (find c "$`\\\"") (princ #\\ s))
+    (princ c s))
+  (when quote (princ #\" s)))
+
+(defun easy-sh-character-p (x)
+  (or (alphanumericp x) (find x "+-_.,%@:/")))
+
+(defun escape-sh-token (token &optional s)
+  "Escape a string TOKEN within double-quotes if needed
+for use within a POSIX Bourne shell, outputing to S."
+  (escape-token token :stream s :quote #\" :good-chars
+                #'easy-sh-character-p
+                :escaper 'escape-sh-token-within-double-quotes))
+
+(defun escape-shell-token (token &optional s)
+  (cond
+    ((os-unix-p) (escape-sh-token token s))
+    ((os-windows-p) (escape-windows-token token s))))
+
+(defun escape-command (command &optional s
+                       (escaper 'escape-shell-token))
+  "Given a COMMAND as a list of tokens, return a string of the
+spaced, escaped tokens, using ESCAPER to escape."
+  (etypecase command
+    (string (output-string command s))
+    (list (with-output (s)
+            (loop :for first = t :then nil :for token :in command :do
+              (unless first (princ #\space s))
+              (funcall escaper token s))))))
+
+(defun escape-windows-command (command &optional s)
+  "Escape a list of command-line arguments into a string suitable for parsing
+by CommandLineToArgv in MS Windows"
+    ;; http://msdn.microsoft.com/en-us/library/bb776391(v=vs.85).aspx
+    ;; http://msdn.microsoft.com/en-us/library/17w5ykft(v=vs.85).aspx
+  (escape-command command s 'escape-windows-token))
+
+(defun escape-sh-command (command &optional s)
+  "Escape a list of command-line arguments into a string suitable for parsing
+by /bin/sh in POSIX"
+  (escape-command command s 'escape-sh-token))
+
+(defun escape-shell-command (command &optional stream)
+  "Escape a command for the current operating system's shell"
+  (escape-command command stream 'escape-shell-token))
+
+;;;; ----- Running an external program -----
+;;; Simple variant of run-program with no input, and capturing output
+;;; On some implementations, may output to a temporary file...
+
+(defgeneric slurp-input-stream (processor input-stream &key &allow-other-keys))
+
+(defmethod slurp-input-stream ((function function) input-stream &key &allow-other-keys)
+  (funcall function input-stream))
+
+(defmethod slurp-input-stream ((list cons) input-stream &key &allow-other-keys)
+  (apply (first list) (cons input-stream (rest list))))
+
+(defmethod slurp-input-stream ((output-stream stream) input-stream
+                               &key (element-type 'character) &allow-other-keys)
+  (copy-stream-to-stream
+   input-stream output-stream :element-type element-type))
+
+(defmethod slurp-input-stream ((x (eql 'string)) stream &key &allow-other-keys)
+  (declare (ignorable x))
+  (slurp-stream-string stream))
+
+(defmethod slurp-input-stream ((x (eql :string)) stream &key &allow-other-keys)
+  (declare (ignorable x))
+  (slurp-stream-string stream))
+
+(defmethod slurp-input-stream ((x (eql :lines)) stream &key &allow-other-keys)
+  (declare (ignorable x))
+  (slurp-stream-lines stream))
+
+(defmethod slurp-input-stream ((x (eql :form)) stream &key &allow-other-keys)
+  (declare (ignorable x))
+  (read stream))
+
+(defmethod slurp-input-stream ((x (eql :forms)) stream &key &allow-other-keys)
+  (declare (ignorable x))
+  (slurp-stream-forms stream))
+
+(define-condition subprocess-error (error)
+  ((code :initform nil :initarg :code :reader subprocess-error-code)
+   (command :initform nil :initarg :command :reader subprocess-error-command)
+   (process :initform nil :initarg :process :reader subprocess-error-process))
+  (:report (lambda (condition stream)
+             (format stream "Subprocess~@[ ~S~]~@[ run with command ~S~] exited with error~@[ code ~D~]"
+                     (subprocess-error-process condition)
+                     (subprocess-error-command condition)
+                     (subprocess-error-code condition)))))
+
+(defun run-program/ (command
+                     &key output ignore-error-status force-shell
+                     (element-type *default-stream-element-type*)
+                     (external-format :default)
+                     &allow-other-keys)
+  "Run program specified by COMMAND,
+either a list of strings specifying a program and list of arguments,
+or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows);
+have its output processed by the OUTPUT processor function
+as per SLURP-INPUT-STREAM,
+or merely output to the inherited standard output if it's NIL.
+Always call a shell (rather than directly execute the command)
+if FORCE-SHELL is specified.
+Issue an error if the process wasn't successful unless IGNORE-ERROR-STATUS
+is specified.
+Return the exit status code of the process that was called.
+Use ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT processor."
+  (declare (ignorable ignore-error-status element-type external-format))
+  #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl)
+  (error "RUN-PROGRAM/ not implemented for this Lisp")
+  (labels (#+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl)
+           (run-program (command &key pipe interactive)
+             "runs the specified command (a list of program and arguments).
+              If using a pipe, returns two values: process and stream
+              If not using a pipe, returns one values: the process result;
+              also, inherits the output stream."
+             ;; NB: these implementations have unix vs windows set at compile-time.
+	     (assert (not (and pipe interactive)))
+             (let* ((wait (not pipe))
+                    #-(and clisp os-windows)
+                    (command
+                     (etypecase command
+                       #+os-unix (string `("/bin/sh" "-c" ,command))
+                       #+os-unix (list command)
+                       #+os-windows
+                       (string
+                        ;; NB: We do NOT add cmd /c here. You might want to.
+                        #+allegro command
+			;; On ClozureCL for Windows, we assume you are using
+			;; r15398 or later in 1.9 or later,
+			;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
+			#+clozure (cons "cmd" (strcat "/c " command))
+                        ;; NB: On other Windows implementations, this is utterly bogus
+                        ;; except in the most trivial cases where no quoting is needed.
+                        ;; Use at your own risk.
+                        #-(or allegro clozure) (list "cmd" "/c" command))
+                       #+os-windows
+                       (list
+                        #+(or allegro clozure) (escape-windows-command command)
+                        #-(or allegro clozure) command)))
+                    #+(and clozure os-windows) (command (list command))
+                    (process*
+                     (multiple-value-list
+                      #+allegro
+                      (excl:run-shell-command
+                       #+os-unix (coerce (cons (first command) command) 'vector)
+                       #+os-windows command
+                       :input interactive :output (or (and pipe :stream) interactive) :wait wait
+                       #+os-windows :show-window #+os-windows (and pipe :hide))
+                      #+clisp
+                      (flet ((run (f &rest args)
+                               (apply f `(,@args :input ,(when interactive :terminal) :wait ,wait :output
+                                          ,(if pipe :stream :terminal)))))
+                        (etypecase command
+                          #+os-windows (run 'ext:run-shell-command command)
+                          (list (run 'ext:run-program (car command)
+                                     :arguments (cdr command)))))
+                      #+lispworks
+                      (system:run-shell-command
+                       (cons "/usr/bin/env" command) ; lispworks wants a full path.
+                       :input interactive :output (or (and pipe :stream) interactive)
+                       :wait wait :save-exit-status (and pipe t))
+                      #+(or clozure cmu ecl sbcl scl)
+                      (#+(or cmu ecl scl) ext:run-program
+                       #+clozure ccl:run-program
+                       #+sbcl sb-ext:run-program
+                       (car command) (cdr command)
+                       :input interactive :wait wait
+                       :output (if pipe :stream t)
+                       . #.(append
+                            #+(or clozure cmu ecl sbcl scl) '(:error t)
+                            #+sbcl '(:search t
+                                     #|:external-format external-format ; not in old SBCLs|#)))))
+                    (process
+                     #+(or allegro lispworks) (if pipe (third process*) (first process*))
+                     #+ecl (third process*)
+                     #-(or allegro lispworks ecl) (first process*))
+                    (stream
+                     (when pipe
+                       #+(or allegro lispworks ecl) (first process*)
+                       #+clisp (first process*)
+                       #+clozure (ccl::external-process-output process)
+                       #+(or cmu scl) (ext:process-output process)
+                       #+sbcl (sb-ext:process-output process))))
+               (values process stream)))
+           #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl)
+           (process-result (process)
+             ;; 1- wait
+             #+(and clozure os-unix) (ccl::external-process-wait process)
+             #+(or cmu scl) (ext:process-wait process)
+             #+(and ecl os-unix) (ext:external-process-wait process)
+             #+sbcl (sb-ext:process-wait process)
+             ;; 2- extract result
+             #+allegro (sys:reap-os-subprocess :pid process :wait t)
+             #+clisp process
+             #+clozure (nth-value 1 (ccl:external-process-status process))
+             #+(or cmu scl) (ext:process-exit-code process)
+             #+ecl (nth-value 1 (ext:external-process-status process))
+             #+lispworks (system:pid-exit-status process :wait t)
+             #+sbcl (sb-ext:process-exit-code process))
+           (check-result (exit-code process)
+             #+clisp
+             (setf exit-code
+                   (typecase exit-code (integer exit-code) (null 0) (t -1)))
+             (unless (or ignore-error-status
+                         (equal exit-code 0))
+               (error 'subprocess-error :command command :code exit-code :process process))
+	     exit-code)
+           (use-run-program ()
+             #-(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl)
+             (let* ((interactive (eq output :interactive))
+		    (pipe (and output (not interactive))))
+               (multiple-value-bind (process stream)
+                   (run-program command :pipe pipe :interactive interactive)
+                 (if (and output (not interactive))
+                     (unwind-protect
+                          (slurp-input-stream output stream)
+                       (when stream (close stream))
+                       (check-result (process-result process) process))
+                     (unwind-protect
+                          (check-result
+                           #+(or allegro lispworks) ; when not capturing, returns the exit code!
+                           process
+                           #-(or allegro lispworks) (process-result process)
+                           process))))))
+           (system-command (command)
+             (etypecase command
+               (string (if (os-windows-p) (format nil "cmd /c ~A" command) command))
+               (list (escape-shell-command
+                      (if (os-unix-p) (cons "exec" command) command)))))
+           (redirected-system-command (command out)
+             (format nil (if (os-unix-p) "exec > ~*~A ; ~2:*~A" "~A > ~A")
+                     (system-command command) (native-namestring out)))
+           (system (command &key interactive)
+             #+(or abcl xcl) (ext:run-shell-command command)
+             #+allegro
+             (excl:run-shell-command command :input interactive :output interactive :wait t)
+             #+(or clisp clozure cmu (and lispworks os-unix) sbcl scl)
+             (process-result (run-program command :pipe nil :interactive interactive))
+             #+ecl (ext:system command)
+             #+cormanlisp (win32:system command)
+             #+gcl (lisp:system command)
+             #+(and lispworks os-windows)
+             (system:call-system-showing-output
+              command :show-cmd interactive :prefix "" :output-stream nil)
+             #+mcl (ccl::with-cstrs ((%command command)) (_system %command))
+             #+mkcl (nth-value 2
+                               (mkcl:run-program #+windows command #+windows ()
+                                                 #-windows "/bin/sh" (list "-c" command)
+                                                 :input nil :output nil)))
+           (call-system (command-string &key interactive)
+             (check-result (system command-string :interactive interactive) nil))
+           (use-system ()
+	     (let ((interactive (eq output :interactive)))
+	       (if (and output (not interactive))
+		   (with-temporary-file (:pathname tmp :direction :output)
+		     (call-system (redirected-system-command command tmp))
+		     (with-open-file (stream tmp
+					     :direction :input
+					     :if-does-not-exist :error
+					     :element-type element-type
+					     :external-format external-format)
+		       (slurp-input-stream output stream)))
+		   (call-system (system-command command) :interactive interactive)))))
+    (if (and (not force-shell)
+             #+(or clisp ecl) ignore-error-status
+             #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) nil)
+        (use-run-program)
+        (use-system))))
+
diff --git a/source-registry.lisp b/source-registry.lisp
index 9892bc0d..c0e63727 100644
--- a/source-registry.lisp
+++ b/source-registry.lisp
@@ -4,7 +4,6 @@
 
 (asdf/package:define-package :asdf/source-registry
   (:recycle :asdf/source-registry :asdf)
-  (:fmakunbound #:inherit-source-registry #:process-source-registry #:process-source-registry-directive)
   (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os
         :asdf/upgrade :asdf/find-system :asdf/configuration)
   (:export
@@ -25,6 +24,10 @@
    #:sysdef-source-registry-search))
 (in-package :asdf/source-registry)
 
+(when-upgrade ()
+  (undefine-functions '(inherit-source-registry process-source-registry
+                        process-source-registry-directive)))
+
 (define-condition invalid-source-registry (invalid-configuration warning)
   ((format :initform (compatfmt "~@<Invalid source registry ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
 
diff --git a/stream.lisp b/stream.lisp
new file mode 100644
index 00000000..9fabbe67
--- /dev/null
+++ b/stream.lisp
@@ -0,0 +1,190 @@
+;;;; ---------------------------------------------------------------------------
+;;;; Utilities related to streams
+
+(asdf/package:define-package :asdf/stream
+  (:recycle :asdf/stream)
+  (:use :cl :asdf/package :asdf/compatibility :asdf/utility)
+  (:export
+   #:*default-stream-element-type* #:*stderr*
+   #:finish-outputs #:format!
+   #:with-output #:with-input #:call-with-input-file
+   #:with-safe-io-syntax #:read-function
+   #:read-file-forms #:read-first-file-form
+   #:copy-stream-to-stream #:concatenate-files
+   #:copy-stream-to-stream-line-by-line
+   #:slurp-stream-string #:slurp-stream-lines
+   #:slurp-stream-forms #:slurp-file-string
+   #:slurp-file-lines #:slurp-file-forms))
+(in-package :asdf/stream)
+
+(defvar *default-stream-element-type* (or #+(or abcl cmu cormanlisp scl xcl) 'character :default)
+  "default element-type for open (depends on the current CL implementation)")
+
+(defvar *stderr* #-clozure *error-output* #+clozure ccl::*stderr*
+  "the original error output stream at startup")
+
+
+;;; Ensure output buffers are flushed
+
+(defun finish-outputs ()
+  "Finish output on the main output streams.
+Useful for portably flushing I/O before user input or program exit."
+  ;; CCL notably buffers its stream output by default.
+  (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))
+
+
+;;; Output to a stream or string, FORMAT-style
+
+(defgeneric call-with-output (x thunk)
+  (:documentation
+   ;; code from fare-utils base/streams where it's now named
+   ;; call-with-output-stream to avoid the package clash in a lot of my code.
+   "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
+
+(defun call-with-input-file (pathname thunk
+                             &key (element-type *default-stream-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))
+
+
+;;; 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 () (let ((*package* (find-package ,package))) ,@body))))
+
+(defun call-with-safe-io-syntax (thunk &key (package :cl))
+  (with-standard-io-syntax ()
+    (let ((*package* (find-package package))
+          (*print-readably* nil)
+	  (*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-file-forms (file)
+  (with-open-file (in file)
+    (loop :with eof = (list nil)
+     :for form = (read in nil eof)
+     :until (eq form eof)
+     :collect form)))
+
+(defun read-first-file-form (pathname &key (package :cl) eof-error-p eof-value)
+  "Reads the first form from the top of a file using a safe standardized syntax"
+  (with-safe-io-syntax (:package package)
+    (with-input-file (in pathname)
+      (read in eof-error-p eof-value))))
+
+
+;;; Simple Whole-Stream processing
+
+(defun* copy-stream-to-stream (input output &key (element-type 'character) (buffer-size 8192))
+  "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
+      :for buffer = (make-array (list buffer-size) :element-type element-type)
+      :for end = (read-sequence buffer input)
+      :until (zerop end)
+      :do (write-sequence buffer output :end end)
+          (when (< end buffer-size) (return)))))
+
+(defun* concatenate-files (inputs output)
+  (with-open-file (o output :element-type '(unsigned-byte 8)
+                            :direction :output :if-exists :rename-and-delete)
+    (dolist (input inputs)
+      (with-open-file (i input :element-type '(unsigned-byte 8)
+                               :direction :input :if-does-not-exist :error)
+        (copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
+
+(defun copy-stream-to-stream-line-by-line (input output &key prefix)
+  "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
+      (when prefix (princ prefix output))
+      (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))
+
diff --git a/system.lisp b/system.lisp
index d104595c..255adf4c 100644
--- a/system.lisp
+++ b/system.lisp
@@ -3,7 +3,6 @@
 
 (asdf/package:define-package :asdf/system
   (:recycle :asdf/system :asdf)
-  (:fmakunbound #:find-system #:system-source-file #:system-relative-pathname #:builtin-system-p)
   (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade
    :asdf/component)
   (:intern #:children #:children-by-name #:default-component-class
@@ -22,6 +21,10 @@
    #:system-defsystem-depends-on))
 (in-package :asdf/system)
 
+(when-upgrade ()
+  (undefine-functions '(find-system system-source-file
+                        system-relative-pathname builtin-system-p)))
+
 (defgeneric* find-system (system &optional error-p))
 (declaim (ftype (function (t t) t) probe-asd))
 
@@ -56,7 +59,7 @@
                   (setf (gethash name hash) c))
         hash))))
 
-(with-upgrade (:when (find-class 'module nil))
+(when-upgrade (:when (find-class 'module nil))
   (defmethod reinitialize-instance :after ((m module) &rest initargs &key)
     (declare (ignorable m initargs)) (values))
   (defmethod update-instance-for-redefined-class :after
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 4cdfd732..dbccd990 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -6,7 +6,6 @@
    #:register-directory #:asdf-load
    #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system
    #:quit-on-error #:test-asdf
-   #:native-namestring
    #:assert-equal
    #:exit-lisp #:leave-lisp
    #:quietly))
@@ -108,13 +107,6 @@
 #+allegro
 (setf excl:*warn-on-nested-reader-conditionals* nil)
 
-(defun native-namestring (x)
-  (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)))
-
 ;;; code adapted from cl-launch http://www.cliki.net/cl-launch
 (defun exit-lisp (return)
   #+allegro
diff --git a/test/test1.script b/test/test1.script
index ea61d1a4..1f1ae519 100644
--- a/test/test1.script
+++ b/test/test1.script
@@ -7,13 +7,13 @@
 (touch-file "file2.lisp" :offset -3400)
 
 (quit-on-error
+ (DBG "loading test1")
+ (asdf:load-system 'test1)
  (let* ((file1 (asdf:compile-file-pathname* "file1"))
         (file2 (asdf:compile-file-pathname* "file2"))
         (date (file-write-date "test1.asd"))
         (then (file-write-date file2)))
 
-   (DBG "loading test1")
-   (asdf:load-system 'test1)
    (DBG "test that it compiled" date then)
    (assert (probe-file file1))
    (assert (probe-file file2))
diff --git a/upgrade.lisp b/upgrade.lisp
index 6bebf5ed..d8c3b9e5 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -6,7 +6,7 @@
   (:recycle :asdf/upgrade :asdf)
   (:use :common-lisp :asdf/package :asdf/compatibility :asdf/utility)
   (:export
-   #:upgrade-asdf #:asdf-upgrade-error #:with-upgrade
+   #:upgrade-asdf #:asdf-upgrade-error #:when-upgrade
    #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook*
    #:asdf-version #:*upgraded-p*
    #:asdf-message #:*asdf-verbose* #:*verbose-out*))
@@ -31,7 +31,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.73")
+         (asdf-version "2.26.74")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -52,7 +52,7 @@
   (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~
           Otherwise, when you upgrade ASDF, you must do it before you operate on any system.~%"))
 
-(defmacro with-upgrade ((&key (upgraded-p '*upgraded-p*) when) &body body)
+(defmacro when-upgrade ((&key (upgraded-p '*upgraded-p*) when) &body body)
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (when (and ,upgraded-p ,@(when when `(,when)))
        (handler-bind ((style-warning #'muffle-warning))
diff --git a/utility.lisp b/utility.lisp
index 84e5a4fe..9f15dd74 100644
--- a/utility.lisp
+++ b/utility.lisp
@@ -4,31 +4,47 @@
 (asdf/package:define-package :asdf/utility
   (:recycle :asdf/utility :asdf)
   (:use :common-lisp :asdf/package :asdf/compatibility)
+  (:import-from :asdf/package #:DBG)
   (:export
-   #:find-symbol* ;; reexport from asdf/package
+   #:find-symbol* ;;#:DBG ;; reexport from asdf/package
    #:strcat #:compatfmt ;; reexport from asdf/compatibility
+   #:undefine-function #:undefine-functions
    #:defun* #:defgeneric* ;; defining macros
    #:aif #:it ;; basic flow control
    #:while-collecting #:appendf #:length=n-p ;; lists
    #:remove-keys #:remove-keyword ;; keyword argument lists
-   #:first-char #:last-char #:split-string #:string-suffix-p ;; strings
+   #:emptyp ;; sequences
+   #:first-char #:last-char #:split-string ;; strings
+   #:string-prefix-p #:string-enclosed-p #:string-suffix-p
    #:find-class* ;; CLOS
    #:stamp< #:stamp<= #:earlier-stamp #:stamps-earliest #:earliest-stamp ;; stamps
    #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f
    #:list-to-hash-set ;; hash-table
-   #:ensure-function ;; functions
+   #:ensure-function #:call-function #:call-functions ;; functions
+   #:eval-string #:load-string #:load-stream
    #:parse-version #:version-compatible-p)) ;; version
 (in-package :asdf/utility)
 
 ;;; *-defining macros
 
+;;; Functions
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (defun undefine-function (function-spec)
+    (cond
+      ((symbolp function-spec) (fmakunbound function-spec))
+      ((and (consp function-spec) (eq (car function-spec) 'setf)
+            (consp (cdr function-spec)) (null (cddr function-spec)))
+       #-(or gcl<2.7) (fmakunbound function-spec))
+      (t (error "bad function spec ~S" function-spec))))
+  (defun undefine-functions (function-spec-list)
+    (map () 'undefine-function function-spec-list)))
+
 (macrolet
     ((defdef (def* def)
        `(defmacro ,def* (name formals &rest rest)
           `(progn
-             ;; #+(or ecl gcl)
-             ,(when (and #+gcl<2.7 (symbolp name))
-                `(fmakunbound ',name))
+             (undefine-function ',name)
              #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
              ,(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
                 `(declaim (notinline ,name)))
@@ -84,7 +100,13 @@ Returns two values: \(A B C\) and \(1 2 3\)."
     :unless (eq k key)
     :append (list k v)))
 
+;;; Sequences
+(defun emptyp (x)
+  "Predicate that is true for an empty sequence"
+  (or (null x) (and (vectorp x) (zerop (length x)))))
+
 ;;; Strings
+
 (defun* first-char (s)
   (and (stringp s) (plusp (length s)) (char s 0)))
 
@@ -111,12 +133,27 @@ starting the separation from the end, e.g. when called with arguments
           (incf words)
           (setf end start))))))
 
-(defun* string-suffix-p (s suffix)
-  (check-type s string)
-  (check-type suffix string)
-  (let ((start (- (length s) (length suffix))))
-    (and (<= 0 start)
-         (string-equal s suffix :start1 start))))
+(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)))
+
 
 ;;; CLOS
 (defun* find-class* (x &optional (errorp t) environment)
@@ -149,7 +186,7 @@ starting the separation from the end, e.g. when called with arguments
 (defun* list-to-hash-set (list &aux (h (make-hash-table :test 'equal)))
   (dolist (x list h) (setf (gethash x h) t)))
 
-;;; Functions
+;;; Code execution
 (defun* ensure-function (fun &key (package :asdf))
   (etypecase fun
     ((or boolean keyword character number pathname) (constantly fun))
@@ -159,6 +196,35 @@ starting the separation from the end, e.g. when called with arguments
                                 (let ((*package* (find-package package)))
                                   (read-from-string fun))))))))
 
+(defun* call-function (function-spec)
+  (funcall (ensure-function function-spec)))
+
+(defun* call-functions (function-specs)
+  (map () 'call-hook-function function-specs))
+
+(defun eval-string (string)
+  "Evaluate a form read from a string"
+  (eval (read-from-string string)))
+
+(defun do-load (x &key external-format print)
+  (apply 'load x :print print (when external-format `(:external-format ,external-format))))
+
+(defun load-stream (&optional (stream *standard-input*))
+  "Portably read and evaluate forms from a STREAM."
+  ;; GCL 2.6 can't load from a string-input-stream
+  ;; ClozureCL 1.6 can only load from file input
+  ;; Allegro 5, I don't remember but it must have been broken when I tested.
+  #+(or gcl-pre2.7 clozure allegro)
+  (with-controlled-loader-conditions ()
+    (do ((eof '#:eof) (x t (read stream nil eof))) ((eq x eof)) (eval x)))
+  #-(or gcl-pre2.7 clozure allegro)
+  (do-load stream))
+
+(defun load-string (string)
+  "Portably read and evaluate forms from a STRING."
+  (with-input-from-string (s string) (load-stream s)))
+
+
 
 ;;; Version handling
 (defun* parse-version (string &optional on-error)
-- 
GitLab