▼Tclのバイナリパッケージのこしらえ方▼

ＯＳ依存だったりして、Tcl単体ではどうしても実現できない機能が ほしい場合は、load コマンドでバイナリパッケージを読み込むことで 対処します。もちろん移植性(Unix/Mac/Win...)はないのでそのつもりで。

ＣでTclの機能を書くので、作成にあたっては /usr/local/tcl*/man3/* あたりに転がっている TclのＣインタフェースにある程度精通しておく必要があります。

• 初期化関数をこしらえる
• コマンドを定義しよう
• パッケージ化してみよう
• 完成版

$Id: tcl_load.html,v 1.9 2001-12-14 14:55:04+09 kabe Exp $

▽初期化関数をこしらえる

Tcl付属のマニュアルの load(n)を見れば、まず基本的なことが 書かれています。

int Pkg_Init(Tcl_Interp *interp) が呼ばれる。

作例： Tclには getpid() はあるんですが (pidコマンド) getppid() がないので、 これを作ってみましょう。 まずは中身のないダミー初期化関数から。

単に getppid() がほしいだけなら TclX に 含まれていたりします。
環境依存でいいなら binary scan [read [open "/proc/[pid]/psinfo"]] {x4x4II} pr_pid ppid; return $ppid てな荒業もありますが

#include <tcl.h>


int
Getpid_Init(Tcl_Interp *interp)
{
	return TCL_OK;
}

TclのＣ関数の返り値は通常はintの TCL_OK か TCL_ERROR です。 他の値を使うことはまずないでしょう。

はまりやすいのはここからで、このソースファイルを ちゃんと loadコマンドで読める共有ライブラリ形式にコンパイルすること。 ＯＳによってやり方が違うので、TclのソースコードのMakefileを見るなりして 各自把握しておくように。

Solaris% gcc -c -fpic -mcpu=v8 -I/usr/local/tcl8.4/include getpid.c
Solaris% ld -G -z text -o getpid.so getpid.o
Solaris% tclsh
% load ./getpid.so
%			エラーが出なければとりあえずｏｋ

▽何かさせてみる

loadしてもだんまりでは本当に起動されたかわからんので、 なんか表示させてみましょうか。

#include <tcl.h>

int
Getpid_Init(Tcl_Interp *interp)
{
	Tcl_Channel chan;
	chan = Tcl_GetStdChannel(TCL_STDOUT);
	Tcl_Write(chan, "Hello,world\n", -1);
	return TCL_OK;
}

Solaris% gcc -c -fpic -mcpu=v8 -I/usr/local/tcl8.4/include getpid.c
Solaris% ld -G -z text -o getpid.so getpid.o
Solaris% tclsh
% load ./getpid.so
Hello,world		実行されているようだ
%

マニュアルを見るとわかりますが、Tcl_Write()関数は 上位互換のためにあるだけで、使用は推奨されてません。 Tcl8以降のオブジェクト機構を使うのが正解で、「正しく」は

	Tcl_Obj	*helloStr;
	helloStr = Tcl_NewStringObj("Hello,world\n", -1);
	Tcl_IncrRefCount(helloStr);
	Tcl_WriteObj(chan, helloStr);
	Tcl_DecrRefCount(helloStr);
	

ただし内部実装としては単にバイト列を叩き出すだけなら Tcl_Write()の方が速いです。

▽コマンドを定義しよう

ppid というコマンドを定義したいので、 初期化関数内で Tcl_CreateObjCommand() を呼び出すようにします。 実際の処理を行う関数Getpid_PpidObjCmd()をこしらえて、

	Tcl_CreateObjCommand(interp, "ppid", Getpid_PpidObjCmd, NULL, NULL);

/*
 * getpid.c --
 *	Binary package for UNIX getpid(2) and friends.
 *
 */

#include <tcl.h>
#include <unistd.h>	/*getpid()*/

static int Getpid_PpidObjCmd(ClientData cd, Tcl_Interp *interp, int objc, 
    Tcl_Obj *CONST objv[]);

int
Getpid_Init(Tcl_Interp *interp)
{
	Tcl_CreateObjCommand(interp, "ppid", Getpid_PpidObjCmd, NULL, NULL);
	return TCL_OK;
}

/*
 *-------------------------------------------------
 *
 * Getpid_PpidObjCmd --
 *	This procedure returns getppid(2) value.
 *
 *-------------------------------------------------
 */
static int 
Getpid_PpidObjCmd(cd, interp, objc, objv)
    ClientData cd;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* # of arguments. */
    Tcl_Obj *CONST objv[];	/* Arguments. */
{
	Tcl_SetLongObj(Tcl_GetObjResult(interp), (long)getppid());
	return TCL_OK;
}

いきなり長くなりましたが、多くはTclのソースのスタイルをまねた注釈です。 少し大きくなりそうなプログラムなら 注釈を入れておくのがおすすめ。 (３ヶ月後の自分は他人也)

Solaris% gcc -c -fpic -mcpu=v8 -I/usr/local/tcl8.4/include getpid.c
Solaris% ld -G -z text -o getpid.so getpid.o
Solaris% tclsh
% ppid
invalid command name "ppid"	最初はもちろんエラー
% load ./getpid.so
% ppid
1892
% pid
1921
% ptree [pid]			正しい値か見てみよう
				(ptreeは/usr/proc/binにあるSolaris2用コマンド)
183   /usr/sbin/inetd -s
  1890  in.telnetd
    1892  -csh
      1921  tclsh
        1922  /usr/bin/ptree 1921
%

▽パッケージ化してみよう

要するに load filename.so ではなく、 package require package で使えるようにしようということ。 必要なのは

• package provide package version
• pkg_mkIndex でカタログを作成
• auto_path が指すディレクトリ以下にインストール

▽パッケージとして宣言する

パッケージ名を getpid, バージョンを 1.0 とします。

これらを決めたら、初期化関数の中で package provide "getpid" 1.0 相当の事を行います。

	Tcl_PkgProvide(interp, "getpid", "1.0");

テスト

	Solaris% tclsh
	% package present getpid
	package getpid is not present	最初はエラー
	% load ./getpid.so
	% package present getpid
	1.0				1.0と出ればok
	% 

▽pkgIndex.tclを生成する

tclshに組み込まれている pkg_mkIndex(n) コマンドを使って、 pkgIndex.tcl ファイルを生成します。 package require は、このファイルを見て目的のライブラリを読み込みます。

	Solaris% tclsh
	% pkg_mkIndex . getpid.so
		./getpid.so を読み込み、./pkgIndex.tcl を生成
	% ^D

テスト

	Solaris% tclsh
	% package require getpid
	can't find package getpid	最初はエラー
	% lappend auto_path .		検索パスを設定
	/usr/local/tcl8.4/lib/tcl8.4 /usr/local/tcl8.4/lib /usr/local/lib .
	% package require getpid
	1.0				読み込まれた
	% 

上の例は関係ファイルを全部カレントディレクトリ(.)に 置いてありますが、普通は getpid/getpid.so, getpid/pkgIndex.tcl といった感じで専用のディレクトリを掘ってその中に入れておきます。 すでにインストールされている /usr/local/tcl*/lib/tcl*/ を 見てみてください。

▽インストールしよう

デフォルトのパッケージ検索パス (auto_path) の直下、または １階層下に getpid.so と pkgIndex.tcl をインストールします。 上の例では /usr/local/tcl8.4/lib/tcl8.4 /usr/local/tcl8.4/lib なので、 候補としては

1. /usr/local/tcl8.4/lib/tcl8.4/getpid.so
2. /usr/local/tcl8.4/lib/tcl8.4/getpid/getpid.so
3. /usr/local/tcl8.4/lib/tcl8.4/getpid1.0/getpid.so
4. /usr/local/tcl8.4/lib/getpid.so
5. /usr/local/tcl8.4/lib/getpid/getpid.so
6. /usr/local/tcl8.4/lib/getpid1.0/getpid.so

	Solaris% mkdir /usr/local/tcl8.4/lib/getpid1.0
	Solaris% cp -p getpid.so pkgIndex.tcl !$
	cp -p getpid.so pkgIndex.tcl /usr/local/tcl8.4/lib/getpid

テスト

	Solaris% tclsh
	% package require getpid
	1.0				読み込まれた
	% 

▽完成版

pgrp, ppid, pgid コマンドを新設します。pidコマンドがなければ それも定義します。 手抜きなので、本物の pid コマンドのように fileID 引数をつけても解釈しません。

• getpid.c