KitCreatorに限らずVFS化すると使えないとされているFfidl 0.6ですが、Windowsでしか試していませんが、何箇所か修正すればVFSとも共存させられる事が分かりました。

変更案A: Ffidlで取り込むDLLが全てVFS外の場合

FfidlでWin32 APIを実行できるようにしてそれにTclを付け足したパッケージであれば、ffidlrt.tclを一部修正すれば使用できる事が分かりました。smartcardパッケージはこの方法でKitCreatorに組み込めました。

修正箇所は::ffidl::find-pkg-lib関数の

return  $l

を

return [file tail $l]

に変更すれば少なくともpackage require Ffidlrtを実行したときのエラーは無くなり、VFS外のDLLは使えるようになりました。

これは何をしているかというと、loadコマンドのVFS対応のおかげでVFS内のFfidl06.dllはロードできているので、::ffidl::symbolでFfidl06.dllを解析するときにロード済みの情報を使わせるようにしたのです。

::ffidl::symbolはC言語で記述されており、Windows向けビルドではLoadLibraryAというwin32 APIをコールするのですが、このAPI関数の説明を読むとDLLファイル名がディレクトリ名を含まない場合はロード済みの情報を使用する事になっていたので、それに合わせて修正してみたらうまくいったというわけです。

ただ、FfidlパッケージはWindows以外のOS向けにもビルドできるので、Windows以外でこの変更が妥当かどうかまでは調査していません。

変更案B: VFS内のDLLをFfidl経由で使用する場合

GitHubで主に64ビット対応を目玉に開発が行われているFfidl 0.7のソースコードを見ると、USE_TCL_LOADFILEというコンパイルスイッチを見つけることができます。

Tcl8.6ではloadコマンドでVFSがサポートされており、ロード対象のDLLがVFS内にある場合は一旦テンポラリディレクトリ(%localappdata%/temp/TCLプロセスID/)にコピーしてからロードするようになっていますが、この仕組みをFfidlのsymbolコマンドからも利用するための修正がUSE_TCL_LOADFILEで、

TclpDlopen関数をTcl_LoadFile関数に置き換え
TclpFindSymbol関数をTcl_FindSymbol関数に置き換え

という変更が加えられており、当該部分をFfidl 0.6に取り込んでビルドすればVFS内のTcl拡張ではないDLLもFfidlから利用できました。

ただなぜかCソースコードの変更だけではエラーが発生してしまい、変更案Aのffidlrt.tclの修正も必要でしたが。

詳しく解析していませんが、オープン済みのDLLと同じ名前で再コピーしようとしたためか、或いは同じDLLを複数回ロードしようとしたためか、まあそんなところじゃないかと思っています。

懸念事項

非常に残念なことに、テンポラリディレクトリにコピーされたDLLファイルはTclプロセスが終了した後も残ってしまいます。

元々Ffidl06.dllが残りますし、案Bによって利用したVFS内のTcl拡張ではないDLLも残ります。

この挙動はさすがにダサいのですが、現状は解決する方法が無いため諦めて放置されているようです。

Tclのソースコードのgeneric/tclIOUtil.cの3434行目前後が関係箇所で、ここに

#ifdef _WIN32
    if (MoveFileEx(Tcl_FSGetNativePath(copyToPtr), NULL, MOVEFILE_DELAY_UNTIL_REBOOT) &&
        MoveFileEx(Tcl_FSGetNativePath(TclPathPart(interp, copyToPtr, TCL_PATH_DIRNAME)),
                   NULL, MOVEFILE_DELAY_UNTIL_REBOOT))
    {
        *handlePtr = newLoadHandle;
        if (interp) {
            Tcl_ResetResult(interp);
        }
        return TCL_OK;
    }
#endif

を挿入して、Win32 APIのMoveFileEx関数を使って次回の再起動時に削除する方法を試してみましたが、管理者として実行すれば狙い通り削除予約できるものの、一般ユーザでは権限不足で削除予約できませんでした。

どうしても削除したいなら、バッチファイルやWSHスクリプトからTclを起動することにして、Tclプロセスが終了したらテンポラリディレクトリにある「TCLプロセスID」ディレクトリを削除するという二段構えしか手が無いような気がします。

変更案Bのパッチ

記事にファイルを添付する方法が分からなかったので、ベタっと貼っておきます。

diff -Ncr ffidl/generic/ffidl.c ffidl-mine/generic/ffidl.c
*** ffidl/generic/ffidl.c   2005-04-30 15:10:03.000000000 +0900
--- ffidl-mine/generic/ffidl.c  2018-07-19 16:25:30.146289900 +0900
***************
*** 273,279 ****
  #endif
  #endif

! #ifndef USE_TCL_DLOPEN
  /*****************************************
   *                  
   * ffidlopen, ffidlsym, and ffidlclose abstractions
--- 273,279 ----
  #endif
  #endif

! #if !defined(USE_TCL_DLOPEN) && !defined(USE_TCL_LOADFILE)
  /*****************************************
   *                  
   * ffidlopen, ffidlsym, and ffidlclose abstractions
***************
*** 1989,1995 ****
    /* free all libs */
    for (entry = Tcl_FirstHashEntry(&client->libs, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) {
      void **libentry = Tcl_GetHashValue(entry);
! #ifdef USE_TCL_DLOPEN
      ((Tcl_FSUnloadFileProc*)libentry[1])((Tcl_LoadHandle)libentry[0]);
  #else
      const char *error;
--- 1989,1995 ----
    /* free all libs */
    for (entry = Tcl_FirstHashEntry(&client->libs, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) {
      void **libentry = Tcl_GetHashValue(entry);
! #if defined(USE_TCL_DLOPEN) || defined(USE_TCL_LOADFILE)
      ((Tcl_FSUnloadFileProc*)libentry[1])((Tcl_LoadHandle)libentry[0]);
  #else
      const char *error;
***************
*** 2736,2742 ****
    const char *error;
    void *address;
    Tcl_DString ds;
! #ifdef USE_TCL_DLOPEN
    Tcl_LoadHandle handle;
    Tcl_FSUnloadFileProc *unload;
  #else
--- 2736,2742 ----
    const char *error;
    void *address;
    Tcl_DString ds;
! #if defined(USE_TCL_DLOPEN) || defined(USE_TCL_LOADFILE)
    Tcl_LoadHandle handle;
    Tcl_FSUnloadFileProc *unload;
  #else
***************
*** 2754,2762 ****
    handle = lib_lookup(client, library, NULL);

    if (handle == NULL) {
! #ifdef USE_TCL_DLOPEN
      if (TclpDlopen(interp, objv[1], &handle, &unload) != TCL_OK)
          return TCL_ERROR;
  #else
      native = Tcl_UtfToExternalDString(NULL, library, -1, &ds);
      handle = ffidlopen(strlen(native)?native:NULL, &error);
--- 2754,2766 ----
    handle = lib_lookup(client, library, NULL);

    if (handle == NULL) {
! #if defined(USE_TCL_DLOPEN)
      if (TclpDlopen(interp, objv[1], &handle, &unload) != TCL_OK)
          return TCL_ERROR;
+ #elif defined(USE_TCL_LOADFILE)
+     if (Tcl_LoadFile(interp, objv[1], NULL ,0 ,NULL ,&handle) != TCL_OK)
+         return TCL_ERROR;
+     unload = (Tcl_FSUnloadFileProc *)&Tcl_FSUnloadFile;
  #else
      native = Tcl_UtfToExternalDString(NULL, library, -1, &ds);
      handle = ffidlopen(strlen(native)?native:NULL, &error);
***************
*** 2772,2780 ****

    symbol = Tcl_GetString(objv[2]);
    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
! #ifdef USE_TCL_DLOPEN
    address = TclpFindSymbol(interp, (Tcl_LoadHandle)handle, native);
    error = address ? NULL : "TclpFindSymbol() failed";
  #else
    address = ffidlsym(handle, native, &error); 
    if (error) {
--- 2776,2787 ----

    symbol = Tcl_GetString(objv[2]);
    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
! #if defined(USE_TCL_DLOPEN)
    address = TclpFindSymbol(interp, (Tcl_LoadHandle)handle, native);
    error = address ? NULL : "TclpFindSymbol() failed";
+ #elif defined(USE_TCL_LOADFILE)
+   address = Tcl_FindSymbol(interp, (Tcl_LoadHandle)handle, native);
+   error = address ? NULL : "Tcl_FindSymbol() failed";
  #else
    address = ffidlsym(handle, native, &error); 
    if (error) {
diff -Ncr ffidl/library/ffidlrt.tcl ffidl-mine/library/ffidlrt.tcl
*** ffidl/library/ffidlrt.tcl   2005-04-29 06:59:41.000000000 +0900
--- ffidl-mine/library/ffidlrt.tcl  2018-07-19 16:25:33.856502100 +0900
***************
*** 13,19 ****
      foreach i [::info loaded {}] {
          foreach {l p} $i {}
          if {$p eq "$pkg"} {
!             return $l
          }
      }
      # ignore errors when running under pkg_mkIndex:
--- 13,19 ----
      foreach i [::info loaded {}] {
          foreach {l p} $i {}
          if {$p eq "$pkg"} {
!             return [file tail $l]
          }
      }
      # ignore errors when running under pkg_mkIndex: