diff --git a/asdf-abcl.lisp b/asdf-abcl.lisp
new file mode 100644
index 0000000..1c003ec
--- /dev/null
+++ b/asdf-abcl.lisp
@@ -0,0 +1,42 @@
+;;;; ABCL specific code for ASDF
+#-abcl (error "This code is only intended to be run under Armed Bear Common Lisp")
+
+(in-package :asdf)
+
+(defun module-provide-asdf (name) 
+  (handler-case
+      (let* ((*verbose-out* (make-broadcast-stream))
+             (system (asdf:find-system name nil)))
+        (when system
+          (asdf:operate 'asdf:load-op name)
+          t))
+    (missing-component (e) 
+      (declare (ignore e))
+      nil)
+    (t (e)
+      (format *error-output* "ASDF could not load ~A because ~A.~%"
+              name e))))
+(when 
+    (find #'module-provide-asdf sys::*module-provider-functions*)
+  (setf sys::*module-provider-functions* 
+        (remove #'module-provide-asdf sys::*module-provider-functions*)))
+
+(pushnew #'module-provide-asdf sys::*module-provider-functions*)
+
+(defun translate-jar-pathname (source wildcard)
+  (declare (ignore wildcard))
+  (let ((root (apply-output-translations
+               (concatenate 'string 
+                            "/:jar:file/"
+                            (namestring (first (pathname-device
+                                                source))))))
+        (entry (make-pathname :directory (pathname-directory source)
+                              :name (pathname-name source)
+                              :type (pathname-type source))))
+    (concatenate 'string (namestring root) (namestring entry))))
+
+(initialize-output-translations 
+ '(:output-translations 
+   :ignore-inherited-configuration
+   (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname))
+   (#p"/:jar:file/**/*.*" (:user-cache #p"**/*.*"))))
diff --git a/asdf.asd b/asdf.asd
index 57f5cdf..8a3655b 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -15,4 +15,5 @@
   :depends-on ()
   :components
   ((:file "asdf")
+   #+abcl (:file "asdf-abcl" :depends-on ("asdf"))
    #+ecl (:file "asdf-ecl" :depends-on ("asdf"))))
diff --git a/asdf.lisp b/asdf.lisp
index 34eb0d0..e5d9a95 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -2353,6 +2353,16 @@ with a different configuration, so the configuration would be re-read then."
   (flet ((componentp (c) (typep c '(or string pathname keyword))))
     (or (null x) (componentp x) (and (consp x) (every #'componentp x)))))
 
+(defun location-function-p (x)
+  (and
+   (consp x)
+   (length=n-p x 2)
+   (or (and (equal (first x) :function)
+            (typep (second x) 'symbol))
+       (and (equal (first x) 'lambda)
+            (length=n-p x 3)
+            (length=n-p (second x) 2)))))
+                   
 (defun validate-output-translations-directive (directive)
   (unless
       (or (member directive '(:inherit-configuration
@@ -2363,7 +2373,12 @@ with a different configuration, so the configuration would be re-read then."
                         (or (and (eq (first directive) :include)
                                  (typep (second directive) '(or string pathname null)))
                             (and (location-designator-p (first directive))
-                                 (location-designator-p (second directive)))))
+                                 (location-designator-p (second directive)))
+                            (and (location-designator-p (first directive))
+                                 (location-function-p (second directive)))
+                            #+nil ;; unimplemented
+                            (and (location-function-p (first directive))
+                                 (location-function-p (second directive)))))
                    (and (length=n-p directive 1)
                         (location-designator-p (first directive))))))
     (error "Invalid directive ~S~%" directive))
@@ -2500,12 +2515,20 @@ with a different configuration, so the configuration would be re-read then."
         (if (eq src :include)
             (when dst
               (process-output-translations (pathname dst) :inherit nil :collect collect))
-            (when src
-              (let* ((trusrc (truenamize (resolve-location src t)))
-                     (trudst (if dst (resolve-location dst t) trusrc))
-                     (wilddst (make-pathname :name :wild :type :wild :defaults trudst)))
-                (funcall collect (list wilddst wilddst))
-                (funcall collect (list trusrc trudst))))))))
+            (if (location-function-p dst)
+                (let* ((function (if (symbolp (second dst))
+                                     (fdefinition (second dst))
+                                     (eval (second dst))))
+                       (trusrc (truenamize (resolve-location src t)))
+                       (wilddst (make-pathname :name :wild :type :wild
+                                               :defaults trusrc)))
+                  (funcall collect (list trusrc function)))
+                (when src
+                  (let* ((trusrc (truenamize (resolve-location src t)))
+                         (trudst (if dst (resolve-location dst t) trusrc))
+                         (wilddst (make-pathname :name :wild :type :wild :defaults trudst)))
+                    (funcall collect (list wilddst wilddst))
+                    (funcall collect (list trusrc trudst)))))))))
 
 (defun compute-output-translations (&optional parameter)
   "read the configuration, return it"
@@ -2538,7 +2561,10 @@ return the configuration"
      (setf path (truenamize path))
      (loop :for (source destination) :in (car *output-translations*)
        :when (pathname-match-p path source)
-       :return (translate-pathname path source destination)
+       :return 
+        (if (functionp destination)
+            (funcall destination path source)
+            (translate-pathname path source destination))
        :finally (return path)))))
 
 (defmethod output-files :around (operation component)
diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo
index 4574f35..5abc325 100644
--- a/doc/asdf.texinfo
+++ b/doc/asdf.texinfo
@@ -2093,6 +2093,8 @@ DIRECTIVE :=
     ;; add a single directory to be scanned (no recursion)
     (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR)
 
+    ;; use a function to return the translation of a directory designator
+    (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION))
 
 DIRECTORY-DESIGNATOR :=
     ABSOLUTE-COMPONENT-DESIGNATOR |
@@ -2116,6 +2118,13 @@ RELATIVE-COMPONENT-DESIGNATOR :=
     :CURRENT-DIRECTORY | ;; all components of the current directory, without the :absolute
     :UID | ;; current UID -- not available on Windows
     :USER ;; current USER name -- NOT IMPLEMENTED(!)
+
+TRANSLATION-FUNCTION :=
+    SYMBOL | ;; symbol of a function that takes two arguments, 
+             ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR 
+    LAMBDA   ;; A form which evalutates to a function taking two arguments consisting of
+             ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR 
+
 @end verbatim
 
 Relative components better be either relative
@@ -2134,6 +2143,17 @@ to anything but themselves (same as if the second designator was the same as the
 @code{:include} statements cause the search to recurse with the path specifications
 from the file specified.
 
+If the @code{translate-pathname} mechanism cannot achieve a desired
+translation, the user may provide a function which provides the
+required algorithim.  Such a translation function is specified by
+supplying a list as the second @code{directory-designator} whose first
+element is the keyword @code{:function}, and whose second element is
+either a symbol which designates a function or a lambda expression.
+The function designated by the second argument must take two
+arguments, the first being the pathname of the source file, the second
+being the wildcard that was matched.  The result of the function
+invocation should be the translated pathname.
+
 An @code{:inherit-configuration} statement cause the search to recurse with the path
 specifications from the next configuration.
 @xref{Controlling where ASDF saves compiled files,,Configurations}, above.
@@ -2261,10 +2281,9 @@ The specified functions are exported from package ASDF.
    where to look for systems not yet defined.
 @end defun
 
-@defun ensure-output-translations PARAMETER
-   checks whether output translations have been initialized.
-   If not, initialize them with the given @var{PARAMETER}.
-   This function will be called before any attempt to operate on a system.
+@defun ensure-output-translations 
+   checks whether output translations have been initialized.  This
+   function will be called before any attempt to operate on a system.
 @end defun
 
 @defun apply-output-translations PATHNAME
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 3ec637b..da2ba68 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -153,6 +153,7 @@ case "$lisp" in
     eval="-eval" ;;
   abcl)
     command="${ABCL:-abcl}"
+    flags="--noinit --noinform"
     eval="--eval" ;;
   *)
     echo "Unsupported lisp: $1" >&2
