[我在之前看的是以ping协议为实例来理解TclCL机制和分裂对象模型]
本文以channel实例的创建过程为例，试图说明ns2的分裂机制，请在阅读本文前阅读《The NS Manual》有关分裂机制章节，由于篇幅有限，作者能力有限，本文章不能分析得非常彻底，时间仓促，有不当之处请大家给予批评指正。
一、定义信道基类
- 定义channel的 C++类
#ns-2.31macchannel.h
class Channel : public TclObject {
public:
Channel(void);
virtual int command(int argc, const char*const* argv);
... ... ...
};
- 定义用于连接的类
#ns-2.31macchannel.cc
static class ChannelClass : public TclClass {
public:
ChannelClass() : TclClass("Channel") {}
TclObject* create(int, const char*const*) {
return (new Channel);
}
}class_channel ;
［注意］一个类声明为static,那么当ns刚开始初始化的时候,便会调用该类的构造函数，当静态变量class_channel 第一次被创建时，ns 将执行其构造函数，这就建立了适当的方法和解释类层次．具体解释请看第三节Otcl注册过程
二、Otcl注册过程
继续第一节，当ns初始化时会创建实体class_channel，它会调用类的构造函数ChannelClass() : TclClass("Channel") {}
首先执行TclClass:TclClass("Channel")，"Channel" 会传给参数此classname_ .
下面我们看一下TclClass()的具体实现
//->tclcl-1.19Tcl.cc
TclClass* TclClass::all_; //[problem]什么意思？ 在c++里
TclClass::TclClass(const char* classname) : class_(0), classname_(classname)
{
if (Tcl::instance().interp()!=NULL) {
#解释器已经存在，解释器是一个动态连接库的一部分
bind(); # 变量绑定函数
} else {
... ... ...
}
}
void TclClass::bind()
{
Tcl& tcl = Tcl::instance();
//获取Tcl 句柄 [参考1]
tcl.evalf("SplitObject register %s", classname_); # $classname_ == "Channel"
//上句利用句柄调用otcl命令，在Otcl环境中注册该类名:Channel
该类的父类是SpliteObject
//SpliteObject是一个具有C++映像类的OTcl类,他是所有OTcl映像类的基类
# 注册了之后,为这个类添加两个命令:create-shadow和delete-shadow
# 调用命令就是TclClass::create_shadow()，TclClass::delete_shadow().
class_ = OTclGetClass(tcl.interp(), (char*)classname_);
//class_
OTclAddIMethod(class_, "create-shadow",
(Tcl_CmdProc *) create_shadow, (ClientData)this, 0);
OTclAddIMethod(class_, "delete-shadow",
(Tcl_CmdProc *) delete_shadow, (ClientData)this, 0);
otcl_mappings();
}
下边来讲讲我们在tcl脚本里自己能控制的实例化过程
四、实例化过程
然后当你在tcl 脚本中调用 new Channel时，ns2使用tclsh解释执行tcl脚本， 调用tcl函数new函数
//tclcl-1.19/tcl-object.tcl
146 proc new { className args } {
set o [SplitObject getid]
#得到一个新的分裂实体编号"_o*" _o*有类SplitObject 的变量 id 标识,从_o0开始
#可见在每一个Simulator对应的模拟中"_o*"标示唯一的一个分裂类实体，
#也就是说，所有的分裂类实体都有自己的唯一标识 ，这个标识就是句柄
#注意SplitObject 与 TclObject 的关系
if [catch "$className create $o $args" msg] { #创建实体
if [string match "__FAILED_SHADOW_OBJECT_" $msg] {
# 如果创建影像类失败，删除 o对象
delete $o
return ""
}
global errorInfo
error "class $className: constructor failed: $msg" $errorInfo
}
return $o
}
但是SpliteObject并没有create函数, 所以动态调用其父类 Class 的 create 函数
Class instproc create {obj args} { # obj是 _oxxx了
set h [$self info heritage] # 取得类继承链测试结果是“SplitObject Object”
foreach i [concat $self $h] {
#沿着继承链从子类到父类递归产生相应实体
#concat后字符串为：”Channel SplitObject Object”
if {[$i info commands alloc] != {}} then { # 判断命令alloc的是否存在
set args [eval [list $i] alloc [list $obj] $args] # 分配空间
$obj class $self
eval [list $obj] init $args #调用init,最终导致shadow对象的产生
return $obj
}
}
error {No reachable alloc}
}
上面调用的init 会动态调用 SpliteObject instproc init()
SplitObject instproc init args {
$self next
#调用类的create-shadow函数
if [catch "$self create-shadow $args"] {
error "__FAILED_SHADOW_OBJECT_" ""
}
}
在这个例子中,动态调用了Channel instproc create_shadow函数，channel没有次函数，调用父类的，实质上最后调用了TclClass::create-shadow()函数，创建
int TclClass::create_shadow(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
TclClass* p = (TclClass*)clientData; #把channel指针转换为父类型的指针
#在这里调用了ChannelClass::create()函数
#也就是调用了C++环境中的:new Channel 见函类ChannelClass定义
#到这里为止,otcl中的Channel的shadow object就生成了
TclObject* o = p->create(argc, argv);
#动态调用那个create?
Tcl& tcl = Tcl::instance();
if (o != 0) {
o->name(argv[0]);
tcl.enter(o);
if (o->init(argc - 2, argv + 2) == TCL_ERROR) {
tcl.remove(o);
delete o;
return (TCL_ERROR);
}
tcl.result(o->name());
# 在这里再次为otcl中的类Channel添加两个instproc:cmd和instvar
# 其中cmd命令是用来运行处理未知命令机制的
# 这样的话,当你在ns脚本中输入了一个该类未知的命令,
# Tcl的unknown机制就会调用该类的cmd命令
# 而这进一步的就会调用该类的shadow object的command()过程
# 所以在实现类的C++部分时,你必须实现该类的Command()过程
# 在command()中实现所有的命令分发
OTclAddPMethod(OTclGetObject(interp, argv[0]), "cmd",
dispatch_cmd, (ClientData)o, 0);
OTclAddPMethod(OTclGetObject(interp, argv[0]), "instvar",
dispatch_instvar, (ClientData)o, 0);
o->delay_bind_init_all();
return (TCL_OK);
} else {
tcl.resultf("new failed while creating object of class %s",
p->classname_);
return (TCL_ERROR);
}
}