[Common Lisp] Windows の SBCL で asdf-install を動かす

Windows の SBCL では asdf-install が動きません。
問題点はシンボリックリンク、tar に渡すパス、tar の出力の取得の3つです。
シンボリックリンクについては ~/.sbcl/site の下の拡張子が asd であるファイルを検索する関数を作成し、asdf:*system-definition-search-functions* に追加しました。
tar に渡すパスは、頭のドライブレターとコロンをとって \ を / に置き換えました。
tar の出力の取得は run-program で直に string output stream に出力せずに、プロセスのアウトプットストリームを自前で読んで string output stream に出力するようにしました。
これで cl-ppcre のインストールが成功するようになったのですが、uffi や usocket はどこかでハングしてしまいました。
tar の出力の取得まわりかと思いつつも、眠いので今日はここまで。
次のコードを ~/.sbclrc に書いておけば、(asdf-install:install :cl-ppcre) で cl-ppcre がインストールできるはずです。

(require :asdf)

(in-package :asdf)

(defun win-sysdef-search (system)
  (let ((home (MERGE-PATHNAMES ".sbcl/site/" (USER-HOMEDIR-PATHNAME))))
    (let* ((name (coerce-name system))
           (home (truename home))
           (files (directory
                   (merge-pathnames
                    (make-pathname :directory `(:relative :wild)
                                   :name name
                                   :type "asd"
                                   :case :local
                                         :version :newest)
                    home))))
      (dolist (file files)
        (when (probe-file file)
          (return-from win-sysdef-search file))))))

(pushnew 'win-sysdef-search asdf:*system-definition-search-functions*)

(require :asdf-install)

(in-package :asdf-install)

(labels ((cyg-path (win-path)
           (cl:substitute #\/ #\\ (cl:subseq (namestring win-path) 2)))
         (tar (args)
           (with-output-to-string (o)
             (let ((process (sb-ext:run-program *tar-program*
                                                args
                                                :search t
                                                :wait nil
                                                :output :stream)))
               (prog1 (loop for l = (read-line (process-output process) nil nil)
                         while l
                         do (write-line l o))
                 (process-wait process)
                 (process-close process))))))
  
  (defun get-tar-directory (packagename)
    (let* ((tar (tar (list "-tzf" (cyg-path packagename))))
           (first-line (subseq tar 0 (position #\newline tar))))
      (if (find #\/ first-line)
          (subseq first-line 0 (position #\/ first-line))
          first-line)))

  (defun untar-package (source packagename)
    (tar (list "-C" (cyg-path source)
               "-xzvf" (cyg-path packagename)))))