diff --git a/racket/collects/pkg/path.rkt b/racket/collects/pkg/path.rkt
index eea013670c..3d0b7deb72 100644
--- a/racket/collects/pkg/path.rkt
+++ b/racket/collects/pkg/path.rkt
@@ -121,8 +121,14 @@
         (if (and (pair? orig)
                  (or (eq? 'link (car orig))
                      (eq? 'static-link (car orig))))
-            (let ([orig-pkg-dir (simplify-path (path->complete-path (cadr orig) pkgs-dir) #f)])
-              (define e (explode orig-pkg-dir))
+            (let ([e (or (and cache
+                              (hash-ref cache `(pkg-dir ,(cadr orig)) #f))
+                         (let ([e (explode (simplify-path 
+                                            (path->complete-path (cadr orig) pkgs-dir) 
+                                            #f))])
+                           (when cache
+                             (hash-set! cache `(pkg-dir ,(cadr orig)) e))
+                           e))])
               (if (sub-path? <= p e)
                   (values k
                           (build-path* (list-tail p (length e)))
diff --git a/racket/collects/setup/path-relativize.rkt b/racket/collects/setup/path-relativize.rkt
index aee87ca64c..a8d8fead55 100644
--- a/racket/collects/setup/path-relativize.rkt
+++ b/racket/collects/setup/path-relativize.rkt
@@ -19,16 +19,11 @@
   ;; We need to compare paths to find when something is in the racket
   ;; tree, so we explode the paths. This is slower than the old way
   ;; (by a factor of 2 or so), but it's simpler and more portable.
-  (define (explode-path path)
-    (let loop ([path (simplify-path (path->complete-path path))]
-               [rest null])
-      (let-values ([(base name dir?) (split-path path)])
-        (if (path? base)
-          (loop base (cons name rest))
-          (cons name rest)))))
+  (define (explode-path* path)
+    (explode-path (simplify-path (path->complete-path path))))
 
   (define exploded-root
-    (delay (cond [(find-root-dir) => explode-path] [else #f])))
+    (delay (cond [(find-root-dir) => explode-path*] [else #f])))
 
   ;; path->relative : path-or-bytes -> datum-containing-bytes-or-path
   (define (path->relative path0)
@@ -37,9 +32,11 @@
             [(path-string? path0) path0]
             [else (raise-type-error to-rel-name "path, string, or bytes"
                                     path0)]))
-    (let loop ([path (explode-path path1)] [root (force exploded-root)])
+    (let loop ([path (explode-path* path1)] [root (force exploded-root)])
       (cond [(not root) path0]
-            [(null? root) (cons tag (map (lambda (pe) (datum-intern-literal (path-element->bytes pe)))
+            [(null? root) (cons tag (map (lambda (pe)
+                                           (datum-intern-literal
+                                            (path-element->bytes pe)))
                                          path))]
             ;; Note: in some cases this returns the input path as is, which
             ;; could be a byte string -- it should be possible to return