diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp
index 65d55402565af6f27510d30f8fefe34adbe6c2bc..927fc019e8facb501de203e4039028f730391854 100644
--- a/uiop/lisp-build.lisp
+++ b/uiop/lisp-build.lisp
@@ -11,6 +11,7 @@
    #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour*
    #:*output-translation-function*
    #:*optimization-settings* #:*previous-optimization-settings*
+   #:*base-build-directory*
    #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error
    #:compile-warned-warning #:compile-failed-warning
    #:check-lisp-compile-results #:check-lisp-compile-warnings
@@ -44,8 +45,13 @@ Valid values are :error, :warn, and :ignore.")
     "How should ASDF react if it encounters a failure (per the ANSI spec of COMPILE-FILE)
 when compiling a file, which includes any non-style-warning warning.
 Valid values are :error, :warn, and :ignore.
-Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling."))
+Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling.")
 
+  (defvar *base-build-directory* nil
+    "When set to a non-null value, it should be an absolute directory pathname,
+which will serve as the *DEFAULT-PATHNAME-DEFAULTS* around a COMPILE-FILE,
+what more while the input-file is shortened if possible to ENOUGH-PATHNAME relative to it.
+This can help you produce more deterministic output for FASLs."))
 
 ;;; Optimization settings
 (with-upgradability ()
@@ -551,7 +557,7 @@ possibly in a different process. Otherwise just call THUNK."
         (funcall thunk)))
 
   (defmacro with-saved-deferred-warnings ((warnings-file) &body body)
-    "Trivial syntax for CALL-WITH-SAVED-DEFERRED-WARNINGS" 
+    "Trivial syntax for CALL-WITH-SAVED-DEFERRED-WARNINGS"
     `(call-with-saved-deferred-warnings #'(lambda () ,@body) ,warnings-file)))
 
 
@@ -563,7 +569,7 @@ possibly in a different process. Otherwise just call THUNK."
 
   (defun load-pathname ()
     "Portably return the LOAD-PATHNAME of the current source file or fasl"
-    *load-pathname*) ;; see magic for GCL in uiop/common-lisp 
+    *load-pathname*) ;; see magic for GCL in uiop/common-lisp
 
   (defun lispize-pathname (input-file)
     "From a INPUT-FILE pathname, return a corresponding .lisp source pathname"
@@ -649,16 +655,17 @@ it will filter them appropriately."
       (multiple-value-bind (output-truename warnings-p failure-p)
           (with-saved-deferred-warnings (warnings-file)
             (with-muffled-compiler-conditions ()
-              (or #-(or ecl mkcl)
-                  (apply 'compile-file input-file :output-file tmp-file
-                         #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
-                         #-sbcl keywords)
-                  #+ecl (apply 'compile-file input-file :output-file
-                               (if object-file
-                                   (list* object-file :system-p t keywords)
-                                   (list* tmp-file keywords)))
-                  #+mkcl (apply 'compile-file input-file
-                                :output-file object-file :fasl-p nil keywords))))
+              (with-enough-pathname (input-file :defaults *base-build-directory*)
+                (or #-(or ecl mkcl)
+                    (apply 'compile-file input-file :output-file tmp-file
+                           #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
+                           #-sbcl keywords)
+                    #+ecl (apply 'compile-file input-file :output-file
+                                 (if object-file
+                                     (list* object-file :system-p t keywords)
+                                     (list* tmp-file keywords)))
+                    #+mkcl (apply 'compile-file input-file
+                                  :output-file object-file :fasl-p nil keywords)))))
         (cond
           ((and output-truename
                 (flet ((check-flag (flag behaviour)
diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp
index 17971d1788415c10bb0ba0690479022d6ea84ca9..8d1a7a0a51204526776cc63292d0556d9196c9cd 100644
--- a/uiop/pathname.lisp
+++ b/uiop/pathname.lisp
@@ -28,7 +28,7 @@
    #:subpathname #:subpathname*
    #:ensure-absolute-pathname
    #:pathname-root #:pathname-host-pathname
-   #:subpathp
+   #:subpathp #:enough-pathname #:with-enough-pathname #:call-with-enough-pathname
    ;; Checking constraints
    #:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints
    ;; Wildcard pathnames
@@ -560,6 +560,29 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA
            (let ((enough (enough-namestring maybe-subpath base-pathname)))
              (and (relative-pathname-p enough) (pathname enough))))))
 
+  (defun enough-pathname (maybe-subpath base-pathname)
+    "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
+when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
+    (check-type maybe-subpath (or null pathname))
+    (check-type base-pathname (or null pathname))
+    (when (pathnamep base-pathname) (assert (absolute-pathname-p base-pathname)))
+    (or (and base-pathname (subpathp maybe-subpath base-pathname))
+        maybe-subpath))
+
+  (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk)
+    "In a context where *DEFAULT-PATHNAME-DEFAULTS* is bound to DEFAULTS-PATHNAME (if not null,
+or else to its current value), call THUNK with ENOUGH-PATHNAME for MAYBE-SUBPATH
+given DEFAULTS-PATHNAME as a base pathname."
+    (let ((enough (enough-pathname maybe-subpath defaults-pathname))
+          (*default-pathname-defaults* (or defaults-pathname *default-pathname-defaults*)))
+      (funcall thunk enough)))
+
+  (defmacro with-enough-pathname ((pathname-var &key (pathname pathname-var)
+                                                  (defaults *default-pathname-defaults*))
+                                  &body body)
+    "Shorthand syntax for CALL-WITH-ENOUGH-PATHNAME"
+    `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body)))
+
   (defun ensure-absolute-pathname (path &optional defaults (on-error 'error))
     "Given a pathname designator PATH, return an absolute pathname as specified by PATH
 considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior,