[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[ns] problem with tcl?

To: [email protected]
Subject: [ns] problem with tcl?
From: Thomas Schwabe <[email protected]>
Date: Mon, 25 Sep 2000 09:15:18 -0700
Organization: International Computer Science Institute
Sender: [email protected]

Hi ,

I try to adapt the MobileIP extensions from Joerg Widmer to the actual
snapshot of ns. The installation of the snapshot is no problem. After I
add the extension to the code I can compile it. But when I execute ./ns
(in the folder of the snapshot) I get the output which you can see in
the attached file. The output seems to be a part of the code of
ns-default.tcl (../tcl/lib). What is wrong? Is there a mistake in the
tcl-code?

Thanks in advance
Thomas

--
Thomas Schwabe, DaimlerChrysler AG
International Computer Science Institute
1947 Center Street
Berkeley, California 94704-1198
(510) 666-2974

mailto:[email protected]
http://www.icsi.berkeley.edu

ns: 


proc warn {msg} {
global warned_
if {![info exists warned_($msg)]} {
puts stderr "warning: $msg"
set warned_($msg) 1
}
}

if {[info commands debug] == ""} {
proc debug args {
warn {Script debugging disabled.  Reconfigure with --with-tcldebug, and recompile.}
}
}

proc assert args {
if [catch "expr $args" ret] {
set ret [eval expr $args]
}
if {! $ret} {
error "assertion failed: $args"
}
}

proc find-max list {
set max 0
foreach val $list {
if {$val > $max} {
set max $val
}
}
return $max
}

proc bw_parse { bspec } {
if { [scan $bspec "%f%s" b unit] == 1 } {
set unit bps
}
regsub {[/p]s(ec)?$} $unit {} unit
if [string match {*B} $unit] {
set b [expr $b*8]
set unit "[string trimright B $unit]b"
}
switch $unit {
b { return $b }
kb { return [expr $b*1000] }
Mb { return [expr $b*1000000] }
Gb { return [expr $b*1000000000] }
default { 
puts "error: bw_parse: unknown unit `$unit'" 
exit 1
}
}
}

proc time_parse { spec } {
if { [scan $spec "%f%s" t unit] == 1 } {
set unit s
}
regsub {sec$} $unit {s} unit
switch $unit {
s { return $t }
ms { return [expr $t*1e-3] }
us { return [expr $t*1e-6] }
ns { return [expr $t*1e-9] }
ps { return [expr $t*1e-12] }
default { 
puts "error: time_parse: unknown unit `$unit'" 
exit 1
}
}
}

proc delay_parse { spec } {
return [time_parse $spec]
}

Class Simulator



proc checkout_executable {exe_var best alternate text} {
global $exe_var
set $exe_var $best
if {"$best" == "" || ![file executable $best]} {
puts stderr $text
set $exe_var $alternate
}
}

checkout_executable PERL "/usr/bin/perl" perl " When configured, ns found the right version of perl in /usr/bin/perl
but it doesn't seem to be there anymore, so ns will fall back on running the first perl in your path. The wrong version of perl may break the test suites. Reconfigure and rebuild ns if this is a problem. "
checkout_executable TCLSH "/usr/bin/tclsh8.0" tclsh " When configured, ns found the right version of tclsh in /usr/bin/tclsh8.0
but it doesn't seem to be there anymore, so ns will fall back on running the first tclsh in your path. The wrong version of tclsh may break the test suites. Reconfigure and rebuild ns if this is a problem. "












Class AddrParams 
Class AllocAddrBits

Simulator instproc get-AllocAddrBits {prog} {
$self instvar allocAddr_
if ![info exists allocAddr_] {
set allocAddr_ [new AllocAddrBits]
} elseif ![string compare $prog "new"] {
set allocAddr_ [new AllocAddrBits]
}
return $allocAddr_
}


Simulator instproc set-address-format {opt args} {
set len [llength $args]
if {[string compare $opt "def"] == 0} {
$self set-address 32
set mcastshift [AddrParams set McastShift_]
Simulator set McastAddr_ [expr 1 << $mcastshift]
mrtObject expandaddr
} elseif {[string compare $opt "expanded"] == 0} {
puts "set-address-format expanded is obsoleted by 32-bit addressing."
} elseif {[string compare $opt "hierarchical"] == 0 && $len == 0} {
if [$self multicast?] {
$self set-hieraddress 3 9 11 11
} else {
$self set-hieraddress 3 10 11 11
}
} else {
if {[string compare $opt "hierarchical"] == 0 && $len > 0} {
eval $self set-hieraddress [lindex $args 0] [lrange $args 1 [expr $len - 1]]
}
} 
}


Simulator instproc expand-port-field-bits nbits {
puts "Warning: Simulator::expand-port-field-bits is obsolete.  Ports are 32 bits wide"
return
}



Simulator instproc set-address {node} {
set a [$self get-AllocAddrBits "new"]
$a set size_ [AllocAddrBits set DEFADDRSIZE_]
if {[expr $node] > [$a set size_]} {
$a set size_ [AllocAddrBits set MAXADDRSIZE_]
}

$a set-mcastbits 1
set lastbit [expr $node - [$a set mcastsize_]]
$a set-idbits 1 $lastbit
}

Simulator instproc expand-address {} {
puts "Warning: Simulator::expand-address is obsolete.  The node address is 32 bits wides"
return
}

Simulator instproc set-hieraddress {hlevel args} {
set a [$self get-AllocAddrBits "new"]
$a set size_ [AllocAddrBits set MAXADDRSIZE_]
if { ![Simulator set EnableHierRt_] && $hlevel > 1} {
Simulator set EnableHierRt_ 1
}
if [$self multicast?] {
$a set-mcastbits 1
}
eval $a set-idbits $hlevel $args
}

AllocAddrBits instproc init {} {
eval $self next
$self instvar size_ portsize_ idsize_ mcastsize_
set size_ 0
set portsize_ 0
set idsize_ 0
set mcastsize_ 0
}


AllocAddrBits instproc get-AllocAddr {} {
$self instvar addrStruct_
if ![info exists addrStruct_] {
set addrStruct_ [new AllocAddr]
}
return $addrStruct_
}

AllocAddrBits instproc get-Address {} {
$self instvar address_
if ![info exists address_] {
set address_ [new Address]
}
return $address_
}


AllocAddrBits instproc chksize {bit_num prog} {
$self instvar size_ portsize_ idsize_ mcastsize_  
if {$bit_num <= 0 } {
error "$prog : \# bits less than 1"
}
set totsize [expr $portsize_ + $idsize_ + $mcastsize_]
if {$totsize > [AllocAddrBits set MAXADDRSIZE_]} {
error "$prog : Total \# bits exceed MAXADDRSIZE"
}
if { $size_ < [AllocAddrBits set MAXADDRSIZE_]} {
if {$totsize > [AllocAddrBits set DEFADDRSIZE_]} {
set size_ [AllocAddrBits set MAXADDRSIZE_]
return 1
} 
}
return 0

}



AllocAddrBits instproc set-portbits {bit_num} {
puts "Warning: AllocAddrBits::set-portbits is obsolete.  Ports are 32 bits wide."
return
}



AllocAddrBits instproc expand-portbits nbits {
puts "Warning: AllocAddrBits::expand-portbits is obsolete.  Ports are 32 bits wide."
return
}

AllocAddrBits instproc set-mcastbits {bit_num} {
$self instvar size_ mcastsize_
if {$bit_num != 1} {
error "setmcast : mcastbit > 1"
}
set mcastsize_ $bit_num

if [$self chksize mcastsize_ "setmcast"] {
error "set-mcastbits: size_ has been changed."
}
set a [$self get-AllocAddr] 
set v [$a setbit $bit_num $size_]
AddrParams set McastMask_ [lindex $v 0]
AddrParams set McastShift_ [lindex $v 1]

set ad [$self get-Address]
$ad mcastbits-are [AddrParams set McastShift_] [AddrParams set McastMask_]

}


AllocAddrBits instproc set-idbits {nlevel args} {
$self instvar size_ portsize_ idsize_ hlevel_ hbits_
if {$nlevel != [llength $args]} {
error "setid: hlevel < 1 OR nlevel and \# args donot match"
}
set a [$self get-AllocAddr] 
set old 0
set idsize_ 0
set nodebits 0
AddrParams set hlevel_ $nlevel
set hlevel_ $nlevel
for {set i 0} {$i < $nlevel} {incr i} {
set bpl($i) [lindex $args $i]
set idsize_ [expr $idsize_ + $bpl($i)]

set chk [$self chksize $bpl($i) "setid"]
if {$chk > 0} {
error "set-idbits: size_ has been changed."
}
set v [$a setbit $bpl($i) $size_]
AddrParams set NodeMask_([expr $i+1]) [lindex $v 0]
set m([expr $i+1]) [lindex $v 0]
AddrParams set NodeShift_([expr $i+1]) [lindex $v 1]
set s([expr $i+1]) [lindex $v 1]
lappend hbits_ $bpl($i)

}
AddrParams set nodebits_ $idsize_
set ad [$self get-Address]
eval $ad idsbits-are [array get s]
eval $ad idmbits-are [array get m]

}





AddrParams proc set-hieraddr addrstr {
set ns [Simulator instance]
set addressObj [[$ns get-AllocAddrBits ""] get-Address]
set ip [$addressObj str2addr $addrstr]

return $ip
}

AddrParams proc get-hieraddr addr {
AddrParams instvar hlevel_ NodeMask_ NodeShift_
for {set i 1} {$i <= $hlevel_} {incr i} {
set a [expr [expr $addr >> $NodeShift_($i)] & $NodeMask_($i)]
lappend str $a
}
return $str
}

AddrParams proc elements-in-level? {nodeaddr level} {
AddrParams instvar hlevel_ domain_num_ cluster_num_ nodes_num_ def_
set L [split $nodeaddr .] 
set level [expr $level + 1]

if { $level == 1} {
return $domain_num_
}
if { $level == 2} {
return [lindex $cluster_num_ [lindex $L 0]]
}
if { $level == 3} {
set C 0
set index 0
while {$C < [lindex $L 0]} {
set index [expr $index + [lindex $cluster_num_ $C]]
incr C
}
return [lindex $nodes_num_ [expr $index + [lindex $L 1]]]
}

}




Simulator instproc get-node-by-addr address {
$self instvar Node_
set n [Node set nn_]
for {set q 0} {$q < $n} {incr q} {
set nq $Node_($q)
if {[string compare [$nq node-addr] $address] == 0} {
return $nq
}
}
error "get-node-by-addr:Cannot find node with given address"
}

Simulator instproc get-node-id-by-addr address {
$self instvar Node_
set n [Node set nn_]
for {set q 0} {$q < $n} {incr q} {
set nq $Node_($q)
if {[string compare [$nq node-addr] $address] == 0} {
return $q
}
}
error "get-node-id-by-addr:Cannot find node with given address"
}

Node set nn_ 0
Node proc getid {} {
set id [Node set nn_]
Node set nn_ [expr $id + 1]
return $id
}

Node instproc init args {
eval $self next $args

$self instvar id_ agents_ dmux_ neighbor_ rtsize_ address_  nodetype_ multiPath_ ns_

set ns_ [Simulator instance]
set id_ [Node getid]
$self nodeid $id_	;# Propagate id_ into c++ space
if {[llength $args] != 0} {
set address_ [lindex $args 0]
} else {
set address_ $id_
}

set nodetype_ [$ns_ get-nodetype]
set neighbor_ ""
set agents_ ""
set dmux_ ""
set rtsize_ 0
$self mk-default-classifier$nodetype_
$self cmd addr $address_; # new by tomh
set multiPath_ [$class set multiPath_]
if [$ns_ multicast?] {
$self enable-mcast $ns_
}
}

Node instproc node-type {} {
return [$self set nodetype_]
}

Node instproc mk-default-classifierMIPMH {} {
$self mk-default-classifier
}

Node instproc mk-default-classifierMIPBS {} {
$self mk-default-classifier
}

Node instproc mk-default-classifierBase {} {
$self mk-default-classifier
}

Node instproc mk-default-classifierMobile {} {
$self mk-default-classifier
}

Node instproc mk-default-classifierHier {} {
$self mk-default-classifier
}

Node instproc mk-default-classifier {} {
$self instvar classifier_ 
if [Simulator set EnableHierRt_] {
$self instvar classifiers_
set levels [AddrParams set hlevel_]
for {set n 1} {$n <= $levels} {incr n} {
set classifiers_($n) [new Classifier/Addr]
$classifiers_($n) set mask_  [AddrParams set NodeMask_($n)]
$classifiers_($n) set shift_  [AddrParams set NodeShift_($n)]
}
$self set classifier_ $classifiers_(1)
} else {
set classifier_ [new Classifier/Hash/Dest 32]
$classifier_ set mask_ [AddrParams set NodeMask_(1)]
$classifier_ set shift_ [AddrParams set NodeShift_(1)]
}
}

Node instproc enable-mcast args {
$self instvar classifier_ multiclassifier_ ns_ switch_ mcastproto_

$self set switch_ [new Classifier/Addr]
[$self set switch_] set mask_ [AddrParams set McastMask_]
[$self set switch_] set shift_ [AddrParams set McastShift_]
$self set multiclassifier_ [new Classifier/Multicast/Replicator]
[$self set multiclassifier_] set node_ $self

$self set mrtObject_ [new mrtObject $self]

$switch_ install 0 $classifier_
$switch_ install 1 $multiclassifier_
}

Node instproc incr-rtgtable-size {} {
$self instvar rtsize_
incr rtsize_
}

Node instproc decr-rtgtable-size {} {
$self instvar rtsize_
incr rtsize_ -1
}

Node instproc entry {} {
$self instvar ns_
if [info exists router_supp_] {
return $router_supp_
}
if [$ns_ multicast?] {
$self instvar switch_
return $switch_
}
$self instvar classifier_
return $classifier_
}

Node instproc id {} {
$self instvar id_
return $id_
}

Node instproc node-addr {} {
$self instvar address_
return $address_
}

Node instproc alloc-port { nullagent } {
return [[$self set dmux_] alloc-port $nullagent]
}

Node instproc attach { agent { port "" } } {
$self instvar agents_ address_ dmux_ 
lappend agents_ $agent
$agent set node_ $self
if [Simulator set EnableHierRt_] {
$agent set agent_addr_ [AddrParams set-hieraddr $address_]
} else {
$agent set agent_addr_ [expr ($address_ &  [AddrParams set NodeMask_(1)])  << [AddrParams set NodeShift_(1) ]]
}
if { $dmux_ == "" } {
set dmux_ [new Classifier/Port]
$dmux_ set mask_ [AddrParams set ALL_BITS_SET]
$dmux_ set shift_ 0
if {[Simulator set EnableHierRt_]} {
$self add-hroute $address_ $dmux_
} else {
$self add-route $address_ $dmux_
}
}
if {$port == ""} {
set port [$self alloc-port [[Simulator instance]  set nullAgent_]]
}
$agent set agent_port_ $port
$self add-target $agent $port
}

Node instproc add-target {agent port} {
$self instvar dmux_
$agent target [$self entry]
$dmux_ install $port $agent
}

Node instproc detach { agent nullagent } {
$self instvar agents_ dmux_
set k [lsearch -exact $agents_ $agent]
if { $k >= 0 } {
set agents_ [lreplace $agents_ $k $k]
}
$agent set node_ ""
$agent set agent_addr_ 0
$agent target $nullagent

set port [$agent set agent_port_]

$dmux_ install $port $nullagent
}

Node instproc agent port {
$self instvar agents_
foreach a $agents_ {
if { [$a set agent_port_] == $port } {
return $a
}
}
return ""
}

Node instproc reset {} {
$self instvar agents_
foreach a $agents_ {
$a reset
}
}

Node instproc neighbors {} {
$self instvar neighbor_
return [lsort $neighbor_]
}

Node instproc add-neighbor p {
$self instvar neighbor_
lappend neighbor_ $p
}

Node instproc is-neighbor { node } {
$self instvar neighbor_
return [expr [lsearch $neighbor_ $node] != -1]
}

Node instproc addInterface { iface } {
$self instvar ifaces_
lappend ifaces_ $iface
}

Node instproc add-route { dst target } {
$self instvar classifier_
$classifier_ install $dst $target
$self incr-rtgtable-size
}

Node instproc delete-route { dst nullagent } {
$self instvar classifier_
$classifier_ install $dst $nullagent
$self decr-rtgtable-size
}

Node instproc init-routing rtObject {
$self instvar multiPath_ routes_ rtObject_
set multiPath_ [$class set multiPath_]
set nn [$class set nn_]
for {set i 0} {$i < $nn} {incr i} {
set routes_($i) 0
}
if ![info exists rtObject_] {
$self set rtObject_ $rtObject
}
$self set rtObject_
}

Node instproc rtObject? {} {
$self instvar rtObject_
if ![info exists rtObject_] {
return ""
} else {
return $rtObject_
}
}

Node instproc split-addrstr addrstr {
set L [split $addrstr .]
return $L
}

Node/MobileNode instproc delete-hroute args {
$self instvar classifiers_
set l [llength $args]
$classifiers_($l) clear [lindex $args [expr $l-1]] 
}

Node instproc add-hroute { dst target } {
$self instvar classifiers_ rtsize_
set al [$self split-addrstr $dst]
set l [llength $al]
for {set i 1} {$i < $l} {incr i} {
set d [lindex $al [expr $i-1]]
$classifiers_($i) install $d $classifiers_([expr $i + 1]) 
}
$classifiers_($l) install [lindex $al [expr $l-1]] $target
$self incr-rtgtable-size
}

Node instproc add-routes {id ifs} {
$self instvar classifier_ multiPath_ routes_ mpathClsfr_
if !$multiPath_ {
if {[llength $ifs] > 1} {
warn "$class::$proc cannot install multiple routes"
set ifs [lindex $ifs 0]
}
$self add-route $id [$ifs head]
set routes_($id) 1
return
}
if {$routes_($id) <= 0 && [llength $ifs] == 1 && 	 ![info exists mpathClsfr_($id)]} {
$self add-route $id [$ifs head]
set routes_($id) 1
} else {
if ![info exists mpathClsfr_($id)] {
set mpathClsfr_($id) [new Classifier/MultiPath]
if {$routes_($id) > 0} {
assert "$routes_($id) == 1"
$mpathClsfr_($id) installNext  [$classifier_ in-slot? $id]
}
$classifier_ install $id $mpathClsfr_($id)
}
foreach L $ifs {
$mpathClsfr_($id) installNext [$L head]
incr routes_($id)
}
}
}

Node instproc delete-routes {id ifs nullagent} {
$self instvar mpathClsfr_ routes_
if [info exists mpathClsfr_($id)] {
foreach L $ifs {
set nonLink([$L head]) 1
}
foreach {slot link} [$mpathClsfr_($id) adjacents] {
if [info exists nonLink($link)] {
$mpathClsfr_($id) clear $slot
incr routes_($id) -1
if { $routes_($id) == 0 } {
delete $mpathClsfr_($id)
unset mpathClsfr_($id)
$self delete-route $id $nullagent
}
}
}
} else {
$self delete-route $id $nullagent
incr routes_($id) -1
}
}

Node instproc intf-changed {} {
$self instvar rtObject_
if [info exists rtObject_] {	;# i.e. detailed dynamic routing
$rtObject_ intf-changed
}
}

Class ManualRtNode -superclass Node

ManualRtNode instproc mk-default-classifier {} {
$self instvar address_ classifier_ id_ dmux_
set classifier_ [new Classifier/Hash/Dest 2]
$classifier_ set mask_ [AddrParams set NodeMask_(1)]
$classifier_ set shift_ [AddrParams set NodeShift_(1)]
set address_ $id_
}

ManualRtNode instproc add-route {dst_address target} {
$self instvar classifier_ 
set slot [$classifier_ installNext $target]
if {$dst_address == "default"} {
$classifier_ set default_ $slot
} else {
set encoded_dst_address [expr $dst_address << [AddrParams set NodeShift_(1)]]
$classifier_ set-hash auto 0 $encoded_dst_address 0 $slot
}
}

ManualRtNode instproc add-route-to-adj-node { args } {
$self instvar classifier_ address_

set dst ""
if {[lindex $args 0] == "-default"} {
set dst default
set args [lrange $args 1 end]
}
if {[llength $args] != 1} {
error "ManualRtNode::add-route-to-adj-node [-default] node"
}
set target_node $args
if {$dst == ""} {
set dst [$target_node set address_]
}
set ns [Simulator instance]
set link [$ns link $self $target_node]
set target [$link head]
return [$self add-route $dst $target]
}

Class VirtualClassifierNode -superclass Node

VirtualClassifierNode instproc mk-default-classifier {} {
$self instvar address_ classifier_ id_

set classifier_ [new Classifier/Virtual]
$classifier_ set node_ $self
$classifier_ set mask_ [AddrParams set NodeMask_(1)]
$classifier_ set shift_ [AddrParams set NodeShift_(1)]
set address_ $id_
$classifier_ nodeaddr $address_
}

VirtualClassifierNode instproc add-route { dst target } {
}

Classifier/Virtual instproc find dst {
$self instvar node_ ns_ 

if ![info exist ns_] {
set ns_ [Simulator instance]
}
if {[$node_ id] == $dst} {
return [$node_ set dmux_]
} else {
return [[$ns_ link $node_ [$ns_ set Node_($dst)]] head]
}
}

Classifier/Virtual instproc install {dst target} {
}



Class HierNode -superclass Node

HierNode instproc init {args} {
$self instvar address_
set haddress $args
set address_ $args
set args [lreplace $args 0 1]
$self next $args
set address_ $haddress
}

HierNode instproc mk-default-classifier {} {
$self instvar np_ id_ classifiers_ agents_ dmux_ neighbor_ address_ 
set levels [AddrParams set hlevel_]
for {set n 1} {$n <= $levels} {incr n} {
set classifiers_($n) [new Classifier/Addr]
$classifiers_($n) set mask_ [AddrParams set NodeMask_($n)]
$classifiers_($n) set shift_ [AddrParams set NodeShift_($n)]
}
$self set classifier_ $classifiers_(1)
}















ARPTable instproc init args {
eval $self next $args		;# parent class constructor
}

ARPTable set bandwidth_         0
ARPTable set delay_             5us


Node/MobileNode instproc init args {
$self instvar nifs_ arptable_ X_ Y_ Z_ nodetype_

eval $self next $args		;# parent class constructor

set X_ 0.0
set Y_ 0.0
set Z_ 0.0
set arptable_ ""                ;# no ARP table yet
set nifs_	0		;# number of network interfaces

$self makemip-New$nodetype_
}


Node/MobileNode instproc makemip-New {} {
}

Node/MobileNode instproc makemip-NewBase {} {
}

Node/MobileNode instproc makemip-NewMobile {} {
}

Node/MobileNode instproc makemip-NewMIPBS {} {
$self instvar regagent_ encap_ decap_ agents_ address_ dmux_ id_

if { $dmux_ == "" } {
set dmux_ [new Classifier/Port/Reserve]
$dmux_ set mask_ 0x7fffffff
$dmux_ set shift_ 0

if [Simulator set EnableHierRt_] {  
$self add-hroute $address_ $dmux_
} else {
$self add-route $address_ $dmux_
}
} 

set regagent_ [new Agent/MIPBS $self]
$self attach $regagent_ [Node/MobileNode set REGAGENT_PORT]
$self attach-encap 
$self attach-decap
}

Node/MobileNode instproc makemip-NewMIPMH {} {
$self instvar regagent_ dmux_ address_

if { $dmux_ == "" } {
set dmux_ [new Classifier/Port/Reserve]
$dmux_ set mask_ 0x7fffffff
$dmux_ set shift_ 0

if [Simulator set EnableHierRt_] {  
$self add-hroute $address_ $dmux_
} else {
$self add-route $address_ $dmux_
}
} 

set regagent_ [new Agent/MIPMH $self]
$self attach $regagent_ [Node/MobileNode set REGAGENT_PORT]
$regagent_ node $self
}

Node/MobileNode instproc install-defaulttarget {rcvT} {
$self instvar nodetype_
$self install-defaulttarget-New$nodetype_ $rcvT
}

Node/MobileNode instproc install-defaulttarget-New {rcvT} {
[$self set classifier_] defaulttarget $rcvT
}

Node/MobileNode instproc install-defaulttarget-NewMobile {rcvT} {
[$self set classifier_] defaulttarget $rcvT
}

Node/MobileNode instproc install-defaulttarget-NewBase {rcvT} {
$self instvar classifiers_
set level [AddrParams set hlevel_]
for {set i 1} {$i <= $level} {incr i} {
$classifiers_($i) defaulttarget $rcvT
}
}

Node/MobileNode instproc install-defaulttarget-NewMIPMH {rcvT} {
$self install-defaulttarget-NewBase $rcvT
}

Node/MobileNode instproc install-defaulttarget-NewMIPBS {rcvT} {
$self install-defaulttarget-NewBase $rcvT
}

Node/MobileNode instproc attach-encap {} {
$self instvar encap_ address_ 

set encap_ [new MIPEncapsulator]

set mask 0x7fffffff
set shift 0
if [Simulator set EnableHierRt_] {
set nodeaddr [AddrParams set-hieraddr $address_]
} else {
set nodeaddr [expr ( $address_ &			 [AddrParams set NodeMask_(1)] ) <<	 [AddrParams set NodeShift_(1) ]]
}
$encap_ set addr_ [expr ( ~($mask << $shift) & $nodeaddr)]
$encap_ set port_ 1
$encap_ target [$self entry]
$encap_ set node_ $self
}

Node/MobileNode instproc attach-decap {} {
$self instvar decap_ dmux_ agents_

set decap_ [new Classifier/Addr/MIPDecapsulator]
lappend agents_ $decap_
set mask 0x7fffffff
set shift 0
if {[expr [llength $agents_] - 1] > $mask} {
error "\# of agents attached to node $self exceeds port-field length of $mask bits\n"
}
$dmux_ install [Node/MobileNode set DECAP_PORT] $decap_
}

Node/MobileNode instproc reset {} {
$self instvar arptable_ nifs_ netif_ mac_ ifq_ ll_ imep_

for {set i 0} {$i < $nifs_} {incr i} {
$netif_($i) reset
$mac_($i) reset
$ll_($i) reset
$ifq_($i) reset
if { [info exists opt(imep)] && $opt(imep) == "ON" } { 
$imep_($i) reset 
}
}
if { $arptable_ != "" } {
$arptable_ reset 
}
}

Node/MobileNode instproc mobility-trace { ttype atype } {
$self instvar ns_

set tracefd [$ns_ get-ns-traceall]
if { $tracefd == "" } {
puts "Warning: You have not defined you tracefile yet!"
puts "Please use trace-all command to define it."
return ""
}
set T [new CMUTrace/$ttype $atype]
$T newtrace [Simulator set WirelessNewTrace_]
$T target [$ns_ nullagent]
$T attach $tracefd
$T set src_ [$self id]
$T node $self
return $T
}

Node/MobileNode instproc add-target-rtagent { agent port } {
$self instvar dmux_ classifier_ imep_ toraDebug_ ns_

set newapi [$ns_ imep-support]
set namfp [$ns_ get-nam-traceall]

if { [Simulator set RouterTrace_] == "ON" } {
if {$newapi != ""} {
set sndT [$self mobility-trace Send "RTR"]
} else {
set sndT [cmu-trace Send "RTR" $self]
}
if { $namfp != "" } {
$sndT namattach $namfp
}
if { $newapi == "ON" } {
$agent target $imep_(0)
$imep_(0) sendtarget $sndT
if { [info exists toraDebug_] && $toraDebug_ == "ON"} {
set sndT2 [$self mobility-trace Send "TRP"]
$sndT2 target $imep_(0)
$agent target $sndT2
}
} else {  ;#  no IMEP
$agent target $sndT
}
$sndT target [$self set ll_(0)]
if {$newapi != ""} {
set rcvT [$self mobility-trace Recv "RTR"]
} else {
set rcvT [cmu-trace Recv "RTR" $self]
}
if { $namfp != "" } {
$rcvT namattach $namfp
}
if {$newapi == "ON" } {
[$self set ll_(0)] up-target $imep_(0)
$classifier_ defaulttarget $agent
if {[info exists toraDebug_] && $toraDebug_ == "ON" } {
set rcvT2 [$self mobility-trace Recv "TRP"]
$rcvT2 target $agent
[$self set classifier_] defaulttarget $rcvT2
}
} else {
$rcvT target $agent
$self install-defaulttarget $rcvT
$dmux_ install $port $rcvT
}
} else {
if { $newapi == "ON" } {
$agent target $imep_(0)
if { [info exists toraDebug_] && $toraDebug_ == "ON"} {
set sndT2 [$self mobility-trace Send "TRP"]
$sndT2 target $imep_(0)
$agent target $sndT2
}
$imep_(0) sendtarget [$self set ll_(0)]

} else {  ;#  no IMEP
$agent target [$self set ll_(0)]
}    
if {$newapi == "ON" } {
[$self set ll_(0)] up-target $imep_(0)
$classifier_ defaulttarget $agent
if {[info exists toraDebug_] && $toraDebug_ == "ON" } {
set rcvT2 [$self mobility-trace Recv "TRP"]
$rcvT2 target $agent
[$self set classifier_] defaulttarget $rcvT2
}
} else {
$self install-defaulttarget $agent
$dmux_ install $port $agent
}
}
}

Node/MobileNode instproc add-target { agent port } {
$self instvar dmux_ classifier_ imep_ toraDebug_ ns_

set newapi [$ns_ imep-support]

$agent set sport_ $port

set toraonly [string first "TORA" [$agent info class]] 
if {$toraonly != -1 } {
$agent if-queue [$self set ifq_(0)]  ;# ifq between LL and MAC
$agent imep-agent [$self set imep_(0)]
[$self set imep_(0)] rtagent $agent
}

set aodvonly [string first "AODV" [$agent info class]] 
if {$aodvonly != -1 } {
$agent if-queue [$self set ifq_(0)]   ;# ifq between LL and MAC
}

if { $port == [Node set rtagent_port_] } {			
$self add-target-rtagent $agent $port
return
}

set namfp [$ns_ get-nam-traceall]
if { [Simulator set AgentTrace_] == "ON" } {
if {$newapi != ""} {
set sndT [$self mobility-trace Send "AGT"]
} else {
set sndT [cmu-trace Send AGT $self]
}
if { $namfp != "" } {
$sndT namattach $namfp
}
$sndT target [$self entry]
$agent target $sndT
if {$newapi != ""} {
set rcvT [$self mobility-trace Recv "AGT"]
} else {
set rcvT [cmu-trace Recv AGT $self]
}
if { $namfp != "" } {
$rcvT namattach $namfp
}
$rcvT target $agent
$dmux_ install $port $rcvT
} else {
$agent target [$self entry]
$dmux_ install $port $agent
}
}

Node/MobileNode instproc setPt { val } {
$self instvar netif_
$netif_(0) setTxPower $val
}

Node/MobileNode instproc setPr { val } {
$self instvar netif_
$netif_(0) setRxPower $val
}

Node/MobileNode instproc setPidle { val } {
$self instvar netif_
$netif_(0) setIdlePower $val
}

Node/MobileNode instproc add-interface { channel pmodel  lltype mactype qtype qlen iftype anttype} {
$self instvar arptable_ nifs_ netif_ mac_ ifq_ ll_ imep_

set ns_ [Simulator instance]
set imepflag [$ns_ imep-support]
set t $nifs_
incr nifs_

set netif_($t)	[new $iftype]		;# interface
set mac_($t)	[new $mactype]		;# mac layer
set ifq_($t)	[new $qtype]		;# interface queue
set ll_($t)	[new $lltype]		;# link layer
set ant_($t)    [new $anttype]

set namfp [$ns_ get-nam-traceall]
if {$imepflag == "ON" } {              
set imep_($t) [new Agent/IMEP [$self id]]
set imep $imep_($t)
set drpT [$self mobility-trace Drop "RTR"]
if { $namfp != "" } {
$drpT namattach $namfp
}
$imep drop-target $drpT
$ns_ at 0.[$self id] "$imep_($t) start"   ;# start beacon timer
}
set nullAgent_ [$ns_ set nullAgent_]
set netif $netif_($t)
set mac $mac_($t)
set ifq $ifq_($t)
set ll $ll_($t)
if { $arptable_ == "" } {
set arptable_ [new ARPTable $self $mac]
if {$imepflag != ""} {
set drpT [$self mobility-trace Drop "IFQ"]
} else {
set drpT [cmu-trace Drop "IFQ" $self]
}
$arptable_ drop-target $drpT
if { $namfp != "" } {
$drpT namattach $namfp
}
}
$ll arptable $arptable_
$ll mac $mac
$ll down-target $ifq

if {$imepflag == "ON" } {
$imep recvtarget [$self entry]
$imep sendtarget $ll
$ll up-target $imep
} else {
$ll up-target [$self entry]
}
$ifq target $mac
$ifq set limit_ $qlen
if {$imepflag != ""} {
set drpT [$self mobility-trace Drop "IFQ"]
} else {
set drpT [cmu-trace Drop "IFQ" $self]
}
$ifq drop-target $drpT
if { $namfp != "" } {
$drpT namattach $namfp
}
$mac netif $netif
$mac up-target $ll
$mac down-target $netif
set god_ [God instance]
if {$mactype == "Mac/802_11"} {
$mac nodes [$god_ num_nodes]
}
$netif channel $channel
$netif up-target $mac
$netif propagation $pmodel	;# Propagation Model
$netif node $self		;# Bind node <---> interface
$netif antenna $ant_($t)
$channel addif $netif


if { [Simulator set MacTrace_] == "ON" } {
if {$imepflag != ""} {
set rcvT [$self mobility-trace Recv "MAC"]
} else {
set rcvT [cmu-trace Recv "MAC" $self]
}
$mac log-target $rcvT
if { $namfp != "" } {
$rcvT namattach $namfp
}
if {$imepflag != ""} {
set sndT [$self mobility-trace Send "MAC"]
} else {
set sndT [cmu-trace Send "MAC" $self]
}
$sndT target [$mac down-target]
$mac down-target $sndT
if { $namfp != "" } {
$sndT namattach $namfp
}
if {$imepflag != ""} {
set rcvT [$self mobility-trace Recv "MAC"]
} else {
set rcvT [cmu-trace Recv "MAC" $self]
}
$rcvT target [$mac up-target]
$mac up-target $rcvT
if { $namfp != "" } {
$rcvT namattach $namfp
}
if {$imepflag != ""} {
set drpT [$self mobility-trace Drop "MAC"]
} else {
set drpT [cmu-trace Drop "MAC" $self]`
}
$mac drop-target $drpT
if { $namfp != "" } {
$drpT namattach $namfp
}
} else {
$mac log-target [$ns_ set nullAgent_]
$mac drop-target [$ns_ set nullAgent_]
}


$self addif $netif
}

Node/MobileNode instproc nodetrace { tracefd } {
set T [new Trace/Generic]
$T target [[Simulator instance] set nullAgent_]
$T attach $tracefd
$T set src_ [$self id]
$self log-target $T    
}

Node/MobileNode instproc agenttrace {tracefd} {
set ns_ [Simulator instance]
set ragent [$self set ragent_]
set drpT [$self mobility-trace Drop "RTR"]
set namfp [$ns_ get-nam-traceall]
if { $namfp != ""} {
$drpT namattach $namfp
}
$ragent drop-target $drpT
set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ [$self id]
$ragent tracetarget $T
set imepflag [$ns_ imep-support]
if {$imepflag == "ON"} {
[$self set imep_(0)] log-target $T
}
}

Node/MobileNode instproc mip-call {ragent} {
$self instvar regagent_
if [info exists regagent_] {
$regagent_ ragent $ragent
}
}

Class SRNodeNew -superclass Node/MobileNode

SRNodeNew instproc init args {
$self instvar dsr_agent_ dmux_ entry_point_ address_

set ns_ [Simulator instance]

eval $self next $args	;# parent class constructor

if {$dmux_ == "" } {
set dmux_ [new Classifier/Port]
$dmux_ set mask_ [AddrParams set PortMask_]
$dmux_ set shift_ [AddrParams set PortShift_]
}
set dsr_agent_ [new Agent/DSRAgent]

$dsr_agent_ addr $address_
$dsr_agent_ node $self
if [Simulator set mobile_ip_] {
$dsr_agent_ port-dmux [$self set dmux_]
}
$self addr $address_

if { [Simulator set RouterTrace_] == "ON" } {
set rcvT [$self mobility-trace Recv "RTR"]
set namfp [$ns_ get-nam-traceall]
if {  $namfp != "" } {
$rcvT namattach $namfp
}
$rcvT target $dsr_agent_
set entry_point_ $rcvT	
} else {
set entry_point_ $dsr_agent_
}

$self set ragent_ $dsr_agent_
$dsr_agent_ target $dmux_

set nullAgent_ [$ns_ set nullAgent_]
$dmux_ install [Node set rtagent_port_] $nullAgent_

$self instvar classifier_
set classifier_ "srnode made illegal use of classifier_"

return $self
}

SRNodeNew instproc start-dsr {} {
$self instvar dsr_agent_
$dsr_agent_ startdsr
}

SRNodeNew instproc entry {} {
$self instvar entry_point_
return $entry_point_
}

SRNodeNew instproc add-interface args {
eval $self next $args

$self instvar dsr_agent_ ll_ mac_ ifq_

set ns_ [Simulator instance]
$dsr_agent_ mac-addr [$mac_(0) id]

if { [Simulator set RouterTrace_] == "ON" } {
set sndT [$self mobility-trace Send "RTR"]
set namfp [$ns_ get-nam-traceall]
if {$namfp != "" } {
$sndT namattach $namfp
}
$sndT target $ll_(0)
$dsr_agent_ add-ll $sndT $ifq_(0)
} else {
$dsr_agent_ add-ll $ll_(0) $ifq_(0)
}
$dsr_agent_ install-tap $mac_(0)
}

SRNodeNew instproc reset args {
$self instvar dsr_agent_
eval $self next $args
$dsr_agent_ reset
}



















Class Node/MobileNode/BaseStationNode -superclass Node/MobileNode

Node/MobileNode/BaseStationNode instproc init args {
$self next $args
}

Node/MobileNode/BaseStationNode instproc mk-default-classifier {} {
$self instvar classifiers_ 
set levels [AddrParams set hlevel_]
for {set n 1} {$n <= $levels} {incr n} {
set classifiers_($n) [new Classifier/Hash/Dest/Bcast 32]
$classifiers_($n) set mask_ [AddrParams set NodeMask_($n)]
$classifiers_($n) set shift_ [AddrParams set NodeShift_($n)]
}
}


Node/MobileNode/BaseStationNode instproc entry {} {
$self instvar ns_
if ![info exist ns_] {
set ns_ [Simulator instance]
}
if [$ns_ multicast?] { 
$self instvar switch_
return $switch_
}
$self instvar classifiers_
return $classifiers_(1)
}

Node/MobileNode/BaseStationNode instproc add-hroute { dst target } {
$self instvar classifiers_ rtsize_
set al [$self split-addrstr $dst]
set l [llength $al]
for {set i 1} {$i <= $l} {incr i} {
set d [lindex $al [expr $i-1]]
if {$i == $l} {
$classifiers_($i) install $d $target
} else {
$classifiers_($i) install $d $classifiers_([expr $i + 1]) 
}
}
set rtsize_ [expr $rtsize_ + 1]
}

Node/MobileNode/BaseStationNode instproc clear-hroute args {
$self instvar classifiers_
set a [split $args]
set l [llength $a]
$classifiers_($l) clear [lindex $a [expr $l-1]] 
}

Node/MobileNode/BaseStationNode instproc node-addr {} {
$self instvar address_
return $address_
}

Node/MobileNode/BaseStationNode instproc split-addrstr addrstr {
set L [split $addrstr .]
return $L
}

Node/MobileNode/BaseStationNode instproc add-target {agent port } {
$self instvar dmux_ classifiers_
$agent set sport_ $port
set level [AddrParams set hlevel_]

if { $port == [Node set rtagent_port_] } {	
if { [Simulator set RouterTrace_] == "ON" } {
set sndT [cmu-trace Send "RTR" $self]
$sndT target [$self set ll_(0)]
$agent target $sndT
set rcvT [cmu-trace Recv "RTR" $self]
$rcvT target $agent
for {set i 1} {$i <= $level} {incr i} {
$classifiers_($i) defaulttarget $rcvT
$classifiers_($i) bcast-receiver $rcvT
}
$dmux_ install $port $rcvT
} else {
$agent target [$self set ll_(0)]
for {set i 1} {$i <= $level} {incr i} {
$classifiers_($i) bcast-receiver $agent
$classifiers_($i) defaulttarget $agent
}
$dmux_ install $port $agent
}
} else {
if { [Simulator set AgentTrace_] == "ON" } {
set sndT [cmu-trace Send AGT $self]
$sndT target [$self entry]
$agent target $sndT
set rcvT [cmu-trace Recv AGT $self]
$rcvT target $agent
$dmux_ install $port $rcvT
} else {
$agent target [$self entry]
$dmux_ install $port $agent
}
}
}
Class Link
Link instproc init { src dst } {
$self next

$self instvar trace_ fromNode_ toNode_ color_ oldColor_
set fromNode_ $src
set toNode_   $dst
set color_ "black"
set oldColor_ "black"

set trace_ ""
}

Link instproc head {} {
$self instvar head_
return $head_
}

Link instproc add-to-head { connector } {
$self instvar head_
$connector target [$head_ target]
$head_ target $connector
}

Link instproc queue {} {
$self instvar queue_
return $queue_
}

Link instproc link {} {
$self instvar link_
return $link_
}

Link instproc src {}	{ $self set fromNode_	}
Link instproc dst {}	{ $self set toNode_	}
Link instproc cost c	{ $self set cost_ $c	}

Link instproc cost? {} {
$self instvar cost_
if ![info exists cost_] {
set cost_ 1
}
set cost_
}

Link instproc if-label? {} {
$self instvar iif_
$iif_ label
}

Link instproc up { } {
$self instvar dynamics_ dynT_
if ![info exists dynamics_] return
$dynamics_ set status_ 1
if [info exists dynT_] {
foreach tr $dynT_ {
$tr format link-up {$src_} {$dst_}
set ns [Simulator instance]
$self instvar fromNode_ toNode_
$tr ntrace "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S UP"
$tr ntrace "v -t [$ns now] link-up [$ns now] [$fromNode_ id] [$toNode_ id]"
}
}
}

Link instproc down { } {
$self instvar dynamics_ dynT_
if ![info exists dynamics_] {
puts stderr "$class::$proc Link $self was not declared dynamic, and cannot be taken down.  ignored"
return
}
$dynamics_ set status_ 0
$self all-connectors reset
if [info exists dynT_] {
foreach tr $dynT_ {
$tr format link-down {$src_} {$dst_}
set ns [Simulator instance]
$self instvar fromNode_ toNode_
$tr ntrace "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DOWN"
$tr ntrace "v -t [$ns now] link-down [$ns now] [$fromNode_ id] [$toNode_ id]"
}
}
}

Link instproc up? {} {
$self instvar dynamics_
if [info exists dynamics_] {
return [$dynamics_ status?]
} else {
return "up"
}
}

Link instproc all-connectors op {
foreach c [$self info vars] {
$self instvar $c
if ![info exists $c] continue
if [array size $c] continue
foreach var [$self set $c] {
if [catch "$var info class"] {
continue
}
if ![$var info class Node] { ;# $op on most everything
catch "$var $op";# in case var isn't a connector
}
}
}
}

Link instproc install-error {em} {
$self instvar link_
$em target [$link_ target]
$link_ target $em
}

Class SimpleLink -superclass Link

SimpleLink instproc init { src dst bw delay q {lltype "DelayLink"} } {
$self next $src $dst
$self instvar link_ queue_ head_ toNode_ ttl_
$self instvar drophead_

set ns [Simulator instance]
set drophead_ [new Connector]
$drophead_ target [$ns set nullAgent_]

set head_ [new Connector]
$head_ set link_ $self

if { [[$q info class] info heritage ErrModule] == "ErrorModule" } {
$head_ target [$q classifier]
} else {
$head_ target $q
}

set queue_ $q
set link_ [new $lltype]
$link_ set bandwidth_ $bw
$link_ set delay_ $delay

$queue_ target $link_
$link_ target [$dst entry]
$queue_ drop-target $drophead_

set ttl_ [new TTLChecker]
$ttl_ target [$link_ target]
$self ttl-drop-trace
$link_ target $ttl_

if { [$ns multicast?] } {
$self enable-mcast $src $dst
}
}

SimpleLink instproc enable-mcast {src dst} {
$self instvar iif_ ttl_
set iif_ [new NetworkInterface]
$iif_ target [$ttl_ target]
$ttl_ target $iif_

$src add-oif [$self head]  $self
$dst add-iif [$iif_ label] $self
}

SimpleLink instproc nam-trace { ns f } {
$self instvar enqT_ deqT_ drpT_ rcvT_ dynT_

if [info exists enqT_] {
$enqT_ namattach $f
if [info exists deqT_] {
$deqT_ namattach $f
}
if [info exists drpT_] {
$drpT_ namattach $f
}
if [info exists rcvT_] {
$rcvT_ namattach $f
}
if [info exists dynT_] {
foreach tr $dynT_ {
$tr namattach $f
}
}
} else {
$self trace $ns $f "nam"
}
}

SimpleLink instproc trace { ns f {op ""} } {

$self instvar enqT_ deqT_ drpT_ queue_ link_ fromNode_ toNode_
$self instvar rcvT_ ttl_ trace_
$self instvar drophead_		;# idea stolen from CBQ and Kevin

set trace_ $f
set enqT_ [$ns create-trace Enque $f $fromNode_ $toNode_ $op]
set deqT_ [$ns create-trace Deque $f $fromNode_ $toNode_ $op]
set drpT_ [$ns create-trace Drop $f $fromNode_ $toNode_ $op]
set rcvT_ [$ns create-trace Recv $f $fromNode_ $toNode_ $op]

$self instvar drpT_ drophead_
set nxt [$drophead_ target]
$drophead_ target $drpT_
$drpT_ target $nxt

$queue_ drop-target $drophead_


$deqT_ target [$queue_ target]
$queue_ target $deqT_

$self add-to-head $enqT_

$rcvT_ target [$ttl_ target]
$ttl_ target $rcvT_

$self instvar dynamics_
if [info exists dynamics_] {
$self trace-dynamics $ns $f $op
}
}

SimpleLink instproc trace-dynamics { ns f {op ""}} {
$self instvar dynT_ fromNode_ toNode_
lappend dynT_ [$ns create-trace Generic $f $fromNode_ $toNode_ $op]
$self transit-drop-trace
$self linkfail-drop-trace
}

SimpleLink instproc ttl-drop-trace args {
$self instvar ttl_
if ![info exists ttl_] return
if {[llength $args] != 0} {
$ttl_ drop-target [lindex $args 0]
} else {
$self instvar drophead_
$ttl_ drop-target $drophead_
}
}

SimpleLink instproc transit-drop-trace args {
$self instvar link_
if {[llength $args] != 0} {
$link_ drop-target [lindex $args 0]
} else {
$self instvar drophead_
$link_ drop-target $drophead_
}
}

SimpleLink instproc linkfail-drop-trace args {
$self instvar dynamics_
if ![info exists dynamics_] return
if {[llength $args] != 0} {
$dynamics_ drop-target [lindex $args 0]
} else {
$self instvar drophead_
$dynamics_ drop-target $drophead_
}
}

SimpleLink instproc trace-callback {ns cmd} {
$self trace $ns {}
foreach part {enqT_ deqT_ drpT_ rcvT_} {
$self instvar $part
set to [$self set $part]
$to set callback_ 1
$to proc handle a "$cmd \$a"
}
}

SimpleLink instproc attach-monitors { insnoop outsnoop dropsnoop qmon } {
$self instvar drpT_ queue_ snoopIn_ snoopOut_ snoopDrop_
$self instvar qMonitor_ drophead_

set snoopIn_ $insnoop
set snoopOut_ $outsnoop
set snoopDrop_ $dropsnoop

$self add-to-head $snoopIn_

$snoopOut_ target [$queue_ target]
$queue_ target $snoopOut_

set nxt [$drophead_ target]
$drophead_ target $snoopDrop_
$snoopDrop_ target $nxt


$snoopIn_ set-monitor $qmon
$snoopOut_ set-monitor $qmon
$snoopDrop_ set-monitor $qmon
set qMonitor_ $qmon
}

SimpleLink instproc attach-taggers { insnoop qmon } {
$self instvar drpT_ queue_ head_ snoopIn_ snoopOut_ snoopDrop_
$self instvar qMonitor_ drophead_

set snoopIn_ $insnoop

$snoopIn_ target $head_
set head_ $snoopIn_

$snoopIn_ set-monitor $qmon


set qMonitor_ $qmon

}

SimpleLink instproc init-monitor { ns qtrace sampleInterval} {
$self instvar qMonitor_ ns_ qtrace_ sampleInterval_

set ns_ $ns
set qtrace_ $qtrace
set sampleInterval_ $sampleInterval
set qMonitor_ [new QueueMonitor]

$self attach-monitors [new SnoopQueue/In]  [new SnoopQueue/Out] [new SnoopQueue/Drop] $qMonitor_

set bytesInt_ [new Integrator]
$qMonitor_ set-bytes-integrator $bytesInt_
set pktsInt_ [new Integrator]
$qMonitor_ set-pkts-integrator $pktsInt_
return $qMonitor_
}

SimpleLink instproc start-tracing { } {
$self instvar qMonitor_ ns_ qtrace_ sampleInterval_
$self instvar fromNode_ toNode_

if {$qtrace_ != 0} {
$qMonitor_ trace $qtrace_
}
$qMonitor_ set-src-dst [$fromNode_ id] [$toNode_ id]
} 

SimpleLink instproc queue-sample-timeout { } {
$self instvar qMonitor_ ns_ qtrace_ sampleInterval_
$self instvar fromNode_ toNode_

set qavg [$self sample-queue-size]
if {$qtrace_ != 0} {
puts $qtrace_ "[$ns_ now] [$fromNode_ id] [$toNode_ id] $qavg"
}
$ns_ at [expr [$ns_ now] + $sampleInterval_] "$self queue-sample-timeout"
}

SimpleLink instproc sample-queue-size { } {
$self instvar qMonitor_ ns_ qtrace_ sampleInterval_ lastSample_

set now [$ns_ now]
set qBytesMonitor_ [$qMonitor_ get-bytes-integrator]
set qPktsMonitor_ [$qMonitor_ get-pkts-integrator]

$qBytesMonitor_ newpoint $now [$qBytesMonitor_ set lasty_]
set bsum [$qBytesMonitor_ set sum_]

$qPktsMonitor_ newpoint $now [$qPktsMonitor_ set lasty_]
set psum [$qPktsMonitor_ set sum_]

if ![info exists lastSample_] {
set lastSample_ 0
}
set dur [expr $now - $lastSample_]
if { $dur != 0 } {
set meanBytesQ [expr $bsum / $dur]
set meanPktsQ [expr $psum / $dur]
} else {
set meanBytesQ 0
set meanPktsQ 0
}
$qBytesMonitor_ set sum_ 0.0
$qPktsMonitor_ set sum_ 0.0
set lastSample_ $now

return "$meanBytesQ $meanPktsQ"
}	


SimpleLink instproc dynamic {} {
$self instvar dynamics_

if [info exists dynamics_] return

set dynamics_ [new DynamicLink]
$self add-to-head $dynamics_

$self transit-drop-trace
$self all-connectors isDynamic
}

SimpleLink instproc errormodule args {
$self instvar errmodule_ queue_ drophead_
if { $args == "" } {
return $errmodule_
}

set em [lindex $args 0]
set errmodule_ $em

$self add-to-head $em

$em drop-target $drophead_
}

SimpleLink instproc insert-linkloss args { 
$self instvar link_errmodule_ queue_ drophead_ deqT_ 
if { $args == "" } {
return $link_errmodule_
}

set em [lindex $args 0]
if [info exists link_errmodule_] {
delete link_errmodule_
}
set link_errmodule_ $em

if [info exists deqT_] {
$em target [$deqT_ target]
$deqT_ target $em
} else {
$em target [$queue_ target]
$queue_ target $em
}

$em drop-target $drophead_
}





Class Application/FTP -superclass Application

Application/FTP instproc init {} {
$self next
}

Application/FTP instproc start {} {
[$self agent] send -1
}

Application/FTP instproc stop {} {
[$self agent] advance 0
[$self agent] close
}

Application/FTP instproc send {nbytes} {
[$self agent] send $nbytes
}

Application/FTP instproc produce { pktcnt } {
[$self agent] advance $pktcnt
}

Application/FTP instproc producemore { pktcnt } {
[$self agent] advanceby $pktcnt
}

Application/Traffic instproc set args {
$self instvar packetSize_ rate_
if { [lindex $args 0] == "packet_size_" } {
if { [llength $args] == 2 } {
set packetSize_ [lindex $args 1]
return
} elseif { [llength $args] == 1 } {
return $packetSize_
}
}
eval $self next $args
}
Application/Traffic/CBR instproc set args {
$self instvar packetSize_ rate_
if { [lindex $args 0] == "interval_" } {
if { [llength $args] == 2 } {
set ns_ [Simulator instance]
set interval_ [$ns_ delay_parse [lindex $args 1]]
$self set rate_ [expr $packetSize_ * 8.0/$interval_]
return
} elseif { [llength $args] == 1 } {
return [expr $packetSize_ * 8.0/$rate_]
}
}
eval $self next $args
}


Class Agent/CBR -superclass Agent/UDP
Class Agent/CBR/UDP -superclass Agent/UDP
Class Agent/CBR/RTP -superclass Agent/RTP
Class Agent/CBR/UDP/SA -superclass Agent/SA

Agent/SA instproc attach-traffic tg {
$tg attach-agent $self
eval $self cmd attach-traffic $tg
}

Agent/CBR/UDP instproc attach-traffic tg {
$self instvar trafgen_
$tg attach-agent $self
set trafgen_ $tg
}

Agent/CBR/UDP instproc done {} { }

Agent/CBR/UDP instproc start {} {
$self instvar trafgen_
$trafgen_ start
}

Agent/CBR/UDP instproc stop {} {
$self instvar trafgen_
$trafgen_ stop
}

Agent/CBR/UDP instproc advance args {
$self instvar trafgen_
eval $trafgen_ advance $args
}

Agent/CBR/UDP instproc advanceby args {
$self instvar trafgen_
eval $trafgen_ advanceby $args
}

Agent/CBR instproc init {} {
$self next
$self instvar trafgen_ interval_ random_ packetSize_ maxpkts_
set packetSize_ 210
set random_ 0
set maxpkts_ 268435456	
set interval_ 0.00375
set trafgen_ [new Application/Traffic/CBR]
$trafgen_ attach-agent $self
$trafgen_ set rate_ [expr $packetSize_ * 8.0/ $interval_]
$trafgen_ set random_ [$self set random_]
$trafgen_ set maxpkts_ [$self set maxpkts_]
$trafgen_ set packetSize_ [$self set packetSize_]
if {[Simulator set nsv1flag] == 0} { 

puts "using backward compatible Agent/CBR; use Application/Traffic/CBR instead"
}    
}



Agent/CBR instproc done {} { }

Agent/CBR instproc start {} {
$self instvar trafgen_
$trafgen_ start
}

Agent/CBR instproc stop {} {
$self instvar trafgen_
$trafgen_ stop
}

Agent/CBR instproc advance args {
$self instvar trafgen_
eval $trafgen_ advance $args
}

Agent/CBR instproc advanceby args {
$self instvar trafgen_
eval $trafgen_ advanceby $args
}

Agent/CBR instproc set args {
$self instvar interval_ random_ packetSize_ maxpkts_ trafgen_
if { [info exists trafgen_] } {
if { [lindex $args 0] == "packetSize_" } {
if { [llength $args] == 2 } {
$trafgen_ set packetSize_ [lindex $args 1]
set packetSize_ [lindex $args 1]
$trafgen_ set rate_ [expr $packetSize_ * 8.0/ $interval_]
return 
} elseif { [llength $args] == 1 } {
return $packetSize_
}
} elseif { [lindex $args 0] == "random_" } {
if { [llength $args] == 2 } {
$trafgen_ set random_ [lindex $args 1]
set random_ [lindex $args 1]
return
} elseif { [llength $args] == 1 } {
return $random_
}
} elseif { [lindex $args 0] == "maxpkts_" } {
if { [llength $args] == 2 } {
$trafgen_ set maxpkts_ [lindex $args 1]
set maxpkts_ [lindex $args 1]
return
} elseif { [llength $args] == 1 } {
return $maxpkts_
}
} elseif { [lindex $args 0] == "interval_" } {
if { [llength $args] == 2 } {
set ns_ [Simulator instance]
set interval_ [$ns_ delay_parse [lindex $args 1]]
$trafgen_ set rate_ [expr $packetSize_ * 8.0/ $interval_]
return
} elseif { [llength $args] == 1 } {
return $interval_
}
}
}
eval $self next $args
}

Class Traffic/Expoo -superclass Application/Traffic/Exponential
Class Traffic/Pareto -superclass Application/Traffic/Pareto
Class Traffic/Trace -superclass Application/Traffic/Trace

Traffic/Expoo instproc set args {
$self instvar packetSize_ burst_time_ idle_time_ rate_ 
if { [lindex $args 0] == "packet-size" } {
if { [llength $args] == 2 } {
$self set packetSize_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $packetSize_
}
} elseif { [lindex $args 0] == "burst-time" } {
if { [llength $args] == 2 } {
$self set burst_time_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $burst_time_
}
} elseif { [lindex $args 0] == "idle-time" } {
if { [llength $args] == 2 } {
$self set idle_time_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $idle_time_
}
} elseif { [lindex $args 0] == "rate" } {
if { [llength $args] == 2 } {
$self set rate_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $rate_
}
}
eval $self next $args
}

Traffic/Pareto instproc set args {
$self instvar packetSize_ burst_time_ idle_time_ rate_ shape_
if { [lindex $args 0] == "packet-size" } {
if { [llength $args] == 2 } {
$self set packetSize_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $packetSize_
}
} elseif { [lindex $args 0] == "burst-time" } {
if { [llength $args] == 2 } {
$self set burst_time_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $burst_time_
}
} elseif { [lindex $args 0] == "idle-time" } {
if { [llength $args] == 2 } {
$self set idle_time_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $idle_time_
}
} elseif { [lindex $args 0] == "rate" } {
if { [llength $args] == 2 } {
$self set rate_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $rate_
}
} elseif { [lindex $args 0] == "shape" } {
if { [llength $args] == 2 } {
$self set shape_ [lindex $args 1]
return 
} elseif { [llength $args] == 1 } {
return $shape_
}
}
eval $self next $args
}

Class Source/FTP -superclass Application
Source/FTP set maxpkts_ 268435456

Source/FTP instproc attach o {
$self instvar agent_
set agent_ $o
$self attach-agent $o
}

Source/FTP instproc init {} {
$self next
$self instvar maxpkts_ agent_
set maxpkts_ 268435456
}

Source/FTP instproc start {} {
$self instvar agent_ maxpkts_
$agent_ advance $maxpkts_
}

Source/FTP instproc stop {} {
$self instvar agent_
$agent_ advance 0
}

Source/FTP instproc produce { pktcnt } {
$self instvar agent_ 
$agent_ advance $pktcnt
}

Source/FTP instproc producemore { pktcnt } {
$self instvar agent_
$agent_ advanceby $pktcnt
}


Class Source/Telnet -superclass Application/Telnet

Source/Telnet set maxpkts_ 268435456

Source/Telnet instproc attach o {
$self instvar agent_
set agent_ $o
$self attach-agent $o
}


Class OldSim -superclass Simulator

proc ns args {
OldSim ns
eval ns $args
}

OldSim instproc default_catch { varName index op } {
if { $index == "" } {
error "ns-1 compat: default change caught, but not a default! (varName: $varName)"
exit 1
}

if { $op == "r" || $op == "u" } {
error "ns-1 compat: default change caught a $op operation"
exit 1
}
set vname ${varName}($index)
upvar $vname var
$self default_assign $varName $index $var
}


OldSim instproc default_assign {aname index newval} {
$self instvar classMap_ queueMap_
if { $index == "" } {
puts "something funny with default traces"
exit 1
}
set obj [string trimleft $aname ns_]
if { $obj == "link" } {
if { $index == "queue-limit" } {
Queue set limit_ $newval
return
}
set ivar "$index\_"
if { [lsearch [DelayLink info vars] $ivar] >= 0 } {
DelayLink set $ivar $newval
return
}
error "warning: ns-1 compatibility library cannot set link default ${aname}($index)"
return
}

if ![info exists classMap_($obj)] {
if ![info exists queueMap_($obj)] {
puts "error: ns-2 compatibility library cannot set ns-v1 default ${aname}($index)"
exit 1
} else {
set ns2obj "Queue/$queueMap_($obj)"
}
} else {
set ns2obj $classMap_($obj)
}
SplitObject instvar varMap_ 
if ![info exists varMap_($index)] {
puts "error: ns-2 compatibility library cannot map instvar $index in class $ns2obj"
exit 1
}
$ns2obj set $varMap_($index) $newval

}

OldSim instproc map_ns_defaults old_arr {
global $old_arr ; # these were all globals in ns-1
SplitObject instvar varMap_

foreach el [array names $old_arr] {
set val [expr "$${old_arr}($el)"]
$self default_assign $old_arr $el $val
}

trace variable $old_arr rwu "$self default_catch"
}

OldSim instproc trace_old_defaults {} {
$self map_ns_defaults ns_tcp
$self map_ns_defaults ns_tcpnewreno
$self map_ns_defaults ns_trace
$self map_ns_defaults ns_fulltcp
$self map_ns_defaults ns_red
$self map_ns_defaults ns_cbq
$self map_ns_defaults ns_class
$self map_ns_defaults ns_sink
$self map_ns_defaults ns_delsink
$self map_ns_defaults ns_sacksink
$self map_ns_defaults ns_cbr
$self map_ns_defaults ns_rlm
$self map_ns_defaults ns_ivs
$self map_ns_defaults ns_source
$self map_ns_defaults ns_telnet
$self map_ns_defaults ns_bursty
$self map_ns_defaults ns_message
$self map_ns_defaults ns_facktcp
$self map_ns_defaults ns_link
$self map_ns_defaults ns_lossy_uniform
$self map_ns_defaults ns_lossy_patt
$self map_ns_defaults ns_queue
$self map_ns_defaults ns_srm
}

OldSim instproc init args {
eval $self next $args
puts stderr "warning: using backward compatibility mode"
$self instvar classMap_

Simulator set nsv1flag 1

$self instvar scheduler_
set scheduler_ [new Scheduler/List]

Queue/CBQ instproc set args {
$self instvar compat_qlim_
if { [lindex $args 0] == "queue-limit" ||  [lindex $args 0] == "limit_" } { 
if { [llength $args] == 2 } {
set val [lindex $args 1]
set compat_qlim_ $val
return $val
}
return $compat_qlim_
} elseif { [lindex $args 0] == "algorithm_" } {
$self algorithm [lindex $args 1]
}
eval $self next $args
}
Queue/DropTail instproc set args {
if { [llength $args] == 2 &&
[lindex $args 0] == "queue-limit" } {
$self set limit_ [lindex $args 1]
return
}
eval $self next $args
}
Queue/RED instproc set args {
if { [llength $args] == 2 &&
[lindex $args 0] == "queue-limit" } {
$self set limit_ [lindex $args 1]
return
}
eval $self next $args
}
Queue/RED instproc enable-vartrace file {
$self trace ave_
$self trace prob_
$self trace curq_
$self attach $file
}
Source/FTP instproc set args {
if { [llength $args] == 2 &&
[lindex $args 0] == "maxpkts" } {
$self set maxpkts_ [lindex $args 1]
return
}
eval $self next $args
}
Source/Telnet instproc set args {
if { [llength $args] == 2 &&
[lindex $args 0] == "interval" } {
$self set interval_ [lindex $args 1]
return
}
eval $self next $args
}
Agent/TCP instproc source type {
if { $type == "ftp" } {
set type FTP
}
if { $type == "telnet" } {
set type Telnet
}
set src [new Source/$type]
$src attach $self
return $src
}
Agent/TCP set restart_bugfix_ false
SplitObject instproc set args {
SplitObject instvar varMap_
set var [lindex $args 0] 
if [info exists varMap_($var)] {
set var $varMap_($var)
set args "$var [lrange $args 1 end]"
}
$self instvar -parse-part1 $var
if {[llength $args] == 1} {
return [subst $[subst $var]]
} else {
return [set $var [lrange $args 1 end]]
}
}
SplitObject instproc get {var} {
SplitObject instvar varMap_
if [info exists varMap_($var)] {
return [$self set $varMap_($var)]
} else {
return [$self next $var]
}
}
TclObject set varMap_(addr) addr_
TclObject set varMap_(dst) dst_
TclObject set varMap_(cls) fid_

TclObject set varMap_(src) src_
TclObject set varMap_(show_tcphdr) show_tcphdr_

TclObject set varMap_(window) window_
TclObject set varMap_(window-init) windowInit_
TclObject set varMap_(window-option) windowOption_
TclObject set varMap_(window-constant) windowConstant_
TclObject set varMap_(window-thresh) windowThresh_
TclObject set varMap_(overhead) overhead_
TclObject set varMap_(tcp-tick) tcpTick_
TclObject set varMap_(ecn) ecn_
TclObject set varMap_(bug-fix) bugFix_
TclObject set varMap_(maxburst) maxburst_
TclObject set varMap_(maxcwnd) maxcwnd_
TclObject set varMap_(dupacks) dupacks_
TclObject set varMap_(seqno) seqno_
TclObject set varMap_(ack) ack_
TclObject set varMap_(cwnd) cwnd_
TclObject set varMap_(awnd) awnd_
TclObject set varMap_(ssthresh) ssthresh_
TclObject set varMap_(rtt) rtt_
TclObject set varMap_(srtt) srtt_
TclObject set varMap_(rttvar) rttvar_
TclObject set varMap_(backoff) backoff_
TclObject set varMap_(v-alpha) v_alpha_
TclObject set varMap_(v-beta) v_beta_
TclObject set varMap_(v-gamma) v_gamma_

TclObject set varMap_(changes) newreno_changes_

TclObject set varMap_(rampdown) rampdown_ 
TclObject set varMap_(ss-div4) ss-div4_

TclObject set varMap_(limit) limit_

TclObject set varMap_(limit) maxqueue_
TclObject set varMap_(buckets) buckets_

TclObject set varMap_(bytes) bytes_
TclObject set varMap_(thresh) thresh_
TclObject set varMap_(maxthresh) maxthresh_
TclObject set varMap_(mean_pktsize) meanPacketSize_
TclObject set varMap_(q_weight) queueWeight_
TclObject set varMap_(wait) wait_
TclObject set varMap_(linterm) linterm_
TclObject set varMap_(setbit) setbit_
TclObject set varMap_(drop-tail) dropTail_
TclObject set varMap_(doubleq) doubleq_
TclObject set varMap_(dqthresh) dqthresh_
TclObject set varMap_(subclasses) subclasses_
TclObject set varMap_(algorithm) algorithm_
TclObject set varMap_(max-pktsize) maxpkt_
TclObject set varMap_(priority) priority_
TclObject set varMap_(maxidle) maxidle_
TclObject set varMap_(extradelay) extradelay_

TclObject set varMap_(packet-size) packetSize_
TclObject set varMap_(interval) interval_

TclObject set varMap_(random) random_

TclObject set varMap_(S) S_
TclObject set varMap_(R) R_
TclObject set varMap_(state) state_
TclObject set varMap_(rttShift) rttShift_
TclObject set varMap_(keyShift) keyShift_
TclObject set varMap_(key) key_
TclObject set varMap_(maxrtt) maxrtt_

Class traceHelper
traceHelper instproc attach f {
$self instvar file_
set file_ $f
}

Class linkHelper
linkHelper instproc init args {
$self instvar node1_ node2_ linkref_ queue_
set node1_ [lindex $args 0]
set node2_ [lindex $args 1]
set lid [$node1_ id]:[$node2_ id]	    
set linkref_ [ns set link_($lid)]
set queue_ [$linkref_ queue]
set sqi [new SnoopQueue/In]
set sqo [new SnoopQueue/Out]
set sqd [new SnoopQueue/Drop]
set dsamples [new Samples]
set qmon [new QueueMonitor/Compat]
$qmon set-delay-samples $dsamples
$linkref_ attach-monitors $sqi $sqo $sqd $qmon
$linkref_ set bytesInt_ [new Integrator]
$linkref_ set pktsInt_ [new Integrator]
$qmon set-bytes-integrator [$linkref_ set bytesInt_]
$qmon set-pkts-integrator [$linkref_ set pktsInt_]
}
linkHelper instproc trace traceObj {
$self instvar node1_ node2_
$self instvar queue_
set tfile [$traceObj set file_]
ns trace-queue $node1_ $node2_ $tfile
if { [string first Queue/RED [$queue_ info class]] == 0 } {
$queue_ enable-vartrace $tfile
}
}
linkHelper instproc callback {fn} {
$self instvar linkref_
foreach part {enqT_ deqT_ drpT_} {
set to [$linkref_ set $part]
$to set callback_ 1
$to proc handle {args} "$fn \$args"
}
}
linkHelper instproc set { var val } {

$self instvar linkref_ queue_
set qvars [$queue_ info vars]
set linkvars [$linkref_ info vars]
set linkdelayvars [[$linkref_ link] info vars]
if { [string last _ $var] != ( [string length $var] - 1) } {
set var ${var}_
}
if { $var == "queue-limit_" } {
set var "limit_"
}
if { [lsearch $qvars $var] >= 0 } {
$queue_ set $var $val
} elseif { [lsearch $linkvars $var] >= 0 } {
$linkref_ set $var $val
} elseif { [lsearch $linkdelayvars $var] >= 0 } {
[$linkref_ link] set $var $val
} else {
puts stderr "linkHelper warning: couldn't set unknown variable $var"
}
}

linkHelper instproc get var {

$self instvar linkref_ queue_
set qvars [$queue_ info vars]
set linkvars [$linkref_ info vars]
set linkdelayvars [[$linkref_ link] info vars]
if { [string last _ $var] != ( [string length $var] - 1) } {
set var ${var}_
}
if { $var == "queue-limit_" } {
set var "limit_"
}
if { [lsearch $qvars $var] >= 0 } {
return [$queue_ set $var]
} elseif { [lsearch $linkvars $var] >= 0 } {
return [$linkref_ set $var]
} elseif { [lsearch $linkdelayvars $var] >= 0 } {
return [[$linkref_ link] set $var]
} else {
puts stderr "linkHelper warning: couldn't set unknown variable $var"
return ""
}
return ""
}

linkHelper instproc try { obj operation argv } {
set op [eval list $obj $operation $argv]
set ocl [$obj info class]
set iprocs [$ocl info instcommands]
set oprocs [$obj info commands]
if { $operation != "cmd" } {
if { [lsearch $iprocs $operation] >= 0 } {
return [eval $op]
}
if { [lsearch $oprocs $operation] >= 0 } {
return [eval $op]
}
}
if [catch $op ret] {
return -1
}
return $ret
}
linkHelper instproc unknown { m args } {
$self instvar linkref_ queue_
set oldbody [TclObject info instbody unknown]
TclObject instproc unknown args {
if { [lindex $args 0] == "cmd" } {
puts stderr "Can't dispatch $args"
exit 1
}
eval $self cmd $args
}

set rval [$self try $queue_ $m $args]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
set rval [$self try $queue_ cmd [list $m $args]]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
set rval [$self try $linkref_ $m $args]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
set rval [$self try $linkref_ cmd [list $m $args]]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
set dlink [$linkref_ link]
set rval [$self try $dlink $m $args]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
set rval [$self try $dlink cmd [list $m $args]]
if { $rval != -1 } {
TclObject instproc unknown args $oldbody
return $rval
}
TclObject instproc unknown args $oldbody
puts stderr "Unknown operation $m or subbordinate operation failed"
exit 1
}
linkHelper instproc stat { classid item } {
$self instvar linkref_
set qmon [$linkref_ set qMonitor_]
if { $item == "packets" } {
return [$qmon pkts $classid]
} elseif { $item == "bytes" } {
return [$qmon bytes $classid]
} elseif { $item == "drops"} {
return [$qmon drops $classid]
} elseif { $item == "mean-qdelay" } {
set dsamp [$qmon get-class-delay-samples $classid]
if { [$dsamp cnt] > 0 } {
return [$dsamp mean]
} else {
return NaN
}
} else {
puts stderr "linkHelper: unknown stat op $item"
exit 1
}
}
linkHelper instproc integral { itype } {
$self instvar linkref_
if { $itype == "qsize" } {
set integ [$linkref_ set bytesInt_]
} elseif { $itype == "qlen" } {
set integ [$linkref_ set pktsInt_]
}

return [$integ set sum_]
}


set classMap_(tcp) Agent/TCP
set classMap_(tcp-reno) Agent/TCP/Reno
set classMap_(tcp-vegas) Agent/TCP/Vegas
set classMap_(tcp-full) Agent/TCP/FullTcp
set classMap_(fulltcp) Agent/TCP/FullTcp
set classMap_(tcp-fack) Agent/TCP/Fack
set classMap_(facktcp) Agent/TCP/Fack
set classMap_(tcp-newreno) Agent/TCP/Newreno
set classMap_(tcpnewreno) Agent/TCP/Newreno
set classMap_(cbr) Agent/CBR
set classMap_(tcp-sink) Agent/TCPSink
set classMap_(tcp-sack1) Agent/TCP/Sack1
set classMap_(sack1-tcp-sink) Agent/TCPSink/Sack1
set classMap_(tcp-sink-da) Agent/TCPSink/DelAck
set classMap_(sack1-tcp-sink-da) Agent/TCPSink/Sack1/DelAck
set classMap_(sink) Agent/TCPSink
set classMap_(delsink) Agent/TCPSink/DelAck
set classMap_(sacksink) Agent/TCPSink ; # sacksink becomes TCPSink here
set classMap_(loss-monitor) Agent/LossMonitor
set classMap_(class) CBQClass
set classMap_(ivs) Agent/IVS/Source
set classMap_(trace) Trace
set classMap_(srm) Agent/SRM

$self instvar queueMap_
set queueMap_(drop-tail) DropTail
set queueMap_(sfq) SFQ
set queueMap_(red) RED
set queueMap_(cbq) CBQ
set queueMap_(wrr-cbq) CBQ/WRR

$self trace_old_defaults

global tcl_version
if {$tcl_version < 8} {
set class_name "class"
} else {
set class_name "::class"
}
proc $class_name args {
set arglen [llength $args]
if { $arglen < 2 } {
return
}
set op [lindex $args 0]
set id [lindex $args 1]
if { $op != "create" } {
error "ns-v1 compat: malformed class operation: op $op"
return
}
eval CBQClass create $id [lrange $args 2 [expr $arglen - 1]]
}
}

OldSim instproc simplex-link-compat { n1 n2 bw delay qtype } {
set linkhelp [$self link-threeargs $n1 $n2 $qtype]
$linkhelp set bandwidth_ $bw
$linkhelp set delay_ $delay
}

OldSim instproc duplex-link-compat { n1 n2 bw delay type } {
ns simplex-link-compat $n1 $n2 $bw $delay $type
ns simplex-link-compat $n2 $n1 $bw $delay $type
}

OldSim instproc get-queues { n1 n2 } {
$self instvar link_
set n1 [$n1 id]
set n2 [$n2 id]
return "[$link_($n1:$n2) queue] [$link_($n2:$n1) queue]"
}

OldSim instproc create-agent { node type pktClass } {

$self instvar classMap_
if ![info exists classMap_($type)] {
puts stderr  "backward compat bug: need to update classMap for $type"
exit 1
}
set agent [new $classMap_($type)]
$agent set fid_ $pktClass
$self attach-agent $node $agent


return $agent
}

OldSim instproc agent { type node } {
return [$self create-agent $node $type 0]
}

OldSim instproc create-connection  { srcType srcNode sinkType sinkNode pktClass } {

set src [$self create-agent $srcNode $srcType $pktClass]
set sink [$self create-agent $sinkNode $sinkType $pktClass]
$self connect $src $sink

return $src
}

proc ns_connect { src sink } {
return [ns connect $src $sink]
}

OldSim instproc link args {
set nargs [llength $args]
set arg0 [lindex $args 0]
set arg1 [lindex $args 1]
if { $nargs == 2 } {
return [$self link-twoargs $arg0 $arg1]
} elseif { $nargs == 3 } {
return [$self link-threeargs $arg0 $arg1 [lindex $args 2]]
}
}
OldSim instproc link-twoargs { n1 n2 } {
$self instvar LH_
if ![info exists LH_($n1:$n2)] {
set LH_($n1:$n2) 1
linkHelper LH_:$n1:$n2 $n1 $n2
}
return LH_:$n1:$n2
}

OldSim instproc link-threeargs { n1 n2 qtype } {
$self simplex-link $n1 $n2 0 0 $qtype
return [$self link-twoargs $n1 $n2]
}
OldSim instproc trace {} {
return [new traceHelper]
}

OldSim instproc random { seed } {
return [ns-random $seed]
}

proc ns_simplex { n1 n2 bw delay type } {
puts stderr "ns_simplex: no backward compat"
exit 1
}

proc ns_duplex { n1 n2 bw delay type } {
ns duplex-link-compat $n1 $n2 $bw $delay $type
return [ns get-queues $n1 $n2]
}

proc ns_create_connection { srcType srcNode sinkType sinkNode pktClass } {
ns create-connection $srcType $srcNode $sinkType  $sinkNode $pktClass
}

proc ns_create_cbr { srcNode sinkNode pktSize interval fid } {
set s [ns create-connection cbr $srcNode loss-monitor  $sinkNode $fid]
$s set interval_ $interval
$s set packetSize_ $pktSize
return $s
}

proc ns_create_class { parent borrow allot maxidle notused prio depth xdelay } {
set cl [new CBQClass]
if { $prio < 8 } {
set qtype [CBQClass set def_qtype_]
set q [new Queue/$qtype]
$cl install-queue $q
}
set depth [expr $depth + 1]
if { $borrow == "none" } {
set borrowok false
} elseif { $borrow == $parent } {
set borrowok true
} else {
puts stderr "CBQ: borrowing from non-parent not supported"
exit 1
}

$cl setparams $parent $borrowok $allot $maxidle $prio $depth $xdelay
return $cl
}

proc ns_create_class1 { parent borrow allot maxidle notused prio depth xdelay Mb } {
set cl [ns_create_class $parent $borrow $allot $maxidle $notused $prio $depth $xdelay]
ns_class_maxIdle $cl $allot $maxidle $prio $Mb
return $cl
}

proc ns_class_params { cl parent borrow allot maxidle notused prio depth xdelay Mb } {
set depth [expr $depth + 1]
if { $borrow == "none" } {
set borrowok false
} elseif { $borrow == $parent } {
set borrowok true
} else {
puts stderr "CBQ: borrowing from non-parent not supported"
exit 1
}
$cl setparams $parent $borrowok $allot $maxidle $prio $depth $xdelay
ns_class_maxIdle $cl $allot $maxidle $prio $Mb
return $cl
}

proc ns_class_maxIdle { cl allot maxIdle priority Mbps } {
if { $maxIdle == "auto" } {
set g 0.9375
set n [expr 8 * $priority]
set gTOn [expr pow($g, $n)]
set first [expr ((1/$allot) - 1) * (1-$gTOn) / $gTOn ]
set second [expr (1 - $g)]
set packetsize 1000
set t [expr ($packetsize * 8)/($Mbps * 1000000) ]
if { $first > $second } {
$cl set maxidle_ [expr $t * $first]
} else {
$cl set maxidle_ [expr $t * $second]
}
} else {
$cl set maxidle_ $maxIdle
}
return $cl
}
Agent instproc connect d {
$self set dst_ $d
}

Agent/Message instproc recv msg {
$self handle $msg
}

Queue/RED proc set { var {arg ""} } {
if { $var == "queue-in-bytes_" } {
warn "Warning: use `queue_in_bytes_' rather than `queue-in-bytes_'"
set var "queue_in_bytes_"
} elseif { $var == "drop-tail_" } {
warn "Warning: use `drop_tail_' rather than `drop-tail_'"
set var "drop_tail_"
} elseif { $var == "drop-front_" } {
warn "Warning: use `drop_front_' rather than `drop-front_'"
set var "drop_front_"
} elseif { $var == "drop-rand_" } {
warn "Warning: use `drop_rand_' rather than `drop-rand_'"
set var "drop_rand_"
} elseif { $var == "ns1-compat_" } {
warn "Warning: use `ns1_compat_' rather than `ns1-compat_'"
set var "ns1_compat_"
}
eval $self next $var $arg
}

Queue/DropTail proc set { var {arg ""} } {
if { $var == "drop-front_" } {
warn "Warning: use `drop_front_' rather than `drop-front_'"
set var "drop_front_"
}
eval $self next $var $arg
}


PacketHeaderManager set hdrlen_ 0

PacketHeaderManager set tab_(Common) 1

proc add-packet-header args {
foreach cl $args {
PacketHeaderManager set tab_(PacketHeader/$cl) 1
}
}

proc add-all-packet-headers {} {
foreach cl [PacketHeader info subclass] {
PacketHeaderManager set tab_($cl) 1
}
}

proc remove-packet-header args {
foreach cl $args {
if { $cl == "Common" } {
warn "Cannot exclude common packet header."
continue
}
PacketHeaderManager unset tab_(PacketHeader/$cl)
}
}

proc remove-all-packet-headers {} {
foreach cl [PacketHeader info subclass] {
if { $cl != "PacketHeader/Common" } {
PacketHeaderManager unset tab_($cl)
}
}
}

foreach prot {
AODV
ARP
aSRM 
Common 
CtrMcast 
Diffusion
Encap
Flags
HttpInval
IMEP
IP
IPinIP 
IVS
LDP
LL
mcastCtrl
MFTP
MPLS
Mac 
Message
MIP 
Ping
RAP 
RTP
Resv 
rtProtoDV
rtProtoLS
SR
SRM 
SRMEXT
Snoop
TCP
TCPA
TFRC
TFRC_ACK
TORA
UMP 
} {
add-packet-header $prot
}

proc PktHdr_offset { hdrName {field ""} } {
set offset [$hdrName offset]
if { $field != "" } {
incr offset [$hdrName set offset_($field)]
}
return $offset
}

Simulator instproc create_packetformat { } {
PacketHeaderManager instvar tab_
set pm [new PacketHeaderManager]
foreach cl [PacketHeader info subclass] {
if [info exists tab_($cl)] {
set off [$pm allochdr $cl]
$cl offset $off
}
}
$self set packetManager_ $pm
}

PacketHeaderManager instproc allochdr cl {
set size [$cl set hdrlen_]

$self instvar hdrlen_
set NS_ALIGN 8
set incr [expr ($size + ($NS_ALIGN-1)) & ~($NS_ALIGN-1)]
set base $hdrlen_
incr hdrlen_ $incr

return $base
}









Class CBQLink -superclass SimpleLink
CBQLink instproc init { src dst bw delay q cl {lltype "DelayLink"} } {
$self next $src $dst $bw $delay $q $lltype ; # SimpleLink ctor
$self instvar head_ queue_ link_
$self instvar  classifier_	; # not found in a SimpleLink

$queue_ link $link_ ; # queue_ set by SimpleLink ctor, CBQ needs $link_
set classifier_ $cl
$head_ target $classifier_

set defalg [Queue/CBQ set algorithm_]
$queue_ set algorithm_ $defalg
$queue_ algorithm $defalg
}




CBQLink instproc classifier {} {
$self instvar classifier_
return $classifier_
}

CBQLink instproc bind args {

$self instvar classifier_
set nargs [llength $args]
set cbqcl [lindex $args 0]
set a [lindex $args 1]
if { $nargs == 3 } {
set b [lindex $args 2]
} else {
set b $a
}
while { $a <= $b } {
set slot [$classifier_ installNext $cbqcl]
$classifier_ set-hash auto 0 0 $a $slot
incr a
}
}

CBQLink instproc insert args {
$self instvar queue_ drophead_ link_
set nargs [llength $args]
set cbqcl [lindex $args 0]
set qdisc [$cbqcl qdisc]
if { $nargs == 1 } {
set qmon [new QueueMonitor]
} else {
set qmon [lindex $args 1]
}


if { $qmon == "" } {
error "CBQ requires a q-monitor for class $cbqcl"
}
if { $qdisc != "" } {
set in [new SnoopQueue/In]
set out [new SnoopQueue/Out]
set drop [new SnoopQueue/Drop]
$in set-monitor $qmon
$out set-monitor $qmon
$drop set-monitor $qmon

$in target $qdisc
$cbqcl target $in

$qdisc drop-target $drop
$drop target $drophead_

$qdisc target $out
$out target $queue_
$cbqcl qmon $qmon
}


$cbqcl instvar maxidle_

if { $maxidle_ == "auto" } {
$cbqcl automaxidle [$link_ set bandwidth_]  [$queue_ set maxpkt_]
set maxidle_ [$cbqcl set maxidle_]
}
$cbqcl maxidle $maxidle_

$queue_ insert-class $cbqcl
}

CBQClass instproc init {} {
$self next
$self instvar automaxidle_gain_
set automaxidle_gain_ [$class set automaxidle_gain_]
}

CBQClass instproc automaxidle { linkbw maxpkt } {
$self instvar automaxidle_gain_ maxidle_
$self instvar priority_


set allot [$self allot]


set g $automaxidle_gain_
set n [expr 8 * $priority_]

if { $g == 0 || $allot == 0 || $linkbw == 0 } {
set maxidle_ 0.0
return
}
set gTOn [expr pow($g, $n)]
set first [expr ((1/$allot) - 1) * (1-$gTOn) / $gTOn ]
set second [expr (1 - $g)]
set t [expr ($maxpkt * 8.0)/$linkbw]
if { $first > $second } {
set maxidle_ [expr $t * $first]
} else {
set maxidle_ [expr $t * $second]
}
return $maxidle_
}


CBQClass instproc setparams { parent okborrow allot maxidle prio level xdelay } {

$self allot $allot
$self parent $parent

$self set okborrow_ $okborrow
$self set maxidle_ $maxidle
$self set priority_ $prio
$self set level_ $level
$self set extradelay_ $xdelay

return $self
}


CBQClass instproc install-queue q {
$q set blocked_ true
$q set unblock_on_resume_ false
$self qdisc $q
}


QueueMonitor instproc reset {} {
$self instvar size_ pkts_
$self instvar parrivals_ barrivals_
$self instvar pdepartures_ bdepartures_
$self instvar pdrops_ bdrops_

set parrivals_ 0
set barrivals_ 0
set pdepartures_ 0
set bdepartures_ 0
set pdrops_ 0
set bdrops_ 0

set bint [$self get-bytes-integrator]
if { $bint != "" } {
$bint reset
}

set pint [$self get-pkts-integrator]
if { $pint != "" } {
$pint reset
}

set samp [$self get-delay-samples]
if { $samp != "" } {
$samp reset
}
}

QueueMonitor/ED instproc reset {} {
$self next
$self instvar epdrops_ ebdrops_
set epdrops_ 0
set ebdrops_ 0
}

Class AckReconsClass -superclass Agent

AckReconsControllerClass instproc demux { src dst } {
$self instvar reconslist_ queue_
set addr $src:$dst
if { ![info exists reconslist_($addr)] } {
set recons [new Agent/AckReconsClass $src $dst]
$recons target $queue_
set reconslist_($addr) $recons
}
return $reconslist_($addr)
}



Agent/AckReconsClass instproc spacing { ack } {
$self instvar ackInterArr_ ackSpacing_ delack_  lastAck_ lastRealAck_ lastRealTime_ adaptive_ size_
global ns

set deltaTime [expr [$ns now] - $lastRealTime_]
set deltaAck [expr $ack - $lastAck_]
if {$adaptive_} {
set bw [expr $deltaAck*$size_/$deltaTime]
set ackSpacing_ $ackInterArr_
if { $deltaAck > 0 } {
}
} else {
set deltaT [expr $deltaTime / ($deltaAck/$delack_ +1)]
set ackSpacing_ $deltaT
}
}

Agent/AckReconsClass instproc ackbw {ack time} {
$self instvar ackInterArr_ lastRealTime_ lastRealAck_ alpha_

set sample [expr $time - $lastRealTime_]
set ackInterArr_ [expr $alpha_*$sample + (1-$alpha_)*$ackInterArr_]
}

Class Classifier/Hash/Fid/FQ -superclass Classifier/Hash/Fid

Classifier/Hash/Fid/FQ instproc unknown-flow { src dst fid } {
$self instvar fq_
$fq_ new-flow $src $dst $fid
}

Class FQLink -superclass SimpleLink

FQLink instproc init { src dst bw delay q } {
$self next $src $dst $bw $delay $q
$self instvar link_ queue_ head_ toNode_ ttl_ classifier_  nactive_ 
$self instvar drophead_		;# idea stolen from CBQ and Kevin

set nactive_ 0

set classifier_ [new Classifier/Hash/Fid/FQ 33]
$classifier_ set fq_ $self

$head_ target $classifier_


$queue_ set secsPerByte_ [expr 8.0 / [$link_ set bandwidth_]]
}
FQLink instproc new-flow { src dst fid } {
$self instvar classifier_ nactive_ queue_ link_ drpT_
incr nactive_

set type [$class set queueManagement_]
set q [new Queue/$type]

if { $type == "RED" } {
set bw [$link_ set bandwidth_]
$q set ptc_ [expr $bw / (8. * [$q set mean_pktsize_])]
}
$q drop-target $drpT_

set slot [$classifier_ installNext $q]
$classifier_ set-hash auto $src $dst $fid $slot
$q target $queue_
$queue_ install $fid $q
}
FQLink instproc up? { } {
return up
}













Queue instproc attach-nam-traces {src dst file} {


$self attach-traces $src $dst $file "nam"
}

Queue instproc attach-traces {src dst file {op ""}} {
}


Queue/RED instproc attach-traces {src dst file {op ""}} {

set ns [Simulator instance]
set type [$self trace-type]

if {$op == "nam"} {
set type "Drop"
}

set newtrace [$ns create-trace $type $file $src $dst $op]

set oldTrace [$self edrop-trace]
if {$oldTrace!=0} {
$newtrace target $oldTrace
} else {
$newtrace target [$ns set nullAgent_]
}

$self edrop-trace $newtrace
}










Trace instproc init type {
$self next $type
$self instvar type_
set type_ $type
}

Trace instproc format args {

$self instvar type_ fp_ src_ dst_

if [info exists fp_] {
set ns [Simulator instance]
puts $fp_ [eval list $type_ [$ns now] [eval concat $args]]
}
}

Trace instproc attach fp {
$self instvar fp_

set fp_ $fp
$self cmd attach $fp_
}

Class Trace/Hop -superclass Trace
Trace/Hop instproc init {} {
$self next "h"
}

Class Trace/Enque -superclass Trace
Trace/Enque instproc init {} {
$self next "+"
}

Trace/Deque instproc init {} {
$self next "-"
}

Class Trace/EDrop -superclass Trace
Trace/EDrop instproc init {} {
$self next "e"
}

Class Trace/MEDrop -superclass Trace
Trace/MEDrop instproc init {} {
$self next "m"
}


Class Trace/SessEnque -superclass Trace
Trace/SessEnque instproc init {} {
$self next "E"	;# Should use '='? :)
}

Class Trace/SessDeque -superclass Trace
Trace/SessDeque instproc init {} {
$self next "D"	;# Should use '_'?
}

Class Trace/Recv -superclass Trace 
Trace/Recv instproc init {} {
$self next "r"
}

Class Trace/Drop -superclass Trace
Trace/Drop instproc init {} {
$self next "d"
}

Class Trace/Generic -superclass Trace
Trace/Generic instproc init {} {
$self next "v"
}

Class Trace/Var -superclass Trace
Trace/Var instproc init {} {
$self next "f"
}

proc f-time t {
format "%7.4f" $t
}

proc f-node n {
set node [expr $n >> 8]
set port [expr $n & 0xff]
return "$node.$port"
}

proc gc o {
set ret "NULL_OBJECT"
if { $o != "" } {
set ret ""
foreach i $o {
if ![catch "$i info class" val] {
lappend ret $val
}
}
}
set ret
}

Node instproc tn {} {
$self instvar id_
return "${self}(id $id_)"
}

Simulator instproc gen-map {} {

$self instvar Node_ link_ MobileNode_

set nn [Node set nn_]
for {set i 0} {$i < $nn} {incr i} {
if ![info exists Node_($i)] {
continue
}
puts "Node [$n tn]"
foreach nc [$n info vars] {
switch $nc {
ns_		continue
id_		continue
neighbor_	continue
agents_		continue
routes_		continue
np_		continue
default {
if [$n array exists $nc] {
puts "\t\t$nc\t[$n array get $nc]"
} else {
set v [$n set $nc]
puts "\t\t$nc${v}([gc $v])"
}
}
}
}
if {[llength [$n set agents_]] > 0} {
puts "\n\tAgents at node (possibly in order of creation):"
foreach a [$n set agents_] {
puts "\t\t$a\t[gc $a]\t\tdst-addr/port: [$a set dst_addr_]/[$a set dst_port_]"
}
}
puts ""
foreach li [array names link_ [$n id]:*] {
set L [split $li :]
set nbr [[$self get-node-by-id [lindex $L 1]] entry]
set ln $link_($li)
puts "\tLink $ln, fromNode_ [[$ln set fromNode_] tn] -> toNode_ [[$ln set toNode_] tn]"
puts "\tComponents (in order) head first"
for {set c [$ln head]} {$c != $nbr} {set c [$c target]} {
puts "\t\t$c\t[gc $c]"
}
}
puts "---"
}
}



Simulator instproc maybeEnableTraceAll {obj args} {
foreach {file tag} {
traceAllFile_           {}
namtraceAllFile_        nam
} {
$self instvar $file
if [info exists $file] {
$obj trace [set $file] $args $tag
}
}
}

proc exponential {args} {
global defaultRNG
eval [list $defaultRNG exponential] $args
}

proc uniform {args} {
global defaultRNG
eval [list $defaultRNG uniform] $args
}

proc integer {args} {
global defaultRNG
eval [list $defaultRNG integer] $args
}

RNG instproc init {} {
$self next
$self instvar z2
set z2 0
}

RNG instproc uniform {a b} {
expr $a + (($b - $a) * ([$self next-random] * 1.0 / 0x7fffffff))
}

RNG instproc integer k {
expr [$self next-random] % abs($k)
}

RNG instproc exponential {{mu 1.0}} {
expr - $mu * log(([$self next-random] + 1.0) / (0x7fffffff + 1.0))
}



RandomVariable instproc test count {
for {set i 0} {$i < $count} {incr i} {
puts stdout [$self value]
}
}


set defaultRNG [new RNG]
$defaultRNG seed 1
$defaultRNG default
trace variable defaultRNG w { abort "cannot update defaultRNG once assigned"; }


Class RandomVariable/TraceDriven -superclass RandomVariable

RandomVariable/TraceDriven instproc init {} {
$self instvar filename_ file_
}

RandomVariable/TraceDriven instproc value {} {
$self instvar file_ filename_

if ![info exist file_] {
if [info exist filename_] {
set file_ [open $filename_ r]
} else {
puts "RandomVariable/TraceDriven: Filename is not given"
exit 0
}
}

if ![eof $file_] {
gets $file_ tmp
return $tmp
} else {
close $file_
puts "Error: RandomVariable/TraceDriven: Reached the end of the trace fi
le "
exit 0
}
}


Agent instproc set args {
if { [lindex $args 0] == "dst_" } {
puts "Warning dst_ is no longer being supported in NS. $args"
puts "Use dst_addr_ and dst_port_ instead"
$self instvar dst_addr_ dst_port_
set addr [lindex $args 1]
set baseAddr [Simulator set McastBaseAddr_]
if { $addr >= $baseAddr } {
$self set dst_addr_ $addr
$self set dst_port_ 0
} else {
$self set dst_addr_ [expr ($addr >> 8) ]
$self set dst_port_ [expr ($addr % 256) ]
exit
}
return
}
eval $self next $args
}

Agent instproc port {} {
$self instvar agent_port_
return $agent_port_
}

Agent instproc dst-port {} {
$self instvar dst_port_
return [expr $dst_port_]
}

Agent instproc attach-source {s_type} {
set source [new Source/$s_type]
$source attach $self
$self set type_ $s_type
return $source
}

Agent instproc attach-app {s_type} {
set app_ [new Application/$s_type]
$app_ attach-agent $self
$self set type_ $s_type
return $app_
}

Agent instproc attach-tbf { tbf } {
$tbf target [$self target]
$self target $tbf

}


Class Agent/Null -superclass Agent

Agent/Null instproc init args {
eval $self next $args
}

Agent/LossMonitor instproc log-loss {} {
}

Agent/CBR/UDP/SA instproc attach-tbf { tbf } {
$tbf target [$self target]
$self target $tbf
$self ctrl-target [$tbf target]
}


Agent proc set-maxttl {objectOrClass var} {
if { [catch "$objectOrClass set $var" value] ||	 ($value < [Agent set ttl_]) } {
$objectOrClass set $var [Agent set ttl_]
}
$objectOrClass set $var
}


Agent/TCP/FullTcp/Tahoe instproc init {} {
$self next
$self instvar reno_fastrecov_
set reno_fastrecov_ false
}

Agent/TCP/FullTcp/Sack instproc init {} {
$self next
$self instvar reno_fastrecov_ maxburst_ open_cwnd_on_pack_
set reno_fastrecov_ false
set maxburst_ 5
set open_cwnd_on_pack_ false
}

Agent/TCP/FullTcp/Newreno instproc init {} {
$self next
$self instvar open_cwnd_on_pack_
set open_cwnd_on_pack_ false
}


Agent/TORA instproc init args {

$self next $args
}       

Agent/TORA set sport_	0
Agent/TORA set dport_	0

Agent/AODV instproc init args {

$self next $args
}

Agent/AODV set sport_   0
Agent/AODV set dport_   0










RouteLogic instproc register {proto args} {
$self instvar rtprotos_ node_rtprotos_ default_node_rtprotos_
if [info exists rtprotos_($proto)] {
eval lappend rtprotos_($proto) $args
} else {
set rtprotos_($proto) $args
}
if { [Agent/rtProto/$proto info procs pre-init-all] != "" } {
Agent/rtProto/$proto pre-init-all $args
}
}

RouteLogic instproc configure {} {
$self instvar rtprotos_
if [info exists rtprotos_] {
foreach proto [array names rtprotos_] {
eval Agent/rtProto/$proto init-all $rtprotos_($proto)
}
} else {
Agent/rtProto/Static init-all
}
}

RouteLogic instproc lookup { nodeid destid } {
if { $nodeid == $destid } {
return $nodeid
}

set ns [Simulator instance]
set node [$ns get-node-by-id $nodeid]

if [Simulator set EnableHierRt_] {
set dest [$ns get-node-by-id $destid]
set nh [$self hier-lookup [$node node-addr] [$dest node-addr]]
return [$ns get-node-id-by-addr $nh]
}
set rtobj [$node rtObject?]
if { $rtobj != "" } {
$rtobj lookup [$ns get-node-by-id $destid]
} else {
$self cmd lookup $nodeid $destid
} 
}

RouteLogic instproc notify {} {
$self instvar rtprotos_
foreach i [array names rtprotos_] {
Agent/rtProto/$i compute-all
}

foreach i [CtrMcastComp info instances] {
$i notify
}
if { [rtObject info instances] == ""} {
foreach node [[Simulator instance] all-nodes-list] {
$node notify-mcast 0
}
}
}

RouteLogic instproc append-addr {level addrstr} {
if {$level != 0} {
set str [lindex $addrstr 0]
for {set i 1} {$i < $level} {incr i} {
append str . [lindex $addrstr [expr $i]]
}
return $str
}
}

RouteLogic instproc dump nn {
set i 0
while { $i < $nn } {
set j 0
while { $j < $nn } {
puts "$i -> $j via [$self lookup $i $j]"
incr j
}
incr i
}
}

Simulator instproc rtproto {proto args} {
$self instvar routingTable_
if {$proto == "Algorithmic"} {
set routingTable_ [new RouteLogic/Algorithmic]
}
eval [$self get-routelogic] register $proto $args
}

Simulator instproc get-routelogic {} {
$self instvar routingTable_
if ![info exists routingTable_] {
set routingTable_ [new RouteLogic]
}
return $routingTable_
}

Simulator instproc dump-routelogic-nh {} {
$self instvar routingTable_ Node_ link_
if ![info exists routingTable_] {
puts "error: routing table is not computed yet!"
return 0
}

puts "Dumping Routing Table: Next Hop Information"
set n [Node set nn_]
set i 0
puts -nonewline "\t"
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
puts -nonewline "$i\t"
incr i
}
set i 0
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
puts -nonewline "\n$i\t"
set n1 $Node_($i)
set j 0
while { $j < $n } {
if { $i != $j } {
set nh [$routingTable_ lookup $i $j]
if { $nh >= 0 } {
puts -nonewline "$nh\t"
}
} else {
puts -nonewline "--\t"
}
incr j
}
incr i
}
puts ""
}

Simulator instproc dump-routelogic-distance {} {
$self instvar routingTable_ Node_ link_
if ![info exists routingTable_] {
puts "error: routing table is not computed yet!"
return 0
}

set n [Node set nn_]
set i 0
puts -nonewline "\t"
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
puts -nonewline "$i\t"
incr i
}

set i 0
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
puts -nonewline "\n$i\t"
set n1 $Node_($i)
set j 0
while { $j < $n } {
if { $i != $j } {
set nh [$routingTable_ lookup $i $j]
if { $nh >= 0 } {
set distance 0
set tmpfrom $i
set tmpto $j
while {$tmpfrom != $tmpto} {
set tmpnext [$routingTable_ lookup $tmpfrom $tmpto]
set distance [expr $distance + [$link_($tmpfrom:$tmpnext) cost?]]
set tmpfrom $tmpnext
}
puts -nonewline "$distance\t"
} else {
puts -nonewline "0\t"
}
} else {
puts -nonewline "0\t"
}
incr j
}
incr i
}
puts ""
}

Simulator instproc compute-routes {} {
if [Simulator set EnableHierRt_] {
$self compute-hier-routes 
} else {
$self compute-flat-routes
}
}

Simulator instproc compute-flat-routes {} {
$self instvar Node_ link_
set r [$self get-routelogic]
foreach ln [array names link_] {
set L [split $ln :]
set srcID [lindex $L 0]
set dstID [lindex $L 1]
if { [$link_($ln) up?] == "up" } {
$r insert $srcID $dstID [$link_($ln) cost?]
} else {
$r reset $srcID $dstID
}
}
$r compute
set i 0
set n [Node set nn_]
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
set n1 $Node_($i)
set j 0
while { $j < $n } {
if { $i != $j } {
set nh [$r lookup $i $j]
if { $nh >= 0 } {
$n1 add-route $j [$link_($i:$nh) head]
}
} 
incr j
}
incr i
}
}

Simulator instproc hier-topo {rl} {
AddrParams instvar domain_num_ cluster_num_ nodes_num_ hlevel_

if ![info exists cluster_num_] {
if {$hlevel_ > 1} {
set def [AddrParams set def_clusters]
puts "Default value for cluster_num set to $def\n"
for {set i 0} {$i < $domain_num_} {incr i} {
lappend clusters $def
}
} else {
puts stderr "hierarchy level = 1; should use flat-rtg instead of hier-rtg" 
exit 1
}
AddrParams set cluster_num_ $clusters
}

if ![info exists nodes_num_ ] {
set total_node 0
set def [AddrParams set def_nodes]
puts "Default value for nodes_num set to $def\n"
for {set i 0} {$i < $domain_num_} {incr i} {
set total_node [expr $total_node +  [lindex $clusters $i]]
}
for {set i 0} {$i < $total_node} {incr i} {
lappend nodes $def
}
AddrParams set nodes_num_ $nodes
}
eval $rl send-num-of-domains $domain_num_
eval $rl send-num-of-clusters $cluster_num_
eval $rl send-num-of-nodes $nodes_num_
}

Simulator instproc compute-hier-routes {} {
$self instvar Node_ link_
set r [$self get-routelogic]
if ![info exists link_] {
return
}
set level [AddrParams set hlevel_]
$r hlevel-is $level
$self hier-topo $r
foreach ln [array names link_] {
set L [split $ln :]
set srcID [[$self get-node-by-id [lindex $L 0]] node-addr]
set dstID [[$self get-node-by-id [lindex $L 1]] node-addr]
if { [$link_($ln) up?] == "up" } {
$r hier-insert $srcID $dstID [$link_($ln) cost?]
} else {
$r hier-reset $srcID $dstID
}
}
$r hier-compute
set n [Node set nn_]
for {set i 0} {$i < $n} {incr i} {
if ![info exists Node_($i)] {
continue
}
set n1 $Node_($i)
set addr [$n1 node-addr]
set L [$n1 split-addrstr $addr]
for {set k 0} {$k < $level} {incr k} {
set csize [AddrParams elements-in-level? $addr $k]
if {$k > 0} {
set prefix [$r append-addr $k $L]
}
for {set m 0} {$m < $csize} {incr m} {
if { $m == [lindex $L $k]} {
continue
}
if {$k > 0} {
set str $prefix
append str . $m
} else {
set str $m
}
set nh [$r hier-lookup $addr $str]
if {$nh == -1} { 
continue
}
set node [$self get-node-id-by-addr $nh]
if { $node >= 0 } {
$n1 add-hroute $str  [$link_($i:$node) head]
}
}
}
}
}




set rtglibRNG [new RNG]
$rtglibRNG seed 1

Class rtObject

rtObject set unreach_ -1
rtObject set maxpref_   255

rtObject proc init-all args {
foreach node $args {
if { [$node rtObject?] == "" } {
set rtobj($node) [new rtObject $node]
}
}
foreach node $args {	;# XXX
$rtobj($node) compute-routes
}
}

rtObject instproc init node {
$self next
$self instvar ns_ nullAgent_
$self instvar nextHop_ rtpref_ metric_ node_ rtVia_ rtProtos_

set ns_ [Simulator instance]
set nullAgent_ [$ns_ set nullAgent_]

$node init-routing $self
set node_ $node
foreach dest [$ns_ all-nodes-list] {
set nextHop_($dest) ""
if {$node == $dest} {
set rtpref_($dest) 0
set metric_($dest) 0
set rtVia_($dest) "Agent/rtProto/Local" ;# make dump happy
} else {
set rtpref_($dest) [$class set maxpref_]
set metric_($dest) [$class set unreach_]
set rtVia_($dest)    ""
$node add-route [$dest id] $nullAgent_
}
}
$self add-proto Direct $node
$rtProtos_(Direct) compute-routes
}

rtObject instproc add-proto {proto node} {
$self instvar ns_ rtProtos_
set rtProtos_($proto) [new Agent/rtProto/$proto $node]
$ns_ attach-agent $node $rtProtos_($proto)
set rtProtos_($proto)
}

rtObject instproc lookup dest {
$self instvar nextHop_ node_
if {![info exists nextHop_($dest)] || $nextHop_($dest) == ""} {
return -1
} else {
return [[$nextHop_($dest) set toNode_] id]
}
}

rtObject instproc compute-routes {} {
$self instvar ns_ node_ rtProtos_ nullAgent_
$self instvar nextHop_ rtpref_ metric_ rtVia_
set protos ""
set changes 0
foreach p [array names rtProtos_] {
if [$rtProtos_($p) set rtsChanged_] {
incr changes
$rtProtos_($p) set rtsChanged_ 0
}
lappend protos $rtProtos_($p)
}
if !$changes return

set changes 0
foreach dst [$ns_ all-nodes-list] {
if {$dst == $node_} continue
set nh ""
set pf [$class set maxpref_]
set mt [$class set unreach_]
set rv ""
foreach p $protos {
set pnh [$p set nextHop_($dst)]
if { $pnh == "" } continue

set ppf [$p set rtpref_($dst)]
set pmt [$p set metric_($dst)]
if {$ppf < $pf || ($ppf == $pf && $pmt < $mt) || $mt < 0} {
set nh  $pnh
set pf  $ppf
set mt  $pmt
set rv  $p
}
}
if { $nh == "" } {
if { $nextHop_($dst) != "" } {
$node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
set nextHop_($dst) $nh
set rtpref_($dst)  $pf
set metric_($dst)  $mt
set rtVia_($dst)   $rv
incr changes
}
} else {
if { $rv == $rtVia_($dst) } {
if { $nh != $nextHop_($dst) } {
$node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
set nextHop_($dst) $nh
$node_ add-routes [$dst id] $nextHop_($dst)
incr changes
}
if { $mt != $metric_($dst) } {
set metric_($dst) $mt
incr changes
}
if { $pf != $rtpref_($dst) } {
set rtpref_($dst) $pf
}
} else {
if { $rtVia_($dst) != "" } {
set nextHop_($dst) [$rtVia_($dst) set nextHop_($dst)]
set rtpref_($dst)  [$rtVia_($dst) set rtpref_($dst)]
set metric_($dst)  [$rtVia_($dst) set metric_($dst)]
}
if {$rtpref_($dst) != $pf || $metric_($dst) != $mt} {
$node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
set nextHop_($dst) $nh
set rtpref_($dst)  $pf
set metric_($dst)  $mt
set rtVia_($dst)   $rv
$node_ add-routes [$dst id] $nextHop_($dst)
incr changes
}
}
}
}
foreach proto [array names rtProtos_] {
$rtProtos_($proto) send-updates $changes
}
$self flag-multicast $changes
}

rtObject instproc flag-multicast changes {
$self instvar node_
$node_ notify-mcast $changes
}

rtObject instproc intf-changed {} {
$self instvar ns_ node_ rtProtos_ rtVia_ nextHop_ rtpref_ metric_
foreach p [array names rtProtos_] {
$rtProtos_($p) intf-changed
$rtProtos_($p) compute-routes
}
$self compute-routes
}

rtObject instproc dump-routes chan {
$self instvar ns_ node_ nextHop_ rtpref_ metric_ rtVia_


if {$ns_ != ""} {
set time [$ns_ now]
} else {
set time 0.0
}
puts $chan [concat "Node:\t${node_}([$node_ id])\tat t ="		 [format "%4.2f" $time]]
puts $chan "  Dest\t\t nextHop\tPref\tMetric\tProto"
foreach dest [lsort -command SplitObjectCompare [$ns_ all-nodes-list]] {
if {[llength $nextHop_($dest)] > 1} {
set p [split [$rtVia_($dest) info class] /]
set proto [lindex $p [expr [llength $p] - 1]]
foreach rt $nextHop_($dest) {
puts $chan [format "%-5s(%d)\t%-5s(%d)\t%3d\t%4d\t %s"	  $dest [$dest id] $rt [[$rt set toNode_] id]	  $rtpref_($dest) $metric_($dest) $proto]
}
} elseif {$nextHop_($dest) != ""} {
set p [split [$rtVia_($dest) info class] /]
set proto [lindex $p [expr [llength $p] - 1]]
puts $chan [format "%-5s(%d)\t%-5s(%d)\t%3d\t%4d\t %s"	  $dest [$dest id]					  $nextHop_($dest) [[$nextHop_($dest) set toNode_] id]  $rtpref_($dest) $metric_($dest) $proto]
} elseif {$dest == $node_} {
puts $chan [format "%-5s(%d)\t%-5s(%d)\t%03d\t%4d\t %s"	 $dest [$dest id] $dest [$dest id] 0 0 "Local"]
} else {
puts $chan [format "%-5s(%d)\t%-5s(%s)\t%03d\t%4d\t %s"	 $dest [$dest id] "" "-" 255 32 "Unknown"]
}
}
}

rtObject instproc rtProto? proto {
$self instvar rtProtos_
if [info exists rtProtos_($proto)] {
return $rtProtos_($proto)
} else {
return ""
}
}

rtObject instproc nextHop? dest {
$self instvar nextHop_
$self set nextHop_($dest)
}

rtObject instproc rtpref? dest {
$self instvar rtpref_
$self set rtpref_($dest)
}

rtObject instproc metric? dest {
$self instvar metric_
$self set metric_($dest)
}

Class rtPeer

rtPeer instproc init {addr port cls} {
$self next
$self instvar addr_ port_ metric_ rtpref_
set addr_ $addr
set port_ $port
foreach dest [[Simulator instance] all-nodes-list] {
set metric_($dest) [$cls set INFINITY]
set rtpref_($dest) [$cls set preference_]
}
}

rtPeer instproc addr? {} {
$self instvar addr_
return $addr_
}

rtPeer instproc port? {} {
$self instvar port_
return $port_
}

rtPeer instproc metric {dest val} {
$self instvar metric_
set metric_($dest) $val
}

rtPeer instproc metric? dest {
$self instvar metric_
return $metric_($dest)
}

rtPeer instproc preference {dest val} {
$self instvar rtpref_
set rtpref_($dest) $val
}

rtPeer instproc preference? dest {
$self instvar rtpref_
return $rtpref_($dest)
}


Agent/rtProto proc pre-init-all args {
}

Agent/rtProto proc init-all args {
error "No initialization defined"
}

Agent/rtProto instproc init node {
$self next

$self instvar ns_ node_ rtObject_ preference_ ifs_ ifstat_
set ns_ [Simulator instance]

catch "set preference_ [[$self info class] set preference_]" ret
if { $ret == "" } {
set preference_ [$class set preference_]
}
foreach nbr [$node set neighbor_] {
set link [$ns_ link $node $nbr]
set ifs_($nbr) $link
set ifstat_($nbr) [$link up?]
}
set rtObject_ [$node rtObject?]
}

Agent/rtProto instproc compute-routes {} {
error "No route computation defined"
}

Agent/rtProto instproc intf-changed {} {
}

Agent/rtProto instproc send-updates args {
}

Agent/rtProto proc compute-all {} {
}

Class Agent/rtProto/Static -superclass Agent/rtProto

Agent/rtProto/Static proc init-all args {
[Simulator instance] compute-routes
}

Class Agent/rtProto/Session -superclass Agent/rtProto

Agent/rtProto/Session proc init-all args {
[Simulator instance] compute-routes
}

Agent/rtProto/Session proc compute-all {} {
[Simulator instance] compute-routes
}

Class Agent/rtProto/Direct -superclass Agent/rtProto
Agent/rtProto/Direct instproc init node {
$self next $node
$self instvar ns_ rtpref_ nextHop_ metric_ ifs_

foreach node [$ns_ all-nodes-list] {
set rtpref_($node) 255
set nextHop_($node) ""
set metric_($node) -1
}
foreach node [array names ifs_] {
set rtpref_($node) [$class set preference_]
}
}

Agent/rtProto/Direct instproc compute-routes {} {
$self instvar ifs_ ifstat_ nextHop_ metric_ rtsChanged_
set rtsChanged_ 0
foreach nbr [array names ifs_] {
if {$nextHop_($nbr) == "" && [$ifs_($nbr) up?] == "up"} {
set ifstat_($nbr) 1
set nextHop_($nbr) $ifs_($nbr)
set metric_($nbr) [$ifs_($nbr) cost?]
incr rtsChanged_
} elseif {$nextHop_($nbr) != "" && [$ifs_($nbr) up?] != "up"} {
set ifstat_($nbr) 0
set nextHop_($nbr) ""
set metric_($nbr) -1
incr rtsChanged_
}
}
}

Agent/rtProto/DV set UNREACHABLE	[rtObject set unreach_]
Agent/rtProto/DV set mid_		  0

Agent/rtProto/DV proc init-all args {
if { [llength $args] == 0 } {
set nodeslist [[Simulator instance] all-nodes-list]
} else {
eval "set nodeslist $args"
}
Agent set-maxttl Agent/rtProto/DV INFINITY
eval rtObject init-all $nodeslist
foreach node $nodeslist {
set proto($node) [[$node rtObject?] add-proto DV $node]
}
foreach node $nodeslist {
foreach nbr [$node neighbors] {
set rtobj [$nbr rtObject?]
if { $rtobj != "" } {
set rtproto [$rtobj rtProto? DV]
if { $rtproto != "" } {
$proto($node) add-peer $nbr [$rtproto set agent_addr_] [$rtproto set agent_port_]
}
}
}
}
}

Agent/rtProto/DV instproc init node {
global rtglibRNG

$self next $node
$self instvar ns_ rtObject_ ifsUp_
$self instvar preference_ rtpref_ nextHop_ nextHopPeer_ metric_ multiPath_

set UNREACHABLE [$class set UNREACHABLE]
foreach dest [$ns_ all-nodes-list] {
set rtpref_($dest) $preference_
set nextHop_($dest) ""
set nextHopPeer_($dest) ""
set metric_($dest)  $UNREACHABLE
}
set ifsUp_ ""
set multiPath_ [[$rtObject_ set node_] set multiPath_]
set updateTime [$rtglibRNG uniform 0.0 0.5]
$ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/DV instproc add-peer {nbr agentAddr agentPort} {
$self instvar peers_
$self set peers_($nbr) [new rtPeer $agentAddr $agentPort $class]
}

Agent/rtProto/DV instproc send-periodic-update {} {
global rtglibRNG

$self instvar ns_
$self send-updates 1	;# Anything but 0
set updateTime [expr [$ns_ now] +  ([$class set advertInterval] * [$rtglibRNG uniform 0.9 1.1])]
$ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/DV instproc compute-routes {} {
$self instvar ns_ ifs_ rtpref_ metric_ nextHop_ nextHopPeer_
$self instvar peers_ rtsChanged_ multiPath_

set INFINITY [$class set INFINITY]
set MAXPREF  [rtObject set maxpref_]
set UNREACH	 [rtObject set unreach_]
set rtsChanged_ 0
foreach dst [$ns_ all-nodes-list] {
set p [lindex $nextHopPeer_($dst) 0]
if {$p != ""} {
set metric_($dst) [$p metric? $dst]
set rtpref_($dst) [$p preference? $dst]
}

set pf $MAXPREF
set mt $INFINITY
set nh(0) 0
foreach nbr [array names peers_] {
set pmt [$peers_($nbr) metric? $dst]
set ppf [$peers_($nbr) preference? $dst]


if { $pmt < 0 || $pmt >= $INFINITY || $ppf > $pf || $pmt > $mt }  continue
if { $ppf < $pf || $pmt < $mt } {
set pf $ppf
set mt $pmt
unset nh	;# because we must compute *new* next hops
}
set nh($ifs_($nbr)) $peers_($nbr)
}
catch "unset nh(0)"
if { $pf == $MAXPREF && $mt == $INFINITY } continue
if { $pf > $rtpref_($dst) ||				 ($metric_($dst) >= 0 && $mt > $metric_($dst)) }	 continue
if {$mt >= $INFINITY} {
set mt $UNREACH
}

incr rtsChanged_
if { $pf < $rtpref_($dst) || $mt < $metric_($dst) } {
set rtpref_($dst) $pf
set metric_($dst) $mt
set nextHop_($dst) ""
set nextHopPeer_($dst) ""
foreach n [array names nh] {
lappend nextHop_($dst) $n
lappend nextHopPeer_($dst) $nh($n)
if !$multiPath_ break;
}
continue
}

set rtpref_($dst) $pf
set metric_($dst) $mt
set newNextHop ""
set newNextHopPeer ""
foreach rt $nextHop_($dst) {
if [info exists nh($rt)] {
lappend newNextHop $rt
lappend newNextHopPeer $nh($rt)
unset nh($rt)
}
}
set nextHop_($dst) $newNextHop
set nextHopPeer_($dst) $newNextHopPeer
if { $multiPath_ || $nextHop_($dst) == "" } {
foreach rt [array names nh] {
lappend nextHop_($dst) $rt
lappend nextHopPeer_($dst) $nh($rt)
if !$multiPath_ break
}
}
}
set rtsChanged_
}

Agent/rtProto/DV instproc intf-changed {} {
$self instvar ns_ peers_ ifs_ ifstat_ ifsUp_ nextHop_ nextHopPeer_ metric_
set INFINITY [$class set INFINITY]
set ifsUp_ ""
foreach nbr [array names peers_] {
set state [$ifs_($nbr) up?]
if {$state != $ifstat_($nbr)} {
set ifstat_($nbr) $state
if {$state != "up"} {
if ![info exists all-nodes] {
set all-nodes [$ns_ all-nodes-list]
}
foreach dest ${all-nodes} {
$peers_($nbr) metric $dest $INFINITY
}
} else {
lappend ifsUp_ $nbr
}
}
}
}

Agent/rtProto/DV proc get-next-mid {} {
set ret [Agent/rtProto/DV set mid_]
Agent/rtProto/DV set mid_ [expr $ret + 1]
set ret
}

Agent/rtProto/DV proc retrieve-msg id {
set ret [Agent/rtProto/DV set msg_($id)]
Agent/rtProto/DV unset msg_($id)
set ret
}

Agent/rtProto/DV instproc send-updates changes {
$self instvar peers_ ifs_ ifsUp_

if $changes {
set to-send-to [array names peers_]
} else {
set to-send-to $ifsUp_
}
set ifsUp_ ""
foreach nbr ${to-send-to} {
if { [$ifs_($nbr) up?] == "up" } {
$self send-to-peer $nbr
}
}
}

Agent/rtProto/DV instproc send-to-peer nbr {
$self instvar ns_ rtObject_ ifs_ peers_
set INFINITY [$class set INFINITY]
foreach dest [$ns_ all-nodes-list] {
set metric [$rtObject_ metric? $dest]
if {$metric < 0} {
set update($dest) $INFINITY
} else {
set update($dest) [$rtObject_ metric? $dest]
foreach nh [$rtObject_ nextHop? $dest] {
if {$nh == $ifs_($nbr)} {
set update($dest) $INFINITY
}
}
}
}

if { $peers_($nbr) == "" } {
return
}

set id [$class get-next-mid]
$class set msg_($id) [array get update]

$self send-update [$peers_($nbr) addr?] [$peers_($nbr) port?] $id [array size update]
}

Agent/rtProto/DV instproc recv-update {peerAddr id} {
$self instvar peers_ ifs_ nextHopPeer_ metric_
$self instvar rtsChanged_ rtObject_

set INFINITY [$class set INFINITY]
set UNREACHABLE  [$class set UNREACHABLE]
set msg [$class retrieve-msg $id]
array set metrics $msg
foreach nbr [array names peers_] {
if {[$peers_($nbr) addr?] == $peerAddr} {
set peer $peers_($nbr)
if { [array size metrics] > [Node set nn_] } {
error "$class::$proc update $peerAddr:$msg:$count is larger than the simulation topology"
}
set metricsChanged 0
foreach dest [array names metrics] {
set metric [expr $metrics($dest) + [$ifs_($nbr) cost?]]
if {$metric > $INFINITY} {
set metric $INFINITY
}
if {$metric != [$peer metric? $dest]} {
$peer metric $dest $metric
incr metricsChanged
}
}
if $metricsChanged {
$self compute-routes
incr rtsChanged_ $metricsChanged
$rtObject_ compute-routes
} else {
$rtObject_ flag-multicast -1
}
return
}
}
error "$class::$proc update $peerAddr:$msg:$count from unknown peer"
}

Agent/rtProto/DV proc compute-all {} {
}

Class Agent/rtProto/Manual -superclass Agent/rtProto

Agent/rtProto/Manual proc pre-init-all args {
Simulator set node_factory_ ManualRtNode
}

Agent/rtProto/Manual proc init-all args {
}




Class rtQueue

Simulator instproc rtmodel { dist parms args } {
set ret ""
if { [rtModel info subclass rtModel/$dist] != "" } {
$self instvar  rtModel_
set ret [eval new rtModel/$dist $self]
eval $ret set-elements $args
eval $ret set-parms $parms
set trace [$self get-ns-traceall]
if {$trace != ""} {
$ret trace $self $trace
}
set trace [$self get-nam-traceall]
if {$trace != ""} {
$ret trace $self $trace "nam"
}
if [info exists rtModel_] {
lappend rtModel_ $ret
} else {
set rtModel_ $ret
}
}
return $ret
}

Simulator instproc rtmodel-configure {} {
$self instvar rtq_ rtModel_
if [info exists rtModel_] {
set rtq_ [new rtQueue $self]
foreach m $rtModel_ {
$m configure
}
}
}

Simulator instproc rtmodel-at {at op args} {
set parms [list $op $at]
eval $self rtmodel Manual [list $parms] $args
}

Simulator instproc rtmodel-delete model {
$self instvar rtModel_
set idx [lsearch -exact $rtModel_ $model]
if { $idx != -1 } {
delete $model
set rtModel_ [lreplace $rtModel_ $idx $idx]
}
}

rtQueue instproc init ns {
$self next
$self instvar ns_
set ns_ $ns
}

rtQueue instproc insq-i { interval obj iproc args } {
$self instvar rtq_ ns_
set time [expr $interval + [$ns_ now]]
if ![info exists rtq_($time)] {
$ns_ at $time "$self runq $time"
}
lappend rtq_($time) "$obj $iproc $args"
return $time
}

rtQueue instproc insq { at obj iproc args } {
$self instvar rtq_ ns_
if {[$ns_ now] >= $at} {
puts stderr "$proc: Cannot set event in the past"
set at ""
} else {
if ![info exists rtq_($at)] {
$ns_ at $at "$self runq $at"
}
lappend rtq_($at) "$obj $iproc $args"
}
return $at
}

rtQueue instproc delq { time obj } {
$self instvar rtq_
set ret ""
set nevent ""
if [info exists rtq_($time)] {
foreach event $rtq_($time) {
if {[lindex $event 0] != $obj} {
lappend nevent $event
} else {
set ret $event
}
}
set rtq_($time) $nevent		;# XXX
}
return ret
}

rtQueue instproc runq { time } {
$self instvar rtq_
set objects ""
foreach event $rtq_($time) {
set obj   [lindex $event 0]
set iproc [lindex $event 1]
set args  [lrange $event 2 end]
eval $obj $iproc $args
lappend objects $obj
}
foreach obj $objects {
$obj notify
}
unset rtq_($time)
}

Class rtModel

rtModel set rtq_ ""

rtModel instproc init ns {
$self next
$self instvar ns_ startTime_ finishTime_
set ns_ $ns
set startTime_ [$class set startTime_]
set finishTime_ [$class set finishTime_]
}

rtModel instproc set-elements args {
$self instvar ns_ links_ nodes_
if { [llength $args] == 2 } {
set n0 [lindex $args 0]
set n1 [lindex $args 1]
set n0id [$n0 id]
set n1id [$n1 id]

set nodes_($n0id) $n0
set nodes_($n1id) $n1
set links_($n0id:$n1id) [$ns_ link $n0 $n1]
set links_($n1id:$n0id) [$ns_ link $n1 $n0]
} else {
set n0 [lindex $args 0]
set n0id [$n0 id]
set nodes_($n0id) $n0
foreach nbr [$n0 set neighbor_] {
set n1 $nbr
set n1id [$n1 id]

set nodes_($n1id) $n1
set links_($n0id:$n1id) [$ns_ link $n0 $n1]
set links_($n1id:$n0id) [$ns_ link $n1 $n0]
}
}
}

rtModel instproc set-parms args {
$self instvar startTime_ upInterval_ downInterval_ finishTime_

set cls [$self info class]
foreach i {startTime_ upInterval_ downInterval_ finishTime_} {
if [catch "$cls set $i" $i] {
set $i [$class set $i]
}
}

set off "-"
set up  "-"
set dn  "-"
set fin "-"

switch [llength $args] {
4 {
set off [lindex $args 0]
set up  [lindex $args 1]
set dn  [lindex $args 2]
set fin [lindex $args 3]
}
3 {
set off [lindex $args 0]
set up  [lindex $args 1]
set dn  [lindex $args 2]
}
2 {
set up [lindex $args 0]
set dn [lindex $args 1]
}
}
if {$off != "-" && $off != ""} {
set startTime_ $off
}
if {$up != "-" && $up != ""} {
set upInterval_ $up
}
if {$dn != "-" && $dn != ""} {
set downInterval_ $dn
}
if {$fin != "-" && $fin != ""} {
set finishTime_ $fin
}
}

rtModel instproc configure {} {
$self instvar ns_ links_
if { [rtModel set rtq_] == "" } {
rtModel set rtq_ [$ns_ set rtq_]
}

foreach l [array names links_] {
$links_($l) dynamic
}
$self set-first-event
}

rtModel instproc set-event-exact {fireTime op} {
$self instvar ns_ finishTime_
if {$finishTime_ != "-" && $fireTime > $finishTime_} {
if {$op == "up"} {
[rtModel set rtq_] insq $finishTime_ $self $op
}
} else {
[rtModel set rtq_] insq $fireTime $self $op
}
}

rtModel instproc set-event {interval op} {
$self instvar ns_
$self set-event-exact [expr [$ns_ now] + $interval] $op
}

rtModel instproc set-first-event {} {
$self instvar startTime_ upInterval_
$self set-event [expr $startTime_ + $upInterval_] down
}

rtModel instproc up {} {
$self instvar links_
foreach l [array names links_] {
$links_($l) up
}
}

rtModel instproc down {} {
$self instvar links_
foreach l [array names links_] {
$links_($l) down
}
}

rtModel instproc notify {} {
$self instvar nodes_ ns_
foreach n [array names nodes_] {
$nodes_($n) intf-changed
}
[$ns_ get-routelogic] notify
}

rtModel instproc trace { ns f {op ""} } {
$self instvar links_
foreach l [array names links_] {
$links_($l) trace-dynamics $ns $f $op
}
}


Class rtModel/Exponential -superclass rtModel

rtModel/Exponential instproc set-first-event {} {
global rtglibRNG

$self instvar startTime_ upInterval_
$self set-event [expr $startTime_ + [$rtglibRNG exponential] * $upInterval_] down
}

rtModel/Exponential instproc up { } {
global rtglibRNG

$self next
$self instvar upInterval_
$self set-event [expr [$rtglibRNG exponential] * $upInterval_] down
}

rtModel/Exponential instproc down { } {
global rtglibRNG

$self next
$self instvar downInterval_
$self set-event [expr [$rtglibRNG exponential] * $downInterval_] up
}


Class rtModel/Deterministic -superclass rtModel

rtModel/Deterministic instproc up { } {
$self next
$self instvar upInterval_
$self set-event $upInterval_ down
}

rtModel/Deterministic instproc down { } {
$self next
$self instvar downInterval_
$self set-event $downInterval_ up
}


Class rtModel/Trace -superclass rtModel

rtModel/Trace instproc get-next-event {} {
$self instvar tracef_ links_
while {[gets $tracef_ event] >= 0} {
set toks [split $event]
if [info exists links_([lindex $toks 3]:[lindex $toks 4])] {
return $toks
}
}
return ""
}

rtModel/Trace instproc set-trace-events {} {
$self instvar ns_ nextEvent_ evq_

set time [lindex $nextEvent_ 1]
while {$nextEvent_ != ""} {
set nextTime [lindex $nextEvent_ 1]
if {$nextTime < $time} {
puts stderr "event $nextEvent_  is before current time $time. ignored."
continue
}
if {$nextTime > $time} break
if ![info exists evq_($time)] {
set op [string range [lindex $nextEvent_ 2] 5 end]
$self set-event-exact $time $op
set evq_($time) 1
}
set nextEvent_ [$self get-next-event]
}
}


rtModel/Trace instproc set-parms traceFile {
$self instvar tracef_ nextEvent_
if [catch "open $traceFile r" tracef_] {
puts stderr "cannot open $traceFile"
} else {
set nextEvent_ [$self get-next-event]
if {$nextEvent_ == ""} {
puts stderr "no relevant events in $traceFile"
}
}
}

rtModel/Trace instproc set-first-event {} {
$self set-trace-events
}

rtModel/Trace instproc up {} {
$self next
$self set-trace-events
}

rtModel/Trace instproc down {} {
$self next
$self set-trace-events
}

Class rtModel/Manual -superclass rtModel

rtModel/Manual instproc set-first-event {} {
$self instvar op_ at_
$self set-event-exact $at_ $op_ ;# you could concievably set a finishTime_?
}

rtModel/Manual instproc set-parms {op at} {
$self instvar op_ at_
set op_ $op
set at_ $at
}

rtModel/Manual instproc notify {} {
$self next
delete $self		;# XXX wierd code alert.
}
Class Agent/rtProto/Algorithmic -superclass Agent/rtProto

Agent/rtProto/Algorithmic proc init-all args {
[Simulator instance] compute-algo-routes
}

Agent/rtProto/Algorithmic proc compute-all {} {
[Simulator instance] compute-algo-routes
}

RouteLogic/Algorithmic instproc BFS {} {
$self instvar ns_ children_ root_ rank_

set ns_ [Simulator instance]
if {[$ns_ info class] == "Simulator"} {
$ns_ instvar link_
foreach ln [array names link_] {
set L [split $ln :]
set srcID [lindex $L 0]
set dstID [lindex $L 1]
if ![info exist adj($srcID)] {
set adj($srcID) ""
}
if ![info exist adj($dstID)] {
set adj($dstID) ""
}
if {[lsearch $adj($srcID) $dstID] < 0} {
lappend adj($srcID) $dstID
}
if {[lsearch $adj($dstID) $srcID] < 0} {
lappend adj($dstID) $srcID
}
}
} elseif {[$ns_ info class] == "SessionSim"} {
$ns_ instvar delay_
foreach ln [array names delay_] {
set L [split $ln :]
set srcID [lindex $L 0]
set dstID [lindex $L 1]
if ![info exist adj($srcID)] {
set adj($srcID) ""
}
if ![info exist adj($dstID)] {
set adj($dstID) ""
}
if {[lsearch $adj($srcID) $dstID] < 0} {
lappend adj($srcID) $dstID
}
if {[lsearch $adj($dstID) $srcID] < 0} {
lappend adj($dstID) $srcID
}
}
}


set rank_ 0
set root_ 0
set traversed($root_) 1
set queue "$root_"

while {[llength $queue] > 0} {
set parent [lindex $queue 0]
set queue [lreplace $queue 0 0]
if ![info exist children_($parent)] {
set children_($parent) ""
}

foreach nd $adj($parent) {
if ![info exist traversed($nd)] {
set traversed($nd) 0
}
if !$traversed($nd) {
set traversed($nd) 1
lappend children_($parent) $nd
lappend queue $nd
}
}
set num_children [llength $children_($parent)]
if {$rank_ < $num_children} {
set rank_ $num_children
}
}
}

RouteLogic/Algorithmic instproc compute {} {
$self instvar root_ children_ rank_ id_ algoAdd_


set queue [list [list $root_ 0]]

while {[llength $queue] > 0} {
set parent [lindex $queue 0]
set queue [lreplace $queue 0 0]
set id [lindex $parent 0]
set algoAdd [lindex $parent 1]
set id_($algoAdd) $id
set algoAdd_($id) $algoAdd

set i 0
foreach child $children_($id) {
incr i
lappend queue [list $child [expr [expr $algoAdd * $rank_] + $i]]
}
}
}

RouteLogic/Algorithmic instproc lookup {src dst} {
$self instvar id_ algoAdd_
set algosrc $algoAdd_($src)
set algodst $algoAdd_($dst)
set algonxt [$self algo-lookup $algosrc $algodst]
return $id_($algonxt)
}


RouteLogic/Algorithmic instproc algo-lookup {src dst} {
$self instvar rank_

if {$src == $dst} {
return $src
}
set a $src
set b $dst
set offset 0

while {$b > $a} {
set offset [expr $b % $rank_]
set b [expr $b / $rank_]
if {$offset == 0} {
set offset $rank_
set b [expr $b - 1]
}
}

if {$b == $a} {
return [expr [expr $a * $rank_] + $offset]
} else {
return [expr [expr $a - 1] / $rank_]
}
}


Simulator instproc compute-algo-routes {} {
$self instvar Node_ link_
set r [$self get-routelogic]

$r BFS
$r compute

set i 0
set n [Node set nn_]
while { $i < $n } {
if ![info exists Node_($i)] {
incr i
continue
}
set n1 $Node_($i)
$n1 set rtsize_ 1 
set j 0
while { $j < $n } {
if { $i != $j } {
set nh [$r lookup $i $j]
if { $nh >= 0 } {
$n1 add-route $j [$link_($i:$nh) head]
}
} 
incr j
}
incr i
}
}













ErrorModel/Trace instproc init {{filename ""}} {
$self instvar file_
$self next
set file_ ""
if {$filename != ""} {
$self open $filename
}
}

ErrorModel/Trace instproc open {filename} {
$self instvar file_
if {! [file readable $filename]} {
puts "$class: cannot open $filename"
return
}
if {$file_ != ""} {
close $file_
}
set file_ [open $filename]
$self read
}

ErrorModel/Trace instproc read {} {
$self instvar file_ good_ loss_
if {$file_ != ""} {
set line [gets $file_]
set good_ [lindex $line 0]
set loss_ [lindex $line 1]
} else {
set good_ 123456789
set loss_ 0
}
}


ErrorModel/TwoState instproc init {rv0 rv1 {unit "pkt"}} {
$self next
$self unit $unit
$self ranvar 0 $rv0
$self ranvar 1 $rv1
}

Class ErrorModel/Uniform -superclass ErrorModel
Class ErrorModel/Expo -superclass ErrorModel/TwoState
Class ErrorModel/Empirical -superclass ErrorModel/TwoState

ErrorModel/Uniform instproc init {rate {unit "pkt"}} {
$self next
$self unit $unit
$self set rate_ $rate
}

ErrorModel/Expo instproc init {avgList {unit "pkt"}} {
set rv0 [new RandomVariable/Exponential]
set rv1 [new RandomVariable/Exponential]
$rv0 set avg_ [lindex $avgList 0]
$rv1 set avg_ [lindex $avgList 1]
$self next $rv0 $rv1 $unit
}

ErrorModel/Empirical instproc init {fileList {unit "pkt"}} {
set rv0 [new RandomVariable/Empirical]
set rv1 [new RandomVariable/Empirical]
$rv0 loadCDF [lindex $fileList 0]
$rv1 loadCDF [lindex $fileList 1]
$self next $rv0 $rv1 $unit
}

ErrorModel/MultiState instproc init {states periods trans transunit sttype nstates start} {

$self instvar states_ transmatrix_ transunit_ nstates_ curstate_ eu_ periods_

$self next
set states_ $states
set periods_ $periods
set transmatrix_ $trans
set transunit_ $transunit
$self sttype $sttype
set nstates_ $nstates
set curstate_ $start
set eu_ $transunit
$self error-model $start

if { [$self sttype] == "time" } {
for { set i 0 } { $i < $nstates_ } {incr i} {
if { [lindex $states_ $i] == $curstate_ } {
break
}
}
$self set curperiod_ [lindex $periods_ $i]
}
}

ErrorModel/MultiState instproc corrupt { } {
$self instvar states_ transmatrix_ transunit_ curstate_

set cur $curstate_
if { [$self sttype] == "time" } {
set curstate_ [$self time-transition]
} else {
set curstate_ [$self transition]
}

if { $cur != $curstate_ } {
$cur reset
$self reset
$self error-model $curstate_
}
return [$curstate_ next]
}


ErrorModel/MultiState instproc time-transition { } {
$self instvar states_ transmatrix_ transunit_ curstate_ nstates_ periods_

if {[$self set texpired_] != 1} {
return $curstate_
}

for { set i 0 } { $i < $nstates_ } {incr i} {
if { [lindex $states_ $i] == $curstate_ } {
break
}
}

set trans [lindex $transmatrix_ $i]
set p [uniform 0 1]
set total 0
for { set i 0 } { $i < $nstates_ } {incr i } {
set total [expr $total + [lindex $trans $i]]
if { $p <= $total } {
$self set curperiod_ [lindex $periods_ $i]
return [lindex $states_ $i]
}
}
puts "Misconfigured state transition: prob $p total $total $nstates_"
return $curstate_
}

ErrorModel/MultiState instproc transition { } {
$self instvar states_ transmatrix_ transunit_ curstate_ nstates_

for { set i 0 } { $i < $nstates_ } {incr i} {
if { [lindex $states_ $i] == $curstate_ } {
break
}
}
set trans [lindex $transmatrix_ $i]
set p [uniform 0 1]
set total 0
for { set i 0 } { $i < $nstates_ } {incr i } {
set total [expr $total + [lindex $trans $i]]
if { $p <= $total } {
return [lindex $states_ $i]
}
}
puts "Misconfigured state transition: prob $p total $total $nstates_"
return $curstate_
}


Class ErrorModel/TwoStateMarkov -superclass ErrorModel/TwoState

ErrorModel/TwoStateMarkov instproc init {rate eu {transition}} {
$self next
$self unit time

set rv0 [new RandomVariable/Exponential]
set rv1 [new RandomVariable/Exponential]
$rv0 set avg_ [lindex $rate 0]
$rv1 set avg_ [lindex $rate 1]
$self ranvar 0 $rv0
$self ranvar 1 $rv1


}



ErrorModule instproc init { cltype { clslots 29 } } {

$self next
set nullagent [[Simulator instance] set nullAgent_]

set classifier [new Classifier/Hash/$cltype $clslots]
$self cmd classifier $classifier
$self cmd target [new Connector]
$self cmd drop-target [new Connector]
$classifier proc unknown-flow { src dst fid } {
puts "warning: classifier $self unknown flow s:$src, d:$dst, fid:$fid"
}
}

ErrorModule instproc default errmodel {
set cl [$self cmd classifier]
if { $errmodel == "pass" } {
set target [$self cmd target]
set pslot [$cl installNext $target]
$cl set default_ $pslot
return
}

set emslot [$cl findslot $errmodel]
if { $emslot == -1 } {
puts "ErrorModule: couldn't find classifier entry for error model $errmodel"
return
}
$cl set default_ $emslot
}

ErrorModule instproc insert errmodel {
$self instvar models_
$errmodel target [$self cmd target]
$errmodel drop-target [$self cmd drop-target]
if { [info exists models_] } {
set models_ [concat $models_ $errmodel]
} else {
set models_ $errmodel
}
}

ErrorModule instproc errormodels {} {
$self instvar models_
return $models_
}

ErrorModule instproc bind args {

set nargs [llength $args]
set errmod [lindex $args 0]
set a [lindex $args 1]
if { $nargs == 3 } {
set b [lindex $args 2]
} else {
set b $a
}       
set cls [$self cmd classifier]
while { $a <= $b } {
set slot [$cls installNext $errmod] 
$cls set-hash auto 0 0 $a $slot
incr a  
}
}

ErrorModule instproc target args {
if { $args == "" } {
return [[$self cmd target] target]
}
set obj [lindex $args 0]

[$self cmd target] target $obj
[$self cmd target] drop-target $obj
}

ErrorModule instproc drop-target args {
if { $args == "" } {
return [[$self cmd drop-target] target]
}

set obj [lindex $args 0]

[$self cmd drop-target] drop-target $obj
[$self cmd drop-target] target $obj
}

Queue/SimpleIntServ set qlimit1_ 50
Queue/SimpleIntServ set qlimit0_ 50

Agent/SA set rate_ 0
Agent/SA set bucket_ 0
Agent/SA set packetSize_ 210

ADC set backoff_ true
ADC set dobump_ true
ADC/MS set backoff_ false

ADC set src_ -1
ADC set dst_ -1
ADC/MS set utilization_ 0.95
ADC/MSPK set utilization_ 0.95
ADC/Param set utilization_ 1.0
ADC/HB set epsilon_ 0.7
ADC/ACTO set s_ 0.002
ADC/ACTO set dobump_ false
ADC/ACTP set s_ 0.002
ADC/ACTP set dobump_ false


Est/TimeWindow set T_ 3
Est/ExpAvg set w_ 0.125
Est set period_ 0.5

ADC set bandwidth_ 0

SALink set src_ -1
SALink set dst_ -1

Est set src_ -1
Est set dst_ -1


Class IntServLink -superclass  SimpleLink
IntServLink instproc init { src dst bw delay q arg {lltype "DelayLink"} } {

$self next $src $dst $bw $delay $q $lltype ; # SimpleLink ctor
$self instvar queue_ link_

$self instvar measclassifier_ signalmod_ adc_ est_ measmod_

set ns_ [Simulator instance]

set adctype [lindex $arg 3]
set adc_ [new ADC/$adctype]
$adc_ set bandwidth_ $bw
$adc_ set src_ [$src id]
$adc_ set dst_ [$dst id]

if { [lindex $arg 5] == "CL" } {
set esttype [lindex $arg 4]
set est_ [new Est/$esttype]
$est_ set src_ [$src id]
$est_ set dst_ [$dst id]
$adc_ attach-est $est_ 1

set measmod_ [new MeasureMod]
$measmod_ target $queue_
$adc_ attach-measmod $measmod_ 1
}

set signaltype [lindex $arg 2]
set signalmod_ [new $signaltype]
$signalmod_ set src_ [$src id]
$signalmod_ set dst_ [$dst id]
$signalmod_ attach-adc $adc_
$self add-to-head $signalmod_


$self create-meas-classifier
$signalmod_ target $measclassifier_

$ns_ at 0.0 "$adc_ start"
}
IntServLink instproc buffersize { b } {
$self instvar est_ adc_
$est_ setbuf [set b]
$adc_ setbuf [set b]
}



IntServLink instproc create-meas-classifier {} {
$self instvar measclassifier_ measmod_ link_ queue_

set measclassifier_ [new Classifier/Hash/Fid 1 ]
set slot [$measclassifier_ installNext $queue_]
$measclassifier_ set-hash auto 0 0 0 $slot 

set slot [$measclassifier_ installNext $measmod_]
$measclassifier_ set default_ 1
}

IntServLink instproc trace-sig { f } {
$self instvar signalmod_ est_ adc_
$signalmod_ attach $f
$est_ attach $f
$adc_ attach $f
set ns [Simulator instance]
$ns at 0.0 "$signalmod_ add-trace"
}

IntServLink instproc trace-util { interval {f ""}} {
$self instvar est_
set ns [Simulator instance]
if { $f != "" } {
puts $f "[$ns now] [$est_ load-est] [$est_ link-utlzn]" 
}
$ns at [expr [$ns now]+$interval] "$self trace-util $interval $f" 
}

CMUTrace instproc init { tname type } {
$self next $tname $type
$self instvar type_ src_ dst_ callback_ show_tcphdr_

set type_ $type
set src_ 0
set dst_ 0
set callback_ 0
set show_tcphdr_ 0
}

CMUTrace instproc attach fp {
$self instvar fp_
set fp_ $fp
$self cmd attach $fp_
}

Class CMUTrace/Send -superclass CMUTrace
CMUTrace/Send instproc init { tname } {
$self next $tname "s"
}

Class CMUTrace/Recv -superclass CMUTrace
CMUTrace/Recv instproc init { tname } {
$self next $tname "r"
}

Class CMUTrace/Drop -superclass CMUTrace
CMUTrace/Drop instproc init { tname } {
$self next $tname "D"
}


CMUTrace/Recv set src_ 0
CMUTrace/Recv set dst_ 0
CMUTrace/Recv set callback_ 0
CMUTrace/Recv set show_tcphdr_ 0

CMUTrace/Send set src_ 0
CMUTrace/Send set dst_ 0
CMUTrace/Send set callback_ 0
CMUTrace/Send set show_tcphdr_ 0

CMUTrace/Drop set src_ 0
CMUTrace/Drop set dst_ 0
CMUTrace/Drop set callback_ 0
CMUTrace/Drop set show_tcphdr_ 0

Class Node/Broadcast -superclass Node

Node/Broadcast instproc mk-default-classifier {} {
$self instvar address_ classifier_ id_ dmux_
set classifier_ [new Classifier/Hash/Dest/Bcast 32]

$classifier_ set mask_ [AddrParams set NodeMask_(1)]
$classifier_ set shift_ [AddrParams set NodeShift_(1)]
set address_ $id_
if { $dmux_ == "" } {
set dmux_ [new Classifier/Port/Reserve]
$dmux_ set mask_ [AddrParams set ALL_BITS_SET]
$dmux_ set shift_ 0

if [Simulator set EnableHierRt_] {  
$self add-hroute $address_ $dmux_
} else {
$self add-route $address_ $dmux_
}
}
$classifier_ bcast-receiver $dmux_
}

MIPEncapsulator instproc tunnel-exit mhaddr {
$self instvar node_
return [[$node_ set regagent_] set TunnelExit_($mhaddr)]
}

Class Node/MIPBS -superclass Node/Broadcast

Node/MIPBS instproc init { args } {
eval $self next $args
$self instvar regagent_ encap_ decap_ agents_ address_ dmux_ id_

if { $dmux_ == "" } {
error "serious internal error at Node/MIPBS\n"
}
set regagent_ [new Agent/MIPBS $self]
$self attach $regagent_ 0
$regagent_ set mask_ [AddrParams set NodeMask_(1)]
$regagent_ set shift_ [AddrParams set NodeShift_(1)]
$regagent_ set dst_addr_ [expr (~0) << [AddrParams set NodeShift_(1)]]
$regagent_ set dst_port_ 0

set encap_ [new MIPEncapsulator]
set decap_ [new Classifier/Addr/MIPDecapsulator]

lappend agents_ $decap_

set mask [AddrParams set ALL_BITS_SET]
set shift 0


if [Simulator set EnableHierRt_] {
set nodeaddr [AddrParams set-hieraddr $address_]

} else {
set nodeaddr [expr ( $address_ &			 [AddrParams set NodeMask_(1)] ) <<	 [AddrParams set NodeShift_(1) ]]
}
$encap_ set addr_ $nodeaddr
$encap_ set port_ 1
$encap_ target [$self entry]
$encap_ set node_ $self

$dmux_ install 1 $decap_

$encap_ set mask_ [AddrParams set NodeMask_(1)]
$encap_ set shift_ [AddrParams set NodeShift_(1)]
$decap_ set mask_ [AddrParams set NodeMask_(1)]
$decap_ set shift_ [AddrParams set NodeShift_(1)]

}

Class Node/MIPMH -superclass Node/Broadcast

Node/MIPMH instproc init { args } {
eval $self next $args
$self instvar regagent_
set regagent_ [new Agent/MIPMH $self]
$self attach $regagent_ 0
$regagent_ set mask_ [AddrParams set NodeMask_(1)]
$regagent_ set shift_ [AddrParams set NodeShift_(1)]
$regagent_ set dst_addr_ [expr (~0) << [AddrParams set NodeShift_(1)]]
$regagent_ set dst_port_ 0
}

Agent/MIPBS instproc init { node args } {
eval $self next $args

if {[$node info class] != "MobileNode/MIPBS" && [$node info class] != "Node/MobileNode"} {
$self instvar BcastTarget_
set BcastTarget_ [new Classifier/Replicator]
$self bcast-target $BcastTarget_
}
$self beacon-period 1.0	;# default value
}

Agent/MIPBS instproc clear-reg mhaddr {
$self instvar node_ OldRoute_ RegTimer_
if [info exists OldRoute_($mhaddr)] {
$node_ add-route $mhaddr $OldRoute_($mhaddr)
}
if {[$node_ info class] == "MobileNode/MIPBS" || [$node_ info class] =="Node/MobileNode" } {
eval $node_ delete-hroute [AddrParams get-hieraddr $mhaddr]
}
if { [info exists RegTimer_($mhaddr)] && $RegTimer_($mhaddr) != "" } {
[Simulator instance] cancel $RegTimer_($mhaddr)
set RegTimer_($mhaddr) ""
}
}

Agent/MIPBS instproc encap-route { mhaddr coa lifetime } {
$self instvar node_ TunnelExit_ OldRoute_ RegTimer_
set ns [Simulator instance]
set encap [$node_ set encap_]

if {[$node_ info class] == "MobileNode/MIPBS" || [$node_ info class] == "Node/MobileNode"} {
set addr [AddrParams get-hieraddr $mhaddr]
set a [split $addr]
set b [join $a .]
$node_ add-hroute $b $encap
} else {
set or [[$node_ set classifier_] slot $mhaddr]
if { $or != $encap } {
set OldRoute_($mhaddr) $or
$node_ add-route $mhaddr $encap
}
}
set TunnelExit_($mhaddr) $coa
if { [info exists RegTimer_($mhaddr)] && $RegTimer_($mhaddr) != "" } {
$ns cancel $RegTimer_($mhaddr)
}
set RegTimer_($mhaddr) [$ns at [expr [$ns now] + $lifetime]  "$self clear-reg $mhaddr"]
}

Agent/MIPBS instproc decap-route { mhaddr target lifetime } {
$self instvar node_ RegTimer_

if {[$node_ info class] != "MobileNode/MIPBS" && [$node_ info class] != "Node/MobileNode" } {
set ns [Simulator instance]
[$node_ set decap_] install $mhaddr $target

if { [info exists RegTimer_($mhaddr)] && $RegTimer_($mhaddr) != "" } {
$ns cancel $RegTimer_($mhaddr)
}
set RegTimer_($mhaddr) [$ns at [expr [$ns now] + $lifetime]  "$self clear-decap $mhaddr"]
} else {

[$node_ set decap_] defaulttarget [$node_ set ragent_]
}
}

Agent/MIPBS instproc clear-decap mhaddr {
$self instvar node_ RegTimer_
if { [info exists RegTimer_($mhaddr)] && $RegTimer_($mhaddr) != "" } {
[Simulator instance] cancel $RegTimer_($mhaddr)
set RegTimer_($mhaddr) ""
}
[$node_ set decap_] clear $mhaddr
}

Agent/MIPBS instproc get-link { src dst } {
$self instvar node_
if {[$node_ info class] != "MobileNode/MIPBS" && [$node_ info class] != "Node/MobileNode"} {
set ns [Simulator instance]
return [[$ns link [$ns get-node-by-addr $src]  [$ns get-node-by-addr $dst]] head]
} else { 
return ""
}
}

Agent/MIPBS instproc add-ads-bcast-link { ll } {
$self instvar BcastTarget_
$BcastTarget_ installNext [$ll head]
}

Agent/MIPMH instproc init { node args } {
eval $self next $args
if {[$node info class] != "MobileNode/MIPMH" &&  [$node info class] != "SRNode/MIPMH" && [$node info class] != "Node/MobileNode" } {
$self instvar BcastTarget_
set BcastTarget_ [new Classifier/Replicator]
$self bcast-target $BcastTarget_
}
$self beacon-period 1.0	;# default value
}

Agent/MIPMH instproc update-reg coa {
$self instvar node_
if {[$node_ info class] != "MobileNode/MIPMH" &&  [$node_ info class] != "SRNode/MIPMH" && [$node_ info class] != "Node/MobileNode" } {
set n [Node set nn_]
set ns [Simulator instance]
set id [$node_ id]
set l [[$ns link $node_ [$ns get-node-by-addr $coa]] head]
for { set i 0 } { $i < $n } { incr i } {
if { $i != $id } {
$node_ add-route $i $l
}
}
}
}

Agent/MIPMH instproc get-link { src dst } {
$self instvar node_
if {[$node_ info class] != "MobileNode/MIPMH" &&  [$node_ info class] != "SRNode/MIPMH" &&  [$node_ info class] != "Node/MobileNode" } {
set ns [Simulator instance]
return [[$ns link [$ns get-node-by-addr $src]  [$ns get-node-by-addr $dst]] head]
} else {
return ""
}
}

Agent/MIPMH instproc add-sol-bcast-link { ll } {
$self instvar BcastTarget_
$BcastTarget_ installNext [$ll head]
}











Node/SatNode instproc init args {
eval $self next $args		;# parent class constructor

$self instvar nifs_ 
$self instvar phy_tx_ phy_rx_ mac_ ifq_ ll_ pos_ hm_

set nifs_	0		;# number of network interfaces
set ns_ [Simulator instance]
set trace_ [$ns_ get-ns-traceall]
if {$trace_ != ""} {
set dropT_ [$ns_ create-trace Sat/Drop $trace_ $self $self ""]
$self set_trace $dropT_
}


}

Node/SatNode instproc reset {} {
eval $self next 
$self instvar hm_ instvar nifs_ phy_tx_ phy_rx_ mac_ ifq_ ll_
set ns [Simulator instance]
set now_ [$ns now]
for {set i 0} {$i < $nifs_} {incr i} {
$phy_tx_($i) reset
$phy_rx_($i) reset
if {[info exists mac_($i)]} {
$mac_($i) reset
}
if {[info exists ll_($i)]} {
$ll_($i) reset
}
if {[info exists ifq_($i)]} {
$ifq_($i) reset
}
}
if {$now_ == 0} {
if {[info exists hm_]} {
$ns at 0.0 "$self start_handoff"
}
}
}

Node/SatNode instproc set_next {node_} {
$self instvar pos_
$pos_ set_next [$node_ set pos_]
}

Node/SatNode instproc add-target {agent port } {

$self instvar dmux_ 

if { $port == [Node set rtagent_port_] } {			
[$self set classifier_] defaulttarget $agent
$dmux_ install $port $agent
} else {
$agent target [$self entry]

$dmux_ install $port $agent
}
}


Simulator instproc satnode-polar {alt inc lon alpha plane linkargs chan} {
set tmp [$self satnode polar $alt $inc $lon $alpha $plane]
$self add-first-links $tmp gsl $linkargs $chan
return $tmp
}

Simulator instproc satnode-geo {lon linkargs chan} {
set tmp [$self satnode geo $lon]
$self add-first-links $tmp gsl $linkargs $chan
return $tmp
}

Simulator instproc satnode-geo-repeater {lon chan} {
set tmp [$self satnode geo $lon]
$self add-first-links $tmp gsl-repeater "" $chan
return $tmp
}

Simulator instproc satnode-terminal {lat lon} {
$self satnode terminal $lat $lon
}

Simulator instproc satnode args {
$self instvar Node_
set node [new Node/SatNode]
if {[lindex $args 0] == "polar" || [lindex $args 0] == "Polar"} {
set args [lreplace $args 0 0]
$node set pos_ [new Position/Sat/Polar $args]
$node cmd set_position [$node set pos_]
[$node set pos_] setnode $node
$node set hm_ [new HandoffManager/Sat]
$node cmd set_handoff_mgr [$node set hm_]
[$node set hm_] setnode $node
$node create-ragent 
} elseif {[lindex $args 0] == "geo" || [lindex $args 0] == "Geo"} {  
set args [lreplace $args 0 0]
$node set pos_ [new Position/Sat/Geo $args]
$node cmd set_position [$node set pos_]
[$node set pos_] setnode $node
$node create-ragent
} elseif {[lindex $args 0] == "geo-repeater" || [lindex $args 0] == "Geo-repeater"} {  
set args [lreplace $args 0 0]
$node set pos_ [new Position/Sat/Geo $args]
$node cmd set_position [$node set pos_]
[$node set pos_] setnode $node
} elseif {[lindex $args 0] == "terminal" || [lindex $args 0] == "Terminal"} {  
set args [lreplace $args 0 0]
$node set pos_ [new Position/Sat/Term $args]
$node cmd set_position [$node set pos_]
[$node set pos_] setnode $node
$node set hm_ [new HandoffManager/Term]
$node cmd set_handoff_mgr [$node set hm_]
[$node set hm_] setnode $node
$node create-ragent
} else {
puts "Otcl error; satnode specified incorrectly: $args"
}
set Node_([$node id]) $node
$node set ns_ $self
if [$self multicast?] {
$node enable-mcast $self
}
$self check-node-num
return $node
}


Simulator instproc add-first-links {node_ linktype linkargs chan} {
$node_ set_downlink $chan
$node_ set_uplink $chan
if {$linktype == "gsl-repeater"} {
$node_ add-repeater $chan
} else {
eval $node_ add-interface $linktype $linkargs
}
$node_ attach-to-outlink [$node_ set downlink_]
$node_ attach-to-inlink [$node_ set uplink_]
}

Node/SatNode instproc add-gsl {ltype opt_ll opt_ifq opt_qlim opt_mac  opt_bw opt_phy opt_inlink opt_outlink} {
$self add-interface $ltype $opt_ll $opt_ifq $opt_qlim $opt_mac $opt_bw  $opt_phy 
$self attach-to-inlink $opt_inlink
$self attach-to-outlink $opt_outlink
}

Simulator instproc add-isl {ltype node1 node2 bw qtype qlim} {
set opt_ll LL/Sat
set opt_mac Mac/Sat
set opt_phy Phy/Sat
set opt_chan Channel/Sat
set chan1 [new $opt_chan]
set chan2 [new $opt_chan]
$node1 add-interface $ltype $opt_ll $qtype $qlim $opt_mac $bw $opt_phy $chan1 $chan2
$node2 add-interface $ltype $opt_ll $qtype $qlim $opt_mac $bw $opt_phy $chan2 $chan1
if {$ltype == "crossseam"} {
$node1 add-interface $ltype $opt_ll $qtype $qlim $opt_mac $bw $opt_phy 
$node2 add-interface $ltype $opt_ll $qtype $qlim $opt_mac $bw $opt_phy 

}
}

Node/SatNode instproc add-repeater chan { 
$self instvar nifs_ phy_tx_ phy_rx_ linkhead_ 

set t $nifs_
incr nifs_

set linkhead_($t) [new Connector/LinkHead/Sat]
set phy_tx_($t)	[new Phy/Repeater]		;# interface
set phy_rx_($t)	[new Phy/Repeater]

$linkhead_($t) setnode $self
$linkhead_($t) setphytx $phy_tx_($t)
$linkhead_($t) setphyrx $phy_rx_($t)
$linkhead_($t) set_type "gsl-repeater"
$linkhead_($t) set type_ "gsl-repeater"

$phy_rx_($t) up-target $phy_tx_($t)
$phy_tx_($t) linkhead $linkhead_($t)
$phy_rx_($t) linkhead $linkhead_($t)
$phy_tx_($t) node $self		;# Bind node <---> interface
$phy_rx_($t) node $self		;# Bind node <---> interface
}

Node/SatNode instproc add-interface args { 

$self instvar nifs_ phy_tx_ phy_rx_ mac_ ifq_ ll_ drophead_ linkhead_

global ns_ MacTrace opt

set t $nifs_
incr nifs_

set linkhead_($t) [new Connector/LinkHead/Sat]

set linktype 	[lindex $args 0]
set ll_($t)	[new [lindex $args 1]]		;# link layer
set ifq_($t)	[new [lindex $args 2]]		;# interface queue
set qlen	[lindex $args 3]
set mac_($t)	[new [lindex $args 4]]		;# mac layer
set mac_bw	[lindex $args 5]
set phy_tx_($t)	[new [lindex $args 6]]		;# interface
set phy_rx_($t)	[new [lindex $args 6]]		;# interface
set inchan 	[lindex $args 7]
set outchan 	[lindex $args 8]
set drophead_($t) [new Connector]	;# drop target for queue
set iif_($t) [new NetworkInterface]


set linkhead $linkhead_($t)
set phy_tx $phy_tx_($t)
set phy_rx $phy_rx_($t)
set mac $mac_($t)
set ifq $ifq_($t)
set ll $ll_($t)
set drophead $drophead_($t)
set iif $iif_($t)

$linkhead setnode $self
$linkhead setll $ll
$linkhead setmac $mac
$linkhead setqueue $ifq
$linkhead setphytx $phy_tx
$linkhead setphyrx $phy_rx
$linkhead setnetinf $iif
$self addlinkhead $linkhead; # Add NetworkInterface to node's list
$linkhead target $ll; 
$linkhead set_type $linktype
$linkhead set type_ $linktype

$iif target [$self entry]

$ll mac $mac; # XXX is this needed?
$ll up-target $iif
$ll down-target $ifq
$ll set delay_ 0ms; # processing delay between ll and ifq

$ifq target $mac
$ifq set qlim_ $qlen
$drophead target [[Simulator instance] set nullAgent_]
$ifq drop-target $drophead


$mac netif $phy_tx; # Not used by satellite code at this time
$mac up-target $ll
$mac down-target $phy_tx
$mac set bandwidth_ $mac_bw; 

$phy_rx up-target $mac
$phy_tx linkhead $linkhead
$phy_rx linkhead $linkhead
$phy_tx node $self		;# Bind node <---> interface
$phy_rx node $self		;# Bind node <---> interface

if {$outchan != "" && $inchan != ""} {
$phy_tx channel $outchan
$phy_rx channel $inchan
$inchan addif $phy_rx
}
return $t
}

Node/SatNode instproc set_uplink {chan} {
$self instvar uplink_
set uplink_ [new $chan]
$self cmd set_uplink $uplink_
}

Node/SatNode instproc set_downlink {chan} {
$self instvar downlink_
set downlink_ [new $chan]
$self cmd set_downlink $downlink_
}

Node/SatNode instproc attach-to-outlink {chan {index 0} } {
$self instvar phy_tx_ mac_
$phy_tx_($index) channel $chan
}

Node/SatNode instproc attach-to-inlink { chan {index 0}} {
$self instvar phy_rx_ 
$phy_rx_($index) channel $chan
$chan addif $phy_rx_($index)
}

Node/SatNode instproc interface-errormodel { em { index 0 } } {
$self instvar mac_ ll_ em_ linkhead_
$mac_($index) up-target $em
$em target $ll_($index)
$em drop-target [new Agent/Null]; # otherwise, packet is only marked
set em_($index) $em
$linkhead_($index) seterrmodel $em
} 


Node/SatNode instproc create-ragent {} {
set ragent [new Agent/SatRoute]
$self attach $ragent 255; # attaches to default target of classifier  
$ragent set myaddr_ [$self set id_]
$self set_ragent $ragent; # sets pointer at C++ level
$ragent set_node $self; # sets back pointer in ragent to node
}

Class Agent/rtProto/Dummy -superclass Agent/rtProto

Agent/rtProto/Dummy proc init-all args {
}


Simulator instproc trace-all-satlinks {f} {
$self instvar Node_
foreach nn [array names Node_] {
if {![$Node_($nn) info class Node/SatNode]} {
continue; # Not a SatNode
}
$Node_($nn) trace-all-satlinks $f
}
}

Node/SatNode instproc trace-all-satlinks {f} {
$self instvar nifs_ enqT_ rcvT_ linkhead_
for {set i 0} {$i < $nifs_} {incr i} {
if {[$linkhead_($i) set type_] == "gsl-repeater"} {
continue;
}
if {[info exists enqT_($i)]} {
puts "Tracing already exists on node [$self id]"
} else {
$self trace-outlink-queue $f $i
}
if {[info exists rcvT_($i)]} {
puts "Tracing already exists on node [$self id]"
} else {
$self trace-inlink-queue $f $i
}
}
}

Node/SatNode instproc trace-outlink-queue {f {index_ 0} } {
$self instvar id_ enqT_ deqT_ drpT_ mac_ ll_ ifq_ drophead_ 

set ns [Simulator instance]
set fromNode_ $id_
set toNode_ -1

set enqT_($index_) [$ns create-trace Sat/Enque $f $fromNode_ $toNode_]
$enqT_($index_) target $ifq_($index_)
$ll_($index_) down-target $enqT_($index_)

set deqT_($index_) [$ns create-trace Sat/Deque $f $fromNode_ $toNode_]
$deqT_($index_) target $mac_($index_)
$ifq_($index_) target $deqT_($index_)

set drpT_($index_) [$ns create-trace Sat/Drop $f $fromNode_ $toNode_]
$drpT_($index_) target [$drophead_($index_) target]
$drophead_($index_) target $drpT_($index_)
$ifq_($index_) drop-target $drpT_($index_)
}

Node/SatNode instproc trace-inlink-queue {f {index_ 0} } {
$self instvar id_ rcvT_ mac_ ll_ phy_rx_ em_ errT_    

set ns [Simulator instance]
set toNode_ $id_
set fromNode_ -1

if {[info exists em_($index_)]} {
set errT_($index_) [$ns create-trace Sat/Error $f $fromNode_ $toNode_]
$errT_($index_) target [$em_($index_) drop-target]
$em_($index_) drop-target $errT_($index_)
set rcvT_($index_) [$ns create-trace Sat/Recv $f $fromNode_ $toNode_]
$rcvT_($index_) target [$em_($index_) target]
$em_($index_) target $rcvT_($index_)
} else {
set rcvT_($index_) [$ns create-trace Sat/Recv $f $fromNode_ $toNode_]
$rcvT_($index_) target [$mac_($index_) up-target]
$mac_($index_) up-target $rcvT_($index_)
}

}




Class Trace/Sat/Hop -superclass Trace/Sat
Trace/Sat/Hop instproc init {} {
$self next "h"
}

Class Trace/Sat/Enque -superclass Trace/Sat
Trace/Sat/Enque instproc init {} {
$self next "+"
}

Trace/Sat/Deque instproc init {} {
$self next "-"
}

Class Trace/Sat/Recv -superclass Trace/Sat
Trace/Sat/Recv instproc init {} {
$self next "r"
}

Class Trace/Sat/Drop -superclass Trace/Sat
Trace/Sat/Drop instproc init {} {
$self next "d"
}

Class Trace/Sat/Error -superclass Trace/Sat
Trace/Sat/Error instproc init {} {
$self next "e"
}

Class Trace/Sat/Generic -superclass Trace/Sat
Trace/Sat/Generic instproc init {} {
$self next "v"
}



Node/SatNode set dist_routing_ "false"; # distributed routing not yet supported
Position/Sat set time_advance_ 0; # time offset to start of simulation 
Position/Sat/Polar set plane_ 0
HandoffManager/Term set elevation_mask_ 0
HandoffManager/Term set term_handoff_int_ 10
HandoffManager/Sat set sat_handoff_int_ 10
HandoffManager/Sat set latitude_threshold_ 70
HandoffManager/Sat set longitude_threshold_ 0
HandoffManager set handoff_randomization_ "false" 
SatRouteObject set metric_delay_ "true"
SatRouteObject set data_driven_computation_ "false"
Mac/Sat/UnslottedAloha set mean_backoff_ 1s; # mean backoff time upon collision
Mac/Sat/UnslottedAloha set rtx_limit_ 3; # Retransmission limit 
Mac/Sat/UnslottedAloha set send_timeout_ 270ms; # Timer interval for new sends

Agent/SatRoute set myaddr_       0        ;# My address
Mac/Sat set bandwidth_ 2Mb 


proc mvar args {
upvar self _s
uplevel $_s instvar $args
}

Session/RTP set uniq_srcid 0
Session/RTP proc alloc_srcid {} {
set id [Session/RTP set uniq_srcid]
Session/RTP set uniq_srcid [expr $id+1]
return $id
}

Session/RTP instproc init {} {
$self next 
mvar dchan_ cchan_
set cchan_ [new Agent/RTCP]
set dchan_ [new Agent/CBR/RTP]
$dchan_ set packetSize_ 512

$dchan_ session $self
$cchan_ session $self

$self set rtcp_timer_ [new RTCPTimer $self]

mvar srcid_ localsrc_
set srcid_ [Session/RTP alloc_srcid]
set localsrc_ [new RTPSource $srcid_]
$self localsrc $localsrc_

$self set srctab_ $localsrc_
$self set stopped_ 1
}

Session/RTP instproc start {} {
mvar group_
if ![info exists group_] {
puts "error: can't transmit before joining group!"
exit 1
}

mvar cchan_ 
$cchan_ start 
}

Session/RTP instproc stop {} {
$self instvar cchan_ dchan_
$dchan_ stop
$cchan_ stop
$self set stopped_ 1
}

Session/RTP instproc report-interval { i } {
mvar cchan_
$cchan_ set interval_ $i
}

Session/RTP instproc bye {} {
mvar cchan_ dchan_
$dchan_ stop
$cchan_ bye
}

Session/RTP instproc attach-node { node } {
mvar dchan_ cchan_
global ns
$ns attach-agent $node $dchan_
$ns attach-agent $node $cchan_

$self set node_ $node
}

Session/RTP instproc detach-node { node } {
mvar dchan_ cchan_
global ns
$ns detach-agent $node $dchan_
$ns detach-agent $node $cchan_

$self unset node_
}

Session/RTP instproc rtcp_timeout {} {
mvar rtcp_timeout_callback_

if [info exists rtcp_timeout_callback_] {
eval $rtcp_timeout_callback_
}
}

Session/RTP instproc join-group { g } {
set g [expr $g]

$self set group_ $g

mvar node_ dchan_ cchan_ 

$dchan_ set dst_ $g
$node_ join-group $dchan_ $g

incr g

$cchan_ set dst_ $g
$node_ join-group $cchan_ $g
}

Session/RTP instproc leave-group { } {
mvar group_ node_ cchan_ dchan_
$node_ leave-group $dchan_ $group_
$node_ leave-group $cchan_ [expr $group_+1]

$self unset group_
}

Session/RTP instproc session_bw { bspec } {
set b [bw_parse $bspec]

$self set session_bw_ $b

mvar rtcp_timer_
$rtcp_timer_ session-bw $b
}

Session/RTP instproc transmit { bspec } {
set b [bw_parse $bspec]


$self set txBW_ $b

$self instvar dchan_ stopped_
if { $b == 0 } {
$dchan_ stop
set stopped_ 1
}

set ps [$dchan_ set packetSize_]
$dchan_ set interval_  [expr 8.*$ps/$b]
if { $stopped_ == 1 } {
$dchan_ start
set stopped_ 0
} else {
$dchan_ rate-change
}
}


Session/RTP instproc sample-size { cc } {
mvar rtcp_timer_
$rtcp_timer_ sample-size $cc
}

Session/RTP instproc adapt-timer { nsrc nrr we_sent } {
mvar rtcp_timer_
$rtcp_timer_ adapt $nsrc $nrr $we_sent
}

Session/RTP instproc new-source { srcid } {
set src [new RTPSource $srcid]
$self enter $src

mvar srctab_
lappend srctab_ $src

return $src
}

Class RTCPTimer 

RTCPTimer instproc init { session } {
$self next


mvar session_bw_fraction_ min_rpt_time_ inv_sender_bw_fraction_
mvar inv_rcvr_bw_fraction_ size_gain_ avg_size_ inv_bw_

set session_bw_fraction_ 0.05

set min_rpt_time_ 1.   

set sender_bw_fraction 0.25
set rcvr_bw_fraction [expr 1. - $sender_bw_fraction]

set inv_sender_bw_fraction_ [expr 1. / $sender_bw_fraction]
set inv_rcvr_bw_fraction_ [expr 1. / $rcvr_bw_fraction]

set size_gain_ 0.125	

set avg_size_ 128.
set inv_bw_ 0.

mvar session_
set session_ $session


mvar min_rtp_time_ avg_size_ inv_bw_
set rint [expr 8*$avg_size_ * $inv_bw_]

set t [expr $min_rpt_time_ / 2.]

if { $rint < $t } {
set rint $t
}

$session_ report-interval $rint
}

RTCPTimer instproc sample-size { cc } {
mvar avg_size_ size_gain_

set avg_size_ [expr $avg_size_ + $size_gain_ * ($cc + 28 - $avg_size_)]
}

RTCPTimer instproc adapt { nsrc nrr we_sent } {
mvar inv_bw_ avg_size_ min_rpt_time_
mvar inv_sender_bw_fraction_ inv_rcvr_bw_fraction_


set ibw $inv_bw_
if { $nrr > 0 } {
if { $we_sent } {
set ibw [expr $ibw * $inv_sender_bw_fraction_]
set nsrc $nrr
} else {
set ibw [expr $ibw * $inv_rcvr_bw_fraction_]
incr nsrc -$nrr
}
}

set rint [expr 8*$avg_size_ * $nsrc * $ibw]	
if { $rint < $min_rpt_time_ } {
set rint $min_rpt_time_
}

mvar session_
$session_ report-interval $rint
}

RTCPTimer instproc session-bw { b } {
$self set inv_bw_ [expr 1. / $b ]
}

Agent/RTCP set interval_ 0.
Agent/RTCP set random_ 0
Agent/RTCP set class_ 32

RTPSource set srcid_ -1
NetworkInterface set ifacenum_ 0
NetworkInterface proc getid {} {
$self instvar ifacenum_
return [incr ifacenum_]
}

NetworkInterface instproc init {} {
$self next
$self cmd label [NetworkInterface getid]
}

Channel set delay_ 4us

Classifier/Mac set bcast_ 0

Mac set bandwidth_ 2Mb
Mac set delay_ 0us

if [TclObject is-class Mac/802_11] {
Mac/802_11 set delay_ 64us
Mac/802_11 set ifs_ 16us
Mac/802_11 set slotTime_ 16us
Mac/802_11 set cwmin_ 16
Mac/802_11 set cwmax_ 1024
Mac/802_11 set rtxLimit_ 16
Mac/802_11 set bssId_ -1
Mac/802_11 set sifs_ 8us
Mac/802_11 set pifs_ 12us
Mac/802_11 set difs_ 16us
Mac/802_11 set rtxAckLimit_ 1
Mac/802_11 set rtxRtsLimit_ 3
}

if [TclObject is-class Mac/Mcns] {
Mac/Mcns set bandwidth_ 10Mb
Mac/Mcns set hlen_ 6
Mac/Mcns set bssId_ -1
Mac/Mcns set slotTime_ 10us
}

if [TclObject is-class Mac/Multihop] {
Mac/Multihop set bandwidth_ 100Kb
Mac/Multihop set delay_ 10ms
Mac/Multihop set tx_rx_ 11.125ms
Mac/Multihop set rx_tx_ 13.25ms
Mac/Multihop set rx_rx_ 10.5625
Mac/Multihop set backoffBase_ 20ms
Mac/Multihop set hlen_ 16
}

Mac instproc classify-macs {peerinfo} {
set peerlabel [lindex $peerinfo 0]
set peerll [lindex $peerinfo 1]
$self instvar mclass_
set mclass_ [new Classifier/Mac]
$mclass_ install $peerlabel $peerll
$self target $mclass_
}

Node instproc addmac {mac} { 
$self instvar machead_ mactail_

if ![info exists mactail_] {
set mactail_ [set machead_ $mac]
$mac maclist $mactail_
} else {
$mactail_ maclist $mac
$mac maclist $machead_
set mactail_ $mac
}
}
LL set bandwidth_ 0      ;# not used
LL set delay_ 1ms
LL set macDA_ 0


if [TclObject is-class LL/Arq] {
LL/Arq set mode_ 2
LL/Arq set hlen_ 16
LL/Arq set slen_ 1400
LL/Arq set limit_ 8
LL/Arq set timeout_ 100ms

Class LL/Rlp -superclass LL/Arq
LL/Rlp set mode_ 1
LL/Rlp set hlen_ 6
LL/Rlp set slen_ 30
LL/Rlp set limit_ 63
LL/Rlp set timeout_ 500ms
LL/Rlp set delay_ 70ms
}


if [TclObject is-class Snoop] {
Snoop set snoopTick_ 0.1
Snoop set snoopDisable_ 0
Snoop set srtt_ 0.1
Snoop set rttvar_ 0.25
Snoop set g_ 0.125
Snoop set tailTime_ 0
Snoop set rxmitStatus_ 0
Snoop set lru_ 0
Snoop set maxbufs_ 0
}

if [TclObject is-class LL/LLSnoop] {
LL/LLSnoop set integrate_ 0
LL/LLSnoop set delay_ 0ms
Snoop set srtt_ 0.1
Snoop set rttvar_ 0.25
Snoop set g_ 0.125
LL/LLSnoop set snoopTick_ 0.1
}

LL/LLSnoop instproc get-snoop { src dst } {
$self instvar snoops_ off_ll_ delay_

if { ![info exists snoops_($src:$dst)] } {
set snoops_($src:$dst) [new Snoop]
}
$snoops_($src:$dst) llsnoop $self
$snoops_($src:$dst) set delay_ $delay_
return $snoops_($src:$dst)
}

LL/LLSnoop instproc integrate { src dst } {
$self instvar snoops_

set conn $src:$dst
if {![info exists snoops_($conn)]} {
return
}

set snoop $snoops_($conn)
set threshtime [$snoop set tailTime_]

foreach a [array names snoops_] {
if { $a != $conn } {
$snoops_($a) check-rxmit $threshtime
if { [$snoops_($a) set rxmitStatus_] == 2 } {
break;
}
}
}
}











Class LanNode
LanNode set ifqType_   Queue/DropTail
LanNode set llType_    LL
LanNode set macType_   Mac
LanNode set chanType_  Channel
LanNode set phyType_   Phy/WiredPhy
LanNode set address_   ""

LanNode instproc address  {val} { $self set address_  $val }
LanNode instproc bw       {val} { $self set bw_       $val }
LanNode instproc delay    {val} { $self set delay_    $val }
LanNode instproc ifqType  {val} { $self set ifqType_  $val }
LanNode instproc llType   {val} { $self set llType_   $val }
LanNode instproc macType  {val} { $self set macType_  $val }
LanNode instproc chanType {val} { $self set chanType_ $val }
LanNode instproc phyType  {val} { $self set phyType_  $val }

LanNode instproc init {ns args} {
set args [eval $self init-vars $args]
$self instvar bw_ delay_ ifqType_ llType_ macType_ chanType_
$self instvar phyType_
$self instvar ns_ nodelist_ defRouter_ cost_
$self instvar id_ address_ channel_ mcl_ varp_
$ns instvar Node_

$self next
set ns_ $ns
set nodelist_ ""
set cost_ 1

set id_ [Node getid]
set Node_($id_) $self
if [Simulator set EnableHierRt_] {
if {$address_ == ""} {
error "LanNode: use \"-address\" option  with hierarchical routing"
}
} else {
set address_ $id_
}
set defRouter_ [new LanRouter $ns $self]
if [$ns multicast?] {
set switch_ [new Classifier/Hash/Dest 32]
$switch_ set mask_ [AddrParams set McastMask_]
$switch_ set shift_ [AddrParams set McastShift_]

$defRouter_ switch $switch_
}
set channel_ [new $chanType_]
set varp_ [new VARPTable]
}

LanNode instproc addNode {nodes bw delay {llType ""} {ifqType ""}  {macType ""} {phyType ""}} {
$self instvar ifqType_ llType_ macType_ chanType_ phyType_
$self instvar id_ channel_ mcl_ lanIface_
$self instvar ns_ nodelist_ cost_ varp_
$ns_ instvar link_ Node_ 

if {$ifqType == ""} { set ifqType $ifqType_ }
if {$macType == ""} { set macType $macType_ }
if {$llType  == ""} { set llType $llType_ }
if {$phyType  == ""} { set phyType $phyType_ }

set vlinkcost [expr $cost_ / 2.0]
foreach src $nodes {
set nif [new LanIface $src $self  -ifqType $ifqType  -llType  $llType  -macType $macType  -phyType $phyType]

set tr [$ns_ get-ns-traceall]
if {$tr != ""} {
$nif trace $ns_ $tr
}
set tr [$ns_ get-nam-traceall]
if {$tr != ""} {
$nif nam-trace $ns_ $tr
}


set ll [$nif set ll_]
$ll set delay_ $delay
$ll varp $varp_

$varp_ mac-addr [[$nif set node_] id]  [[$nif set mac_] id]

set phy [$nif set phy_]
$phy node $src
$phy channel $channel_
$channel_ addif $phy
$phy set bandwidth_ $bw

set lanIface_($src) $nif

$src add-neighbor $self

set sid [$src id]
set link_($sid:$id_) [new Vlink $ns_ $self $src  $self $bw 0]
set link_($id_:$sid) [new Vlink $ns_ $self $self $src  $bw 0]

$src add-oif [$link_($sid:$id_) head]  $link_($sid:$id_)
$src add-iif [[$nif set iface_] label] $link_($id_:$sid)
[$link_($sid:$id_) head] set link_ $link_($sid:$id_)

$link_($sid:$id_) queue [$nif set ifq_]
$link_($id_:$sid) queue [$nif set ifq_]

$link_($sid:$id_) set iif_ [$nif set iface_]
$link_($id_:$sid) set iif_ [$nif set iface_]

$link_($sid:$id_) cost $vlinkcost
$link_($id_:$sid) cost $vlinkcost
}
set nodelist_ [concat $nodelist_ $nodes]
}

LanNode instproc assign-mac {ip} {
return $ip ;# use ip addresses at MAC layer
}

LanNode instproc cost c {
$self instvar ns_ nodelist_ id_ cost_
$ns_ instvar link_
set cost_ $c
set vlinkcost [expr $c / 2.0]
foreach node $nodelist_ {
set nid [$node id]
$link_($id_:$nid) cost $vlinkcost
$link_($nid:$id_) cost $vlinkcost
}
}

LanNode instproc cost? {} {
$self instvar cost_
return $cost_
}

LanNode instproc rtObject? {} {
}

LanNode instproc id {} { $self set id_ }

LanNode instproc node-addr {{addr ""}} { 
eval $self set address_ $addr
}

LanNode instproc reset {} {
}

LanNode instproc is-lan? {} { return 1 }

LanNode instproc dump-namconfig {} {
$self instvar ns_ bw_ delay_ nodelist_ id_
$ns_ puts-nam-config  "X -t * -n $id_ -r $bw_ -D $delay_ -o left"
set cnt 0
set LanOrient(0) "up"
set LanOrient(1) "down"

foreach n $nodelist_ {
$ns_ puts-nam-config  "L -t * -s $id_ -d [$n id] -o $LanOrient($cnt)"
set cnt [expr 1 - $cnt]
}
}

LanNode instproc init-outLink {} { 
}

LanNode instproc start-mcast {} { 
}

LanNode instproc getArbiter {} {
}

LanNode instproc attach {agent} {
}

LanNode instproc add-route {args} {
}

LanNode instproc add-hroute {args} {
}

LanNode instproc split-addrstr addrstr {
set L [split $addrstr .]
return $L
}


Class LanIface 
LanIface set ifqType_ Queue/DropTail
LanIface set macType_ Mac
LanIface set llType_  LL
LanIface set phyType_  Phy/WiredPhy

LanIface instproc llType {val} { $self set llType_ $val }
LanIface instproc ifqType {val} { $self set ifqType_ $val }
LanIface instproc macType {val} { $self set macType_ $val }
LanIface instproc phyType {val} { $self set phyType_ $val }

LanIface instproc entry {} { $self set entry_ }
LanIface instproc init {node lan args} {
set args [eval $self init-vars $args]
eval $self next $args

$self instvar llType_ ifqType_ macType_ phyType_
$self instvar node_ lan_ ifq_ mac_ ll_ phy_
$self instvar iface_ entry_ drophead_

set node_ $node
set lan_ $lan

set ll_ [new $llType_]
set ifq_ [new $ifqType_]
set mac_ [new $macType_]
set iface_ [new NetworkInterface]
set phy_ [new $phyType_]

set entry_ [new Connector]
set drophead_ [new Connector]

$ll_ set macDA_ -1	;# bcast address if there is no LAN router
$ll_ lanrouter [$lan set defRouter_]
$ll_ up-target $iface_
$ll_ down-target $ifq_
$ll_ mac $mac_

$ifq_ target $mac_

$mac_ up-target $ll_
$mac_ down-target $phy_
$mac_ netif $phy_

$phy_ up-target $mac_

$node addInterface $iface_
$iface_ target [$node entry]
$entry_ target $ll_

set ns [Simulator instance]

$drophead_ target [$ns set nullAgent_]

$ifq_ drop-target $drophead_ 
$mac_ drop-target $drophead_ 
$ll_ drop-target $drophead_
}

LanIface instproc trace {ns f {op ""}} {
$self instvar hopT_ rcvT_ enqT_ deqT_ drpT_ 
$self instvar iface_ entry_ node_ lan_ drophead_ 
$self instvar ll_ ifq_

set hopT_ [$ns create-trace Hop   $f $node_ $lan_  $op]
set rcvT_ [$ns create-trace Recv  $f $lan_  $node_ $op]
set enqT_ [$ns create-trace Enque $f $node_ $lan_  $op]
set deqT_ [$ns create-trace Deque $f $node_ $lan_  $op]
set drpT_ [$ns create-trace Drop  $f $node_ $lan_  $op]

$hopT_ target [$entry_ target]
$entry_ target $hopT_

$rcvT_ target [$iface_ target]
$iface_ target $rcvT_

$enqT_ target [$ll_ down-target]
$ll_ down-target $enqT_

$deqT_ target [$ifq_ target]
$ifq_ target $deqT_

$drpT_ target [$drophead_ target]
$drophead_ target $drpT_
}
LanIface instproc nam-trace {ns f} {
$self instvar hopT_ rcvT_ enqT_ deqT_ drpT_ 
if [info exists hopT_] {
$hopT_ namattach $f
} else {
$self trace $ns $f "nam"
}
$rcvT_ namattach $f
$enqT_ namattach $f
$deqT_ namattach $f
$drpT_ namattach $f
}
LanIface instproc add-receive-filter filter {
$self instvar mac_
$filter target [$mac_ target]
$mac_ target $filter
}


Class Vlink
Vlink instproc up? {} {
return "up"
}
Vlink instproc queue {{q ""}} {
eval $self set queue_ $q
}
Vlink instproc init {ns lan src dst b d} {
$self instvar ns_ lan_ src_ dst_ bw_ delay_

set ns_ $ns
set lan_ $lan
set src_ $src
set dst_ $dst
set bw_ $b
set delay_ $d
}
Vlink instproc src {}	{ $self set src_	}
Vlink instproc dst {}	{ $self set dst_	}
Vlink instproc dump-nam-queueconfig {} {
}
Vlink instproc head {} {
$self instvar lan_ dst_ src_
if {$src_ == $lan_ } {
return ""
} else {
set src_lif [$lan_ set lanIface_($src_)]
return [$src_lif entry]
}
}
Vlink instproc cost c { $self set cost_ $c}	
Vlink instproc cost? {} {
$self instvar cost_
if ![info exists cost_] {
return 1
}
return $cost_
}


LanRouter instproc init {ns lan} {
$self next
Simulator instvar EnableHierRt_
if {$EnableHierRt_} {
$self routing hier
} else {
$self routing flat
}
$self lanaddr [$lan node-addr]
$self routelogic [$ns get-routelogic]
}


Node instproc is-lan? {} { return 0 }

Simulator instproc newLan {nodelist bw delay args} {
set lan [eval new LanNode $self -bw $bw -delay $delay $args]
$lan addNode $nodelist $bw $delay
return $lan
}

Simulator instproc make-lan {nodelist bw delay  {llType LL}  {ifqType Queue/DropTail}  {macType Mac}  {chanType Channel}  {phyType Phy/WiredPhy}} {
if {[string compare $macType "Mac/Csma/Cd"] == 0} {
puts "Warning: Mac/Csma/Cd is out of date"
puts "Warning: Please use Mac/802_3 to replace Mac/Csma/Cd"
set macType "Mac/802_3"
}
set lan [new LanNode $self  -bw $bw  -delay $delay  -llType $llType  -ifqType $ifqType  -macType $macType  -chanType $chanType  -phyType $phyType]
$lan addNode $nodelist $bw $delay $llType $ifqType $macType  $phyType

return $lan
}














Class Timer

Timer instproc init { ns } {
$self set ns_ $ns
}

Timer instproc sched delay {
$self instvar ns_
$self instvar id_
$self cancel
set id_ [$ns_ after $delay "$self timeout"]
}

Timer instproc destroy {} {
$self cancel
}

Timer instproc cancel {} {
$self instvar ns_
$self instvar id_
if [info exists id_] {
$ns_ cancel $id_
unset id_
}
}

Timer instproc resched delay {
$self sched $delay 
}

Timer instproc expire {} {
$self timeout
}


Class Timer/Iface -superclass Timer

Timer/Iface instproc init { protocol source group oiface sim} {
$self instvar proto_ src_ grp_ oif_
$self next $sim
set proto_ $protocol
set src_ $source
set grp_ $group
set oif_ $oiface
}

Timer/Iface instproc schedule {} {
$self sched [[$self info class] set timeout]
}


Class MultiSim -superclass Simulator

MultiSim instproc init args {
eval $self next $args
$self multicast on
}

Simulator instproc multicast args {
$self set multiSim_ 1
}

Simulator instproc multicast? {} {
$self instvar multiSim_
if { ![info exists multiSim_] } {
set multiSim_ 0
}
set multiSim_
}

Simulator instproc run-mcast {} {
$self instvar Node_
foreach n [array names Node_] {
set node $Node_($n)
$node start-mcast
}
$self next
}

Simulator instproc clear-mcast {} {
$self instvar Node_
foreach n [array names Node_] {
$Node_($n) stop-mcast
}
}
Simulator instproc mrtproto { mproto { nodelist "" } } {
$self instvar Node_ MrtHandle_

set MrtHandle_ ""
if { $mproto == "CtrMcast" } {
set MrtHandle_ [new CtrMcastComp $self]
$MrtHandle_ set ctrrpcomp [new CtrRPComp $self]
}

if { $mproto == "BST" } {
foreach n [array names Node_] {
if ![$Node_($n) is-lan?] {
$Node_($n) instvar multiclassifier_ switch_
set multiclassifier_ [new Classifier/Multicast/Replicator/BST]
[$Node_($n) set multiclassifier_] set node_ $Node_($n)
$switch_ install 1 $multiclassifier_
}

}
}

if { $nodelist == "" } {
foreach n [array names Node_] {
$self mrtproto-iifs $mproto $Node_($n) ""
}
} else {
foreach node $nodelist {
$self mrtproto-iifs $mproto $node ""
}
}
$self at 0.0 "$self run-mcast"

return $MrtHandle_
}
Simulator instproc mrtproto-iifs {mproto node iiflist } {
set mh [new $mproto $self $node]
set arbiter [$node getArbiter]
if { $arbiter != "" } {
$arbiter addproto $mh $iiflist
}
}

Node proc allocaddr {} {
set addr [Simulator set McastAddr_]
Simulator set McastAddr_ [expr $addr + 1]
return $addr
}

Node proc expandaddr {} {

set ns [Simulator instance]
$ns set-address-format expanded
puts "Backward compatibility: Use \"set-address-format expanded\" instead of \"Node expandaddr\";" 

}

Node instproc start-mcast {} {
$self instvar mrtObject_
$mrtObject_ start
}

Node instproc getArbiter {} {
$self instvar mrtObject_
if [info exists mrtObject_] {
return $mrtObject_
}
return ""
}

Node instproc notify-mcast changes {
$self instvar mrtObject_
if [info exists mrtObject_] {
$mrtObject_ notify $changes
}
}

Node instproc stop-mcast {} {
$self instvar mrtObject_
$self clear-caches
$mrtObject_ stop
}

Node instproc clear-caches {} {
$self instvar Agents_  multiclassifier_ replicator_

$multiclassifier_ clearAll
$multiclassifier_ set nrep_ 0

foreach var {Agents_ replicator_} {
$self instvar $var
if { [info exists $var] } {
delete $var
unset $var
}
}
}

Node instproc dump-routes args {
$self instvar mrtObject_
if { [info exists mrtObject_] } {
eval $mrtObject_ dump-routes $args
}
}

Node instproc check-local { group } {
$self instvar Agents_
if [info exists Agents_($group)] {
return [llength $Agents_($group)]
}
return 0
}

Node instproc new-group { src group iface code } {
$self instvar mrtObject_
$mrtObject_ upcall $code $src $group $iface
}

Node instproc join-group { agent group { src "" } } {
$self instvar replicator_ Agents_ mrtObject_
set group [expr $group] ;# use expr to convert to decimal

$mrtObject_ join-group $group $src

lappend Agents_($group) $agent
if { $src == "" } {
set reps [$self getReps "*" $group]
} else {
set reps [$self getReps $src $group]
}
foreach rep $reps {
$rep insert $agent
}
}

Node instproc leave-group { agent group { src "" } } {
$self instvar replicator_ Agents_ mrtObject_
set group [expr $group] ;# use expr to get rid of possible leading 0x
if { $src == "" } {
set reps [$self getReps "*" $group]
} else {
set reps [$self getReps $src $group]
}
foreach rep $reps  {
$rep disable $agent
}
if [info exists Agents_($group)] {
set k [lsearch -exact $Agents_($group) $agent]
set Agents_($group) [lreplace $Agents_($group) $k $k]

$mrtObject_ leave-group $group $src
} else {
warn "cannot leave a group without joining it"
}
}



Node instproc add-mfc { src group iif oiflist } {
$self instvar multiclassifier_  replicator_ Agents_ 

if [info exists replicator_($src:$group)] {
set r $replicator_($src:$group)
} else {
set r [new Classifier/Replicator/Demuxer]
$r set srcID_ $src
$r set grp_ $group
set replicator_($src:$group) $r
$r set node_ $self
if [info exists Agents_($group)] {
foreach a $Agents_($group) {
$r insert $a
}
}
if [info exists Agents_($src:$group)] {
foreach a $Agents_($src:$group) {
$r insert $a
}
}
$multiclassifier_ add-rep $r $src $group $iif
}

foreach oif [lsort $oiflist] {
$r insert $oif
}
}

Node instproc del-mfc { srcID group oiflist } {
$self instvar replicator_ multiclassifier_
if [info exists replicator_($srcID:$group)] {
set r $replicator_($srcID:$group)  
foreach oif $oiflist {
$r disable $oif
}
return 1
} 
return 0
}

Class Classifier/Multicast/Replicator -superclass Classifier/Multicast

Classifier/Multicast instproc new-group { src group iface code} {
$self instvar node_
$node_ new-group $src $group $iface $code
}

Classifier/Multicast instproc no-slot slot {
}

Classifier/Multicast/Replicator instproc init args {
$self next
$self instvar nrep_
set nrep_ 0
}

Classifier/Multicast/Replicator instproc add-rep { rep src group iif } {
$self instvar nrep_
$self set-hash $src $group $nrep_ $iif
$self install $nrep_ $rep
incr nrep_
}

Class Classifier/Replicator/Demuxer -superclass Classifier/Replicator
Classifier/Replicator/Demuxer set ignore_ 0
Classifier/Replicator/Demuxer instproc init args {
eval $self next $args
$self instvar nslot_ nactive_
set nactive_ 0
}

Classifier/Replicator/Demuxer instproc is-active {} {
$self instvar nactive_
expr $nactive_ > 0
}

Classifier/Replicator/Demuxer instproc insert target {
$self instvar nactive_ active_ 

if ![info exists active_($target)] {
set active_($target) -1
}
if {$active_($target) < 0} {
$self enable $target
}
}

Classifier/Replicator/Demuxer instproc dump-oifs {} {
set oifs ""
if [$self is-active] {
$self instvar active_
foreach target [array names active_] {
if { $active_($target) >= 0 } {
lappend oifs [$self slot $active_($target)]
}
}
}
return [lsort $oifs]
}

Classifier/Replicator/Demuxer instproc disable target {
$self instvar nactive_ active_
if {[info exists active_($target)] && $active_($target) >= 0} {
$self clear $active_($target)
set active_($target) -1
incr nactive_ -1
}
}

Classifier/Replicator/Demuxer instproc enable target {
$self instvar nactive_ active_ ignore_
if {$active_($target) < 0} {
set active_($target) [$self installNext $target]
incr nactive_
set ignore_ 0
}
}

Classifier/Replicator/Demuxer instproc exists target {
$self instvar active_
info exists active_($target)
}

Classifier/Replicator/Demuxer instproc is-active-target target {
$self instvar active_
if { [info exists active_($target)] && $active_($target) >= 0 } {
return 1
} else {
return 0
}
}

Classifier/Replicator/Demuxer instproc drop { src dst {iface -1} } {
$self instvar node_
[$node_ getArbiter] drop $self $src $dst $iface
}

Node instproc change-iface { src dst oldiface newiface} {
$self instvar multiclassifier_
$multiclassifier_ change-iface $src $dst $oldiface $newiface
}

Node instproc lookup-iface { src dst } {
$self instvar multiclassifier_
$multiclassifier_ lookup-iface $src $dst
}

Classifier/Replicator/Demuxer instproc reset {} {
$self instvar nactive_ active_
foreach { target slot } [array get active_] {
$self clear $slot
}
set nactive_ 0
unset active_
}


Agent/Mcast/Control instproc init { protocol } {
$self next
$self instvar proto_
set proto_ $protocol
}

Agent/Mcast/Control array set messages {}
Agent/Mcast/Control set mcounter 0

Agent/Mcast/Control instproc send {type from src group args} {
Agent/Mcast/Control instvar mcounter messages
set messages($mcounter) [concat [list $from $src $group] $args]
$self cmd send $type $mcounter
incr mcounter
}

Agent/Mcast/Control instproc recv {type iface m} {
Agent/Mcast/Control instvar messages
eval $self recv2 $type $iface $messages($m)
}

Agent/Mcast/Control instproc recv2 {type iface from src group args} {
$self instvar proto_
eval $proto_ recv-$type $from $src $group $iface $args
}

Node instproc rpf-nbr src {
$self instvar ns_ id_
if [catch "$src id" srcID] {	
set srcID $src
}
$ns_ get-node-by-id [[$ns_ get-routelogic] lookup $id_ $srcID]
}

LanNode instproc rpf-nbr src {
$self instvar ns_ id_
if [catch "$src id" srcID] {	
set srcID $src
}
$ns_ get-node-by-id [[$ns_ get-routelogic] lookup $id_ $srcID]
}

Node instproc getReps { src group } {
$self instvar replicator_
set reps ""
foreach key [array names replicator_ "$src:$group"] { 
lappend reps $replicator_($key)
}
return [lsort $reps]
}

Node instproc getReps-raw { src group } {
$self array get replicator_ "$src:$group"
}

Node instproc clearReps { src group } {
$self instvar multiclassifier_
foreach {key rep} [$self getReps-raw $src $group] {
$rep reset
delete $rep

foreach {slot val} [$multiclassifier_ adjacents] {
if { $val == $rep } {
$multiclassifier_ clear $slot
}
}

$self unset replicator_($key)
}
}

Node instproc add-oif {head link} {
$self instvar outLink_
set outLink_($head) $link
}

Node instproc add-iif {iflbl link} {
$self set inLink_($iflbl) $link
}

Node instproc get-all-oifs {} {
$self instvar outLink_
return [lsort [array names outLink_]]
}

Node instproc get-all-iifs {} {
$self instvar inLink_
return [array names inLink_]
}

Node instproc iif2oif ifid {
$self instvar ns_
set link [$self iif2link $ifid]
set outlink [$ns_ link $self [$link src]]
return [$self link2oif $outlink]
}

Node instproc iif2link ifid {
$self set inLink_($ifid)
}

Node instproc link2iif link {
return [[$link set iif_] label]
}

Node instproc link2oif link {
$link head
}

Node instproc oif2link oif {
$oif set link_
}

Node instproc from-node-iface { node } {
$self instvar ns_
catch {
set node [$ns_ get-node-by-id $node]
}
set rpfnbr [$self rpf-nbr $node]
set rpflink [$ns_ link $rpfnbr $self]
if { $rpflink != "" } {
return [$rpflink if-label?]
}
return "?" ;#unknown iface
}

Vlink instproc if-label? {} {
$self instvar iif_
$iif_ label
}
Class McastProtocol

McastProtocol instproc init {sim node} {
$self next
$self instvar ns_ node_ status_ type_ id_
set ns_   $sim
set node_ $node
set status_ "down"
set type_   [$self info class]
set id_ [$node id]

$ns_ maybeEnableTraceAll $self $node_
}

McastProtocol instproc getType {} { $self set type_ }

McastProtocol instproc start {}		{ $self set status_ "up"   }
McastProtocol instproc stop {}		{ $self set status_"down"  }
McastProtocol instproc getStatus {}	{ $self set status_	   }

McastProtocol instproc upcall {code args} {
eval $self handle-$code $args
}

McastProtocol instproc handle-wrong-iif { srcID group iface } {
return 0
}

McastProtocol instproc handle-cache-miss { srcID group iface } {
return 0
}

McastProtocol instproc annotate args {
$self instvar dynT_ node_ ns_
set s "[$ns_ now] [$node_ id] $args" ;#nam wants uinique first arg???
if [info exists dynT_] {
foreach tr $dynT_ {
$tr annotate $s
}
}
}

McastProtocol instproc join-group arg	{ 
$self annotate $proc $arg 
}
McastProtocol instproc leave-group arg	{ 
$self annotate $proc $arg
}

McastProtocol instproc trace { f src {op ""} } {
$self instvar ns_ dynT_
if {$op == "nam" && [info exists dynT_] > 0} {
foreach tr $dynT_ {
$tr namattach $f
}
} else {
lappend dynT_ [$ns_ create-trace Generic $f $src $src $op]
}
}
McastProtocol instproc notify { dummy } {
$self instvar ns_ node_ PruneTimer_

foreach r [$node_ getReps "*" "*"] {
set src_id [$r set srcID_]
set sources($src_id) 1
}
set sourceIDs [array names sources]
foreach src_id $sourceIDs {
set src [$ns_ get-node-by-id $src_id]
if {$src != $node_} {
set upstream [$node_ rpf-nbr $src]
if { $upstream != ""} {
set inlink [$ns_ link $upstream $node_]
set newiif [$node_ link2iif $inlink]
set reps [$node_ getReps $src_id "*"]
foreach r $reps {
set oldiif [$node_ lookup-iface $src_id [$r set grp_]]
if { $oldiif != $newiif } {
$node_ change-iface $src_id [$r set grp_] $oldiif $newiif
}
}
}
}
set oiflist ""
foreach nbr [$node_ neighbors] {
set nbr_id [$nbr id]
set nh [$nbr rpf-nbr $src] 
if { $nh != $node_ } {
continue
}
set oif [$node_ link2oif [$ns_ link $node_ $nbr]]
set oifs($oif) 1
}
set oiflist [array names oifs]

set reps [$node_ getReps $src_id "*"]
foreach r $reps {
set grp [$r set grp_]
set oldoifs [$r dump-oifs]
set newoifs $oiflist
foreach old $oldoifs {
if [catch "$node_ oif2link $old" ] {
continue
}
set idx [lsearch $newoifs $old]
if { $idx < 0} {
$r disable $old
if [info exists PruneTimer_($src_id:$grp:$old)] {
delete $PruneTimer_($src_id:$grp:$old)
unset PruneTimer_($src_id:$grp:$old)
}
} else {
set newoifs [lreplace $newoifs $idx $idx]
}
}
foreach new $newoifs {
foreach r $reps {
$r insert $new
}
}
}
}
}

McastProtocol instproc dump-routes {chan {grp ""} {src ""}} {
$self instvar ns_ node_
if { $grp == "" } {
array set reps [$node_ getReps-raw * *]
} elseif { $src == "" } {
array set reps [$node_ getReps-raw * $grp]  ;# actually, more than *,g
} else {
array set reps [$node_ getReps-raw $src $grp]
}
puts $chan [concat "Node:\t${node_}([$node_ id])\tat t ="	 [format "%4.2f" [$ns_ now]]]
puts $chan "\trepTag\tActive\t\tsrc\tgroup\tiifNode\t\tdest_nodes"
foreach ent [lsort [array names reps]] {
set sg [split $ent ":"]
if { [$reps($ent) is-active] } {
set active Y
} else {
set active N
}
set dest ""
foreach oif [$reps($ent) dump-oifs] {
if ![catch { set nbr [[$node_ oif2link $oif] dst] } ] {
set nbrid [$nbr id]
if [$nbr is-lan?] {
set nbrid ${nbrid}(L)
}
lappend dest $nbrid
}
}
set s [lindex $sg 0]
set g [lindex $sg 1]
set iif [$node_ lookup-iface $s $g]

set iif_node_id $iif
catch {
set iif_node [[$node_ iif2link $iif] src]
if [$iif_node is-lan?] {
set iif_node_id [$iif_node id](L)
} else {
set iif_node_id [$iif_node id]
}
}

puts $chan [format "\t%5s\t  %s\t\t%d\t0x%x\t%s\t\t%s"	 $reps($ent) $active $s $g $iif_node_id $dest]
}
}


Class mrtObject

mrtObject set mask-wkgroups	0xfff0
mrtObject set wkgroups(Allocd)	[mrtObject set mask-wkgroups]

mrtObject proc registerWellKnownGroups name {
set newGroup [mrtObject set wkgroups(Allocd)]
mrtObject set wkgroups(Allocd) [expr $newGroup + 1]
mrtObject set wkgroups($name)  $newGroup
}

mrtObject proc getWellKnownGroup name {
assert "\"$name\" != \"Allocd\""
mrtObject set wkgroups($name)
}

mrtObject registerWellKnownGroups ALL_ROUTERS
mrtObject registerWellKnownGroups ALL_PIM_ROUTERS

mrtObject proc expandaddr {} {
mrtObject set mask-wkgroups	0x7fffffff

foreach {name group} [mrtObject array get wkgroups] {
mrtObject set wkgroups($name) [expr $group | 0x7fffffff]
}
}

mrtObject instproc init { node } {
$self next
$self set node_	     $node
}

mrtObject instproc addproto { proto { iiflist "" } } {
$self instvar node_ protocols_
if { $iiflist == "" } {
set iiflist [$node_ get-all-iifs]
lappend iiflist -1 ;#for local packets
}
foreach iif $iiflist {
set protocols_($iif) $proto
}
}

mrtObject instproc getType { protocolType } {
$self instvar protocols_
foreach iif [array names protocols_] {
if { [$protocols_($iif) getType] == $protocolType } {
return $protocols_($iif)
}
}
return ""
}

mrtObject instproc all-mprotos {op args} {
$self instvar protocols_
foreach iif [array names protocols_] {
set p $protocols_($iif)
if ![info exists protos($p)] {
set protos($p) 1
eval $p $op $args
}
}
}

mrtObject instproc start {}	{ $self all-mprotos start	}
mrtObject instproc stop {}	{ $self all-mprotos stop	}
mrtObject instproc notify dummy { $self all-mprotos notify $dummy }
mrtObject instproc dump-routes args {
$self all-mprotos dump-routes $args
}

mrtObject instproc join-group { grp src } {
eval $self all-mprotos join-group $grp $src
}

mrtObject instproc leave-group { grp src } {
eval $self all-mprotos leave-group $grp $src
}

mrtObject instproc upcall { code source group iface } {
set wkgroup [expr [$class set mask-wkgroups]]
if { [expr ( $group & $wkgroup ) == $wkgroup] } {
$self instvar node_
$node_ add-mfc $source $group -1 {}
return 1
} else {
$self instvar protocols_
$protocols_($iface) upcall $code $source $group $iface
}
}

mrtObject instproc drop { replicator src dst {iface -1} } {
$self instvar protocols_
$protocols_($iface) drop $replicator $src $dst $iface
}

Class DM -superclass McastProtocol

DM set PruneTimeout  0.5
DM set CacheMissMode pimdm ;#or dvmrp (lowercase)

DM instproc init { sim node } {
$self instvar mctrl_
set mctrl_ [new Agent/Mcast/Control $self]
$node attach $mctrl_
Timer/Iface/Prune set timeout [[$self info class] set PruneTimeout]
$self next $sim $node
}

DM instproc join-group  { group } {
$self instvar node_
$self next $group
set listOfReps [$node_ getReps * $group]
foreach r $listOfReps {
if ![$r is-active] {
$self send-ctrl "graft" [$r set srcID_] $group
set nbr [$node_ rpf-nbr [$r set srcID_]]
set nbrs($nbr) 1
}
}
foreach nbr [array names nbrs] {
if [$nbr is-lan?] {
$nbr instvar receivers_
if [info exists receivers_($group)] {
incr receivers_($group)
} else {
set receivers_($group) 1
}
}
}
}

DM instproc leave-group { group } {
$self next $group

$self instvar node_
set listOfReps [$node_ getReps * $group]
foreach r $listOfReps {
set nbr [$node_ rpf-nbr [$r set srcID_]]
set nbrs($nbr) 1
}
foreach nbr [array names nbrs] {
if [$nbr is-lan?] {
$nbr instvar receivers_
if { [info exists receivers_($group)] &&  $receivers_($group) > 0 } {
incr receivers_($group) -1
}
}
}
}

DM instproc handle-wrong-iif { srcID group iface } {
$self instvar node_ ns_
set inlink  [$node_ iif2link $iface]
set from [$inlink src]
$self send-ctrl "prune" $srcID $group [$from id]
return 0 ;# don't call this method two times
}

DM instproc handle-cache-miss  { srcID group iface } {
DM instvar CacheMissMode
$self handle-cache-miss-$CacheMissMode $srcID $group $iface
return 1 ;#call again
}

DM instproc handle-cache-miss-pimdm { srcID group iface } {
$self instvar node_ ns_

if { $iface >= 0 } {
set rpf_nbr [$node_ rpf-nbr $srcID]
set inlink  [$node_ iif2link $iface]
set rpflink [$ns_ link $rpf_nbr $node_]

if { $inlink != $rpflink } {
set from [$inlink src]
$self send-ctrl "prune" $srcID $group [$from id]
return 0; #drop this packet
}
set rpfoif [$node_ iif2oif $iface]
} else {
set rpfoif ""
}
set alloifs [$node_ get-all-oifs]
set oiflist ""
foreach oif $alloifs {
if {$oif == $rpfoif} {
continue ;#exclude incoming iface
}
set dst [[$node_ oif2link $oif] dst]
if { [$dst is-lan?] && [$dst rpf-nbr $srcID] != $node_  } {
continue 
}
lappend oiflist $oif
}

$node_ add-mfc $srcID $group $iface $oiflist
}

DM instproc handle-cache-miss-dvmrp { srcID group iface } {
$self instvar node_ ns_

set oiflist ""
foreach nbr [$node_ neighbors] {
set rpfnbr [$nbr rpf-nbr $srcID]
if { $rpfnbr == $node_ } {
set link [$ns_ link $node_ $nbr]
lappend oiflist [$node_ link2oif $link]
}

}
$node_ add-mfc $srcID $group $iface $oiflist
}

DM instproc drop { replicator src dst iface} {
$self instvar node_ ns_

if { $iface < 0 } {
$replicator set ignore_ 1
} else {
set from [[$node_ iif2link $iface] src]
if [$from is-lan?] {
$self send-ctrl "prune" $src $dst
} else {
$self send-ctrl "prune" $src $dst [$from id]
}
}
}

DM instproc recv-prune { from src group iface} {
$self instvar node_ PruneTimer_ ns_

set r [$node_ getReps $src $group]
if { $r == "" } { 
return 0
}
set id [$node_ id]
set tmpoif [$node_ iif2oif $iface]

if { [$r is-active-target $tmpoif] } {
$r disable $tmpoif
if ![$r is-active] {
if { $src != $id } {
$self send-ctrl prune $src $group
}
}
}
if ![info exists PruneTimer_($src:$group:$tmpoif)] {
set PruneTimer_($src:$group:$tmpoif)  [new Timer/Iface/Prune $self $src $group $tmpoif $ns_]
}
$PruneTimer_($src:$group:$tmpoif) schedule

}

DM instproc recv-graft { from src group iface} {
$self instvar node_ PruneTimer_ ns_

set id [$node_ id]
set r [$node_ getReps $src $group]
if { $r == "" } {
if { $id == $src } {
set iif "?"
} else {
set rpfnbr [$node_ rpf_nbr $src]
set rpflnk [$ns_ link $src $id]
set iif [$node_ link2iif $rpflnk]
}
$node_ add-mfc $src $group $iif ""
set r [$node_ getReps $src $group]
} 
if { ![$r is-active] && $src != $id } {
$self send-ctrl graft $src $group
}
set tmpoif [$node_ iif2oif $iface]
$r enable $tmpoif
if [info exists PruneTimer_($src:$group:$tmpoif)] {
delete $PruneTimer_($src:$group:$tmpoif)
unset  PruneTimer_($src:$group:$tmpoif)
}
}

DM instproc send-ctrl { which src group { to "" } } {
$self instvar mctrl_ ns_ node_
if { $to != "" } {
set n [$ns_ get-node-by-id $to]
if [$n is-lan?] return
set toid $to
} else {
set toid $src
}
set nbr [$node_ rpf-nbr $toid]
if [$nbr is-lan?] {
$nbr instvar receivers_
if { [info exists receivers_($group)] &&  $receivers_($group) > 0 } return 
set nbr [$nbr rpf-nbr $toid]
}
$ns_ simplex-connect $mctrl_  [[[$nbr getArbiter] getType [$self info class]] set mctrl_]
if { $which == "prune" } {
$mctrl_ set class_ 30
} else {
$mctrl_ set class_ 31
}        
$mctrl_ send $which [$node_ id] $src $group
}

DM instproc timeoutPrune { oif src grp } {
$self instvar node_ PruneTimer_ ns_
set r [$node_ getReps $src $grp]

$r insert $oif
if [info exists PruneTimer_($src:$grp:$oif)] {
delete $PruneTimer_($src:$grp:$oif)
unset PruneTimer_($src:$grp:$oif)
}
return
}


Class Timer/Iface/Prune -superclass Timer/Iface
Timer/Iface/Prune set timeout 0.5

Timer/Iface/Prune instproc timeout {} {
$self instvar proto_ src_ grp_ oif_
$proto_ timeoutPrune $oif_ $src_ $grp_
}



Class CtrMcast -superclass McastProtocol

CtrMcast instproc init { sim node } {
$self next $sim $node
$self instvar ns_ node_
$self instvar agent_ defaultTree_ decapagent_
$self instvar c_rp_ c_bsr_ priority_

set agent_ [$ns_ set MrtHandle_]

set defaultTree_ "RPT"

set decapagent_ [new Agent/Decapsulator]
$ns_ attach-agent $node_ $decapagent_

set c_rp_      1
set c_bsr_     1
set priority_  0
}

CtrMcast instproc join-group  { group } {
$self next $group
$self instvar node_ ns_ agent_
$self instvar defaultTree_

if { [$agent_ treetype? $group] == "" } {
$agent_ treetype $group $defaultTree_
$agent_ add-new-group $group
}

$agent_ add-new-member $group $node_

foreach src [$agent_ sources? $group] {
$agent_ compute-branch $src $group $node_
}
}

CtrMcast instproc leave-group  { group } {
$self next $group
$self instvar node_ ns_ agent_ defaultTree_

$agent_ remove-member $group $node_
foreach src [$agent_ sources? $group] {
$agent_ prune-branch $src $group $node_
}
}

CtrMcast instproc handle-cache-miss { srcID group iface } {
$self instvar ns_ agent_ node_
$self instvar defaultTree_

if { [$agent_ treetype? $group] == "" } {
$agent_ treetype $group $defaultTree_
}
if { [$node_ id] == $srcID } {
set RP [$self get_rp $group]
if {[$agent_ treetype? $group] == "RPT" && $srcID != [$RP id]} {
set encapagent [new Agent/Encapsulator]
$ns_ attach-agent $node_ $encapagent

set ctrmcast [[$RP getArbiter] getType "CtrMcast"]
$ns_ connect $encapagent [$ctrmcast set decapagent_]

$node_ add-mfc-reg $srcID $group -1 $encapagent
}

if [$agent_ new-source? $group $node_] {
$agent_ compute-tree $node_ $group
}
} elseif [SessionSim set MixMode_] {
set srcnode [$ns_ get-node-by-id $srcID]
if [$agent_ new-source? $group $srcnode] {
$agent_ compute-tree $srcnode $group
}
}
return 1 ;#call again
}

CtrMcast instproc drop  { replicator src group iface } {
}

CtrMcast instproc handle-wrong-iif { srcID group iface } {
warn "$self: $proc for <S: $srcID, G: $group, if: $iface>?"
return 0 ;#call once
}

CtrMcast instproc notify { dummy } {
}
CtrMcast instproc get_rp group {
$self instvar rpset_ agent_

if ![info exists rpset_] {
[$agent_ set ctrrpcomp] compute-rpset
assert [info exists rpset_]
}
set returnrp -1
set hashval -1
foreach rp $rpset_ {
if {[$self hash $rp $group] > $hashval} {
set hashval [$self hash $rp $group]
set returnrp $rp
}
}
set returnrp		;# return
}

CtrMcast instproc hash {rp group} {
$rp id
}

CtrMcast instproc set-rpset args {
eval $self set rpset_ "$args"
}

CtrMcast instproc get_bsr {} {
warn "$self: CtrMcast doesn't require a BSR"
}

CtrMcast instproc set_c_bsr { prior } {
$self instvar c_bsr_ priority_
set c_bsr_ 1
set priority_ $prior
}

CtrMcast instproc set_c_rp {} {
$self instvar c_rp_
set c_rp_ 1
}

CtrMcast instproc unset_c_rp {} {
$self instvar c_rp_
set c_rp_ 0
}


Node instproc add-mfc-reg { src group iif oiflist } {
$self instvar multiclassifier_ Regreplicator_


if [info exists Regreplicator_($group)] {
foreach oif $oiflist {
$Regreplicator_($group) insert $oif
}
return 1
}
set r [new Classifier/Replicator/Demuxer]
$r set node_ $self
$r set srcID_ $src
set Regreplicator_($group) $r

foreach oif $oiflist {
$r insert $oif
}

$multiclassifier_ add-rep $r $src $group $iif
}

Node instproc getRegreplicator group {
$self instvar Regreplicator_
if [info exists Regreplicator_($group)] {
return $Regreplicator_($group)
} else {
return -1
}
}

Class CtrMcastComp

CtrMcastComp instproc init sim {
$self instvar ns_

set ns_ $sim
$self init-groups
$ns_ maybeEnableTraceAll $self {}
}

CtrMcastComp instproc id {} {
return 0
}

CtrMcastComp instproc trace { f nop {op ""} } {
$self instvar ns_ dynT_
if {$op == "nam" && [info exists dynT_]} {
foreach tr $dynT_ {
$tr namattach $f
}
} else {
lappend dynT_ [$ns_ create-trace Generic $f $self $self $op]
}
}

CtrMcastComp instproc reset-mroutes {} {
$self instvar ns_

foreach node [$ns_ all-nodes-list] {
foreach group [$self groups?] {
set class_info [$node info class]
if {$class_info != "LanNode"} {
$node clearReps * $group
}
}
}
}

CtrMcastComp instproc compute-mroutes {} {
$self reset-mroutes
foreach group [$self groups?] {
foreach src [$self sources? $group] {
$self compute-tree $src $group
}
}
}

CtrMcastComp instproc compute-tree { src group } {
foreach mem [$self members? $group] {
$self compute-branch $src $group $mem
}
}


CtrMcastComp instproc compute-branch { src group nodeh } {
$self instvar ns_

set tt [$self treetype? $group]
if { $tt == "SPT" } {
set target $src
} elseif { $tt == "RPT" } {
set target [$self get_rp $nodeh $group]
}

for {
set downstreamtmp ""
set tmp $nodeh
} { $downstreamtmp != $target } {
set downstreamtmp $tmp
set tmp [$tmp rpf-nbr $target]
} {

if {[SessionSim set MixMode_] && $downstreamtmp != "" && ![$ns_ detailed-link? [$tmp id] [$downstreamtmp id]]} {
break
}


if {$tmp == $target} {
set iif -1
} else {
set rpfl [$ns_ link [$tmp rpf-nbr $target] $tmp]

if {[SessionSim set MixMode_] && $rpfl == ""} {
set iif -1
set ttmp $tmp
while {$ttmp != $target} {
set rpfl [$ns_ link [$ttmp rpf-nbr $target] $ttmp]
if {$rpfl != ""} {
set iif [$rpfl if-label?]
break
}
set ttmp [$ttmp rpf-nbr $target]
}
} else {
set iif [$rpfl if-label?]
}
}

set oiflist ""
if { $downstreamtmp != "" } {
set rpfnbr [$downstreamtmp rpf-nbr $target]
if { $rpfnbr == $tmp } {
set rpflink [$ns_ link $tmp $downstreamtmp]
if {$rpflink != ""} {
set oiflist [$tmp link2oif $rpflink]
} 
}
}

if { [set r [$tmp getReps [$src id] $group]] != "" } {
if [$r is-active] {
if { $oiflist != "" } {
$r insert [lindex $oiflist 0]
}
break
} else {
if { $oiflist != "" } {
$r insert [lindex $oiflist 0]
}
}
} else {
$tmp add-mfc [$src id] $group $iif $oiflist
}
}
}


CtrMcastComp instproc prune-branch { src group nodeh } {
$self instvar ns_

set tt [$self treetype? $group]
if { $tt == "SPT" } {
set target $src
} elseif { $tt == "RPT" } {
set target [$self get_rp $nodeh $group]
}

for {
set downstreamtmp ""
set tmp $nodeh
} { $downstreamtmp != $target } {
set downstreamtmp $tmp
set tmp [$tmp rpf-nbr $target]
} {
set iif -1
set oif ""
if { $downstreamtmp != "" } {
set rpfnbr [$downstreamtmp rpf-nbr $target]
if { $rpfnbr == $tmp } {
set oif [$tmp link2oif [$ns_ link $tmp $downstreamtmp]]
}
}

if { [set r [$tmp getReps [$src id] $group]] != "" } {
if { $oif != "" } {
$r disable $oif
}

if [$r is-active] {
break
}
} else {
break
}
}

}

CtrMcastComp instproc notify {} {
$self instvar ctrrpcomp

$ctrrpcomp compute-rpset
$self compute-mroutes
}

CtrMcastComp instproc init-groups {} {
$self set Glist_ ""
}

CtrMcastComp instproc add-new-group group {
$self instvar Glist_ 
set group [expr $group]

if ![info exist Glist_] {
set Glist_ ""
}
if {[lsearch $Glist_ $group] < 0} {
lappend Glist_ $group
}
}

CtrMcastComp instproc add-new-member {group node} {
$self instvar Mlist_ 
set group [expr $group]

$self add-new-group $group
if ![info exist Mlist_($group)] {
set Mlist_($group) ""
}

if {[lsearch $Mlist_($group) $node] < 0} {
lappend Mlist_($group) $node
}
}

CtrMcastComp instproc new-source? {group node} {
$self instvar Slist_ 
set group [expr $group]

$self add-new-group $group
if ![info exist Slist_($group)] {
set Slist_($group) ""
}

if {[lsearch $Slist_($group) $node] < 0} {
lappend Slist_($group) $node
return 1
} else {
return 0
}
}

CtrMcastComp instproc groups? {} {
$self set Glist_
}

CtrMcastComp instproc members? group {
$self instvar Mlist_
set group [expr $group]
if ![info exists Mlist_($group)] {
set Mlist_($group) ""
}
set Mlist_($group)
}

CtrMcastComp instproc sources? group {
$self instvar Slist_
set group [expr $group]
if ![info exists Slist_($group)] {
set Slist_($group) ""
}
set Slist_($group)
}

CtrMcastComp instproc remove-member {group node} {
$self instvar Mlist_ Glist_
set group [expr $group]

set k [lsearch $Mlist_($group) $node]
if {$k < 0} {
puts "warning: removing non-member"
} else {
set Mlist_($group) [lreplace $Mlist_($group) $k $k]
}

if { $Mlist_($group) == "" } {
set k [lsearch $Glist_ $group]
if {$k < 0} {
puts "warning: removing non-existing group"
} else {
set Glist_ [lreplace $Glist_ $k $k]
}
}
}

CtrMcastComp instproc treetype? group {
$self instvar treetype_
set group [expr $group]
if [info exists treetype_($group)] {
return $treetype_($group)
} else {
return ""
}
}

CtrMcastComp instproc treetype {group tree} {
$self set treetype_([expr $group]) $tree
}

CtrMcastComp instproc switch-treetype group {
$self instvar treetype_ dynT_
set group [expr $group]

if [info exists dynT_] {
foreach tr $dynT_ {
$tr annotate "$group switch tree type"
}
}
set treetype_($group) "SPT"
$self add-new-group $group
$self compute-mroutes
}

CtrMcastComp instproc set_c_rp args {
$self instvar ns_


foreach n [$ns_ all-nodes-list] {
set arbiter [$n getArbiter]
if {$arbiter != ""} {
set ctrmcast [$arbiter getType "CtrMcast"]
$ctrmcast instvar c_rp_
$ctrmcast unset_c_rp
}
}

foreach node $args {
set arbiter [$node getArbiter]	   
set ctrmcast [$arbiter getType "CtrMcast"]
$ctrmcast set_c_rp
}
}

CtrMcastComp instproc set_c_bsr args {
foreach node $args {
set tmp [split $node :]
set node [lindex $tmp 0]
set prior [lindex $tmp 1]
set arbiter [$node getArbiter]
set ctrmcast [$arbiter getType "CtrMcast"]
$ctrmcast set_c_bsr $prior
}
}

CtrMcastComp instproc get_rp { node group } {
set ctrmcast [[$node getArbiter] getType "CtrMcast"]
$ctrmcast get_rp $group
}

CtrMcastComp instproc get_bsr { node } {
set arbiter [$node getArbiter]
set ctrmcast [$arbiter getType "CtrMcast"]
$ctrmcast get_bsr
}

Class CtrRPComp
CtrRPComp instproc init sim {
$self set ns_ $sim
$self next
}

CtrRPComp instproc compute-rpset {} {
$self instvar ns_

foreach node [$ns_ all-nodes-list] {
set connected($node) 0
}
set urtl [$ns_ get-routelogic]

foreach node [$ns_ all-nodes-list] {
foreach {vertix lvertix} [array get ldomain] {
if {[$urtl lookup [$node id] [$vertix id]] >= 0} {
lappend ldomain($vertix) $node
set connected($node) 1
break
}
}

if {!$connected($node)} {
set ldomain($node) $node
set connected($node) 1
}
}

foreach {vnode lvertix} [array get ldomain] {
set hasbsr 0
set rpset ""

foreach vertix $lvertix {
set class_info [$vertix info class]
if {$class_info != "LanNode"} {
set ctrdm [[$vertix getArbiter] getType "CtrMcast"]
if [$ctrdm set c_bsr_] {set hasbsr 1}
if [$ctrdm set c_rp_] {
lappend rpset $vertix
}
}
}

foreach vertix $lvertix {
set class_info [$vertix info class]
if {$class_info != "LanNode"} {
set ctrdm [[$vertix getArbiter] getType "CtrMcast"]
if $hasbsr {
$ctrdm set-rpset $rpset
} else {
$ctrdm set-rpset ""
puts "no c_bsr"
}
}
}
}
}

Class BST -superclass McastProtocol

BST instproc init { sim node } {
$self instvar mctrl_ oiflist_
BST instvar RP_

set mctrl_ [new Agent/Mcast/Control $self]
$node attach $mctrl_
$self next $sim $node
}

BST instproc start {} {
$self instvar node_ oiflist_
BST instvar RP_

foreach grpx [array names RP_] {
set grp [expr $grpx]
if { [string compare $grp $grpx] } {
set RP_($grp) $RP_(grpx)
unset RP_($grpx)
}
set rpfiif [$node_ from-node-iface $RP_($grp)]
if { $rpfiif != "?" } {
set rpfoif [$node_ iif2oif $rpfiif]
} else {
set rpfoif ""
}

set oiflist_($grp) $rpfoif
set neighbors [$node_ set neighbor_]
if [info exists neighbors] {
for {set i 0} {$i < [llength $neighbors]} {incr i} {
set neighbor [lindex $neighbors $i]
set class_info [$neighbor info class]
if {$class_info == "LanNode"} {
$neighbor designate-ump-router $grp  $RP_($grp)
}
}
}
}

}

BST instproc join-group  { group {src "x"} } {
$self instvar node_ ns_ oiflist_
BST instvar RP_

set nbr [$node_ rpf-nbr $RP_($group)]
set nbrs($nbr) 1
$node_ add-mark m1 blue "[$node_ get-shape]"
foreach nbr [array names nbrs] {
if [$nbr is-lan?] {
$nbr instvar receivers_
if [info exists receivers_($group)] {
incr receivers_($group)
} else {
$self send-ctrl "graft" $RP_($group) $group
set receivers_($group) 1
}
}
$self next $group ; #annotate
}

if { ![$node_ check-local $group] || [$node_ getReps "x"  $group] == ""} { 
$self send-ctrl "graft" $RP_($group) $group
}

}

BST instproc leave-group { group {src "x"} } {
BST instvar RP_ 

$self next $group ;#annotate
$self instvar node_ oiflist_

set nbr [$node_ rpf-nbr $RP_($group)]
if  [$nbr is-lan?] {
$nbr instvar receivers_
if [info exists receivers_($group)] {
if {$receivers_($group) > 0} {
incr receivers_($group) -1
if {$receivers_($group) == 0} {
$node_ delete-mark m1
$self send-ctrl "prune" $RP_($group) $group
}
}
} else {
return
}
} else {
set rpfiif [$node_ from-node-iface $RP_($group)]
if { $rpfiif != "?" } {
set rpfoif [$node_ iif2oif $rpfiif]
} else {
set rpfoif ""
}
if { $oiflist_($group) ==  $rpfoif && ![$node_ check-local $group] } {
$self send-ctrl "prune" $RP_($group) $group
$node_ delete-mark m1
}
}

}

BST instproc handle-wrong-iif { srcID group iface } {
$self instvar node_ oiflist_
BST instvar RP_


set rep [$node_ getReps "x" $group]

$node_ add-mfc "x" $group $iface $oiflist_($group)
set iif [$node_ lookup-iface "x" $group]
if { $iface >= 0 } {
set oif [$node_ iif2oif $iface]
set rpfiif [$node_ from-node-iface $RP_($group)]
if { $iface == $rpfiif } {
$rep disable [$node_ iif2oif $rpfiif]
} else {
$rep disable $oif
if { $node_ != $RP_($group) } {
$rep insert [$node_ iif2oif $rpfiif]
}
}
}
$node_ change-iface "x" $group $iif $iface
return 1 ;#classify packet again
}

BST instproc handle-cache-miss { srcID group iface } {
$self instvar node_  ns_ oiflist_
BST instvar RP_

if { [$node_ getReps "x" $group] != "" } {
debug 1
}




if {$iface != -1} {
set neighbors [$node_ set neighbor_]
if [info exists neighbors] {
for {set i 0} {$i < [llength $neighbors]} {incr i} {
set neighbor [lindex $neighbors $i]
set nbr [$node_ rpf-nbr $RP_($group)]
if {[$neighbor is-lan?] &&  [$nbr info class] != "LanNode"} {
$neighbor instvar up_
set up [$neighbor set up_($group)]
if {$node_ != $up} {
if [$self link2lan? $neighbor  $iface] {
return 0
}
}
}
}
}
}

$node_ add-mfc "x" $group $iface $oiflist_($group)

if { $iface > 0 } {
set rep [$node_ getReps "x" $group]
$rep disable [$node_ iif2oif $iface]
}
return 1 ;# classify the packet again.
}

BST instproc drop { replicator src dst iface} {
$self instvar node_ ns_
BST instvar RP_


if {$iface >= 0} {
}
}

BST instproc recv-prune { from src group iface} {
$self instvar node_ ns_ oiflist_ 
BST instvar RP_ 

set rep [$node_ getReps "x" $group]
if {$rep != ""} {
set oif [$node_ iif2oif $iface]
set idx [lsearch $oiflist_($group) $oif]
if { $idx >= 0 } {
set oiflist_($group) [lreplace $oiflist_($group) $idx $idx]
$rep disable $oif
set rpfiif [$node_ from-node-iface $RP_($group)]
if { $rpfiif != "?" } {
set rpfoif [$node_ iif2oif $rpfiif]
} else {
set rpfoif ""
}
if { $oiflist_($group) == $rpfoif && ![$node_ check-local $group] } {
$node_ delete-mark m2
$self send-ctrl "prune" $RP_($group) $group
}
}
}
}

BST instproc recv-graft { from to group iface } {
$self instvar node_ ns_ oiflist_
BST instvar RP_

set oif [$node_ iif2oif $iface]
set rpfiif [$node_ from-node-iface $RP_($group)]
if { $rpfiif != "?" } {
set rpfoif [$node_ iif2oif $rpfiif]
} else {
set rpfoif ""
}

if { $oiflist_($group) == $rpfoif && ![$node_ check-local $group] } {
$node_ add-mark m2 red circle
$self send-ctrl "graft" $RP_($group) $group
}
if { [lsearch $oiflist_($group) $oif] < 0 } {
lappend oiflist_($group) $oif
if { [$node_ lookup-iface "x" $group] != $iface } {
set rep [$node_ getReps "x" $group]
if { $rep != "" } {
$rep insert $oif
}
}
}
}

BST instproc send-ctrl { which dst group } {
$self instvar mctrl_ ns_ node_

if {$node_ != $dst} {
set nbr [$node_ rpf-nbr $dst]
if [$nbr is-lan?] {
$nbr instvar receivers_
if { [info exists receivers_($group)] &&  $receivers_($group) > 0 } return

set nbr [$nbr rpf-nbr $dst]
}


$ns_ simplex-connect $mctrl_  [[[$nbr getArbiter] getType [$self info class]] set mctrl_]
if { $which == "prune" } {
$mctrl_ set fid_ 2
} else {
$mctrl_ set fid_ 3
}
$mctrl_ send $which [$node_ id] $dst $group
}
}


BST instproc dbg arg {
$self instvar ns_ node_
puts [format "At %.4f : node [$node_ id] $arg" [$ns_ now]]
}



LanNode instproc designate-ump-router {group dst} {
$self instvar nodelist_
$self instvar up_

set nbr [$self rpf-nbr $dst]
set up_($group) $nbr
return
}


BST instproc next-hop-router {node group} {
BST instvar RP_

set nbr [$node rpf-nbr $RP_($group)]
if [$nbr is-lan?] {
set nbr [$nbr rpf-nbr $RP_($group)]
}
return $nbr
}

BST instproc is-group-bidir? {group} {
BST instvar RP_

foreach grp [array names RP_] {
if {$grp == $group} {
return 1
}
}
return 0
}

BST instproc match-oif {group link} {
$self instvar oiflist_

set oiflist $oiflist_($group)
if {$oiflist != ""} {
foreach oif $oiflist {
set oiflink [$oif set link_]
if {$oiflink == $link} {
return $oiflink
}
}
}
return
}

BST instproc find-oif {dst group} {
$self instvar node_ ns_

if {$node_ != $dst} {
set ns [$self set ns_]
$ns instvar link_
set link [$ns set link_([$node_ id]:[$dst id])]
return [$self match-oif $group $link]
} else {
return ""
}
}

BST instproc link2lan? {neighbor iface} {
$self instvar node_ ns_

set link1 [[[$node_ iif2oif $iface] set link_] set iif_]
set link2 [[$ns_ link $node_ $neighbor] set iif_]
if {$link1 == $link2} {
return 1
} else {
return 0
}
}

Class Classifier/Multicast/Replicator/BST -superclass Classifier/Multicast/BST

Classifier/Multicast/BST instproc new-group { src group iface code} {
$self instvar node_
$node_ new-group $src $group $iface $code
}

Classifier/Multicast/BST instproc no-slot slot {
}

Classifier/Multicast/Replicator/BST instproc init args {
$self next
$self instvar nrep_
set nrep_ 0
}

Classifier/Multicast/Replicator/BST instproc add-rep { rep src group iif } {
$self instvar nrep_
$self set-hash $src $group $nrep_ $iif
$self install $nrep_ $rep
incr nrep_
}

Classifier/Multicast/Replicator/BST instproc match-BST-iif {iface group} {
$self instvar node_

list retval_
set agents [$node_ set agents_]
for {set i 0} {$i < [llength $agents]} {incr i} {
set agent [lindex $agents $i]
$agent instvar proto_
if [info exists proto_] {
set protocol [$agent set proto_]
if {[$protocol info class] == "BST"} {
BST instvar RP_
$protocol instvar oiflist_
set bidir [$protocol is-group-bidir? $group]
if {$bidir == 1} {
if {$node_ == $RP_($group)} {
return 1
}

set iif [$node_ from-node-iface  $RP_($group)]
if {$iif == $iface} {
return 1
} else {
return 0
}
}
}
}
}
return -1
}

Classifier/Multicast/Replicator/BST instproc upstream-link {group} {
$self instvar node_

list retval_
set agents [$node_ set agents_]
for {set i 0} {$i < [llength $agents]} {incr i} {
set agent [lindex $agents $i]
$agent instvar proto_
if [info exists proto_] {
set protocol [$agent set proto_]
if {[$protocol info class] == "BST"} {
BST instvar RP_
$protocol instvar oiflist_
set bidir [$protocol is-group-bidir? $group]
if {$bidir == 1} {
set nbr [$node_ rpf-nbr $RP_($group)]

set oif [$protocol find-oif $nbr  $group]

if {$oif == ""} {
set oif "self"
} 
lappend retval_ $oif

if [$nbr is-lan?] {
set nbr [$nbr rpf-nbr $RP_($group)]
}
lappend retval_ [$nbr id]
return $retval_

}
}
}
}
return {}
}

Classifier/Multicast/Replicator/BST instproc check-rpf-link {node group} {
$self instvar node_

set agents [$node_ set agents_]
for {set i 0} {$i < [llength $agents]} {incr i} {
set agent [lindex $agents $i]
$agent instvar proto_
if [info exists proto_] {
set protocol [$agent set proto_]
set classInfo [$protocol info class]
if {$classInfo == "BST"} {
BST instvar RP_
set rpfiif [$node_ from-node-iface  $RP_($group)]
return $rpfiif
}
}
}
return -1
}



Agent instproc traffic-source agent {
$self instvar tg_
set tg_ $agent
$tg_ target $self
$tg_ set agent_addr_ [$self set agent_addr_]
$tg_ set agent_port_ [$self set agent_port_]
}

Agent/SRM set packetSize_  1024	;# assume default message size for repair is 1K
Agent/SRM set groupSize_   0
Agent/SRM set app_fid_ 0

Agent/SRM set distanceCompute_	ewma

Agent/SRM set C1_	2.0
Agent/SRM set C2_	2.0
Agent/SRM set requestFunction_	"SRM/request"
Agent/SRM set requestBackoffLimit_	5

Agent/SRM set D1_	1.0
Agent/SRM set D2_	1.0
Agent/SRM set repairFunction_	"SRM/repair"

Agent/SRM set sessionDelay_ 1.0
Agent/SRM set sessionFunction_	"SRM/session"

Class Agent/SRM/Deterministic -superclass Agent/SRM
Agent/SRM/Deterministic set C2_ 0.0
Agent/SRM/Deterministic set D2_ 0.0

Class Agent/SRM/Probabilistic -superclass Agent/SRM
Agent/SRM/Probabilistic set C1_ 0.0
Agent/SRM/Probabilistic set D1_ 0.0

Class Agent/SRM/Fixed -superclass Agent/SRM

Class SRM
Class SRM/request -superclass SRM
Class SRM/repair -superclass SRM
Class SRM/session -superclass SRM


Agent/SRM/Adaptive set pdistance_	0.0	;# bound instance variables
Agent/SRM/Adaptive set requestor_ 0

Agent/SRM/Adaptive set C1_	2.0
Agent/SRM/Adaptive set MinC1_	0.5
Agent/SRM/Adaptive set MaxC1_	2.0
Agent/SRM/Adaptive set C2_	2.0
Agent/SRM/Adaptive set MinC2_	1.0
Agent/SRM/Adaptive set MaxC2_	1.0	;# G

Agent/SRM/Adaptive set D1_	-1	;# log10 G
Agent/SRM/Adaptive set MinD1_	0.5
Agent/SRM/Adaptive set MaxD1_	0.0	;# log10 G
Agent/SRM/Adaptive set D2_	-1	;# log10 G	XXX
Agent/SRM/Adaptive set MinD2_	1.0
Agent/SRM/Adaptive set MaxD2_	1.0	;# G

Agent/SRM/Adaptive set requestFunction_	"SRM/request/Adaptive"
Agent/SRM/Adaptive set repairFunction_	"SRM/repair/Adaptive"

Agent/SRM/Adaptive set AveDups_	1.0
Agent/SRM/Adaptive set AveDelay_	1.0

Agent/SRM/Adaptive set eps_	0.10

Agent/SRM/Adaptive instproc init args {

eval $self next $args
$self array set closest_ "requestor 0 repairor 0"

$self set AveDups_	[$class set AveDups_]
$self set AveDelay_	[$class set AveDelay_]

foreach i [list MinC1_ MaxC1_ MinC2_ MaxC2_			 MinD1_ MaxD1_ MinD2_ MaxD2_] {
$self instvar $i
set $i [$class set $i]
}

$self set eps_	[$class set eps_]
}

Agent/SRM/Adaptive instproc check-bounds args {
set G [$self set groupSize_]
$self set MaxC2_ $G
$self set MaxD1_ [expr log10($G)]
$self set MaxD2_ $G
if {[llength $args] <= 0} {
set args "C1_ C2_ D1_ D2_"
}
foreach i $args {
$self instvar $i
set val [$self set $i]	      ;# We do this for notational convenience
set min [$self set Min$i]
set max [$self set Max$i]
if { $val < $min } {
set $i $min
} elseif { $val > $max } {
set $i $max
}
}
}

Agent/SRM/Adaptive instproc recompute-request-params {} {
$self instvar closest_ C1_ C2_ stats_ AveDups_ AveDelay_ eps_
if {$stats_(ave-req-delay) < 0} {
$self check-bounds C1_ C2_	;# adjust bounds to estimated size of G
return
}

$self compute-ave dup-req
if $closest_(requestor) {
set C2_ [expr $C2_ - 0.1]
set closest_(requestor)	0
} elseif {$stats_(ave-dup-req) >= $AveDups_} {
set C1_ [expr $C1_ + 0.1]
set C2_ [expr $C2_ + 0.5]
} elseif {$stats_(ave-dup-req) < [expr $AveDups_ - $eps_]} {
if {$stats_(ave-req-delay) > $AveDelay_} {
set C2_ [expr $C2_ - 0.1]
}
if {$stats_(ave-dup-req) < 0.25} {
set C1_ [expr $C1_ - 0.05]
}
} else {
set C1_ [expr $C1_ + 0.05]
}
$self check-bounds C1_ C2_
}

Agent/SRM/Adaptive instproc sending-request {} {
$self set C1_ [expr [$self set C1_] - 0.1]  ;# XXX SF's code uses other
$self set closest_(requestor) 1
$self check-bounds C1_
}

Agent/SRM/Adaptive instproc recv-request {r d s m} {
$self instvar pending_ closest_
if { [info exists pending_($s:$m)]  && $d == 1 } {
set closeness [$pending_($s:$m) closest-requestor?]
if {$closeness >= 0} {
set closest_(requestor) $closeness
}
}
$self next $r $d $s $m
}

Agent/SRM/Adaptive instproc recompute-repair-params {} {
$self instvar closest_ D1_ D2_ stats_ AveDups_ AveDelay_ eps_
if {$stats_(ave-rep-delay) < 0} {
set logG [expr log10([$self set groupSize_])]
set D1_  $logG
set D2_  $logG
$self check-bounds D1_ D2_	;# adjust bounds to estimated size of G
return
}

$self compute-ave dup-rep
if $closest_(repairor) {
set D2_ [expr $D2_ - 0.1]
set closest_(repairor) 0
} elseif {$stats_(ave-dup-rep) >= $AveDups_} {
set D1_ [expr $D1_ + 0.1]
set D2_ [expr $D2_ + 0.5]
} elseif {$stats_(ave-dup-rep) < [expr $AveDups_ - $eps_]} {
if {$stats_(ave-rep-delay) > $AveDelay_} {
set D2_ [expr $D2_ - 0.1]
}
if {$stats_(ave-dup-rep) < 0.25} {
set D1_ [expr $D1_ - 0.05]
}
} else {
set D1_ [expr $D1_ + 0.05]
}
$self check-bounds D1_ D2_
}

Agent/SRM/Adaptive instproc sending-repair {} {
$self set D1_ [expr [$self set D1_] - 0.1]  ;# XXX SF's code uses other
$self set closest_(repairor) 1
$self check-bounds D1_
}

Agent/SRM/Adaptive instproc recv-repair {d s m} {
$self instvar pending_ closest_
if { [info exists pending_($s:$m)] && $d == 1 } {
set closeness [$pending_($s:$m) closest-repairor?]
if {$closeness >= 0} {
set closest_(repairor) $closeness
}
}
$self next $d $s $m
}

Class SRM/request/Adaptive -superclass SRM/request
SRM/request/Adaptive instproc set-params args {
$self instvar agent_
$agent_ recompute-request-params
eval $self next $args
}

SRM/request/Adaptive instproc backoff? {} {
$self instvar backoff_ backoffCtr_ backoffLimit_
set retval $backoff_
if {[incr backoffCtr_] <= $backoffLimit_} {
set backoff_ [expr $backoff_ * 3]
}
set retval
}

SRM/request/Adaptive instproc schedule {} {
$self next
}

SRM/request/Adaptive instproc send-request {} {
$self instvar agent_ round_
if { $round_ == 1 } {
$agent_ sending-request
}
$self next
}

SRM/request/Adaptive instproc closest-requestor? {} {
$self instvar agent_ sender_ sent_ round_
if {$sent_ == 1 && $round_ == 1} {	;# since repairs aren't rescheduled.
if {[$agent_ set pdistance_] >			 [expr 1.5 * [$self distance? $sender_]]} {
return 1
} else {
return 0
}
} else {
return -1
}
}

SRM/request/Adaptive instproc closest-repairor? {} {
return -1
}

Class SRM/repair/Adaptive -superclass SRM/repair
SRM/repair/Adaptive instproc set-params args {
$self instvar agent_
$agent_ recompute-repair-params
eval $self next $args
}

SRM/repair/Adaptive instproc schedule {} {
$self next
}

SRM/repair/Adaptive instproc send-repair {} {
$self instvar round_ agent_
if { $round_ == 1 } {
$agent_ sending-repair
}
$self next
}

SRM/repair/Adaptive instproc closest-requestor? {} {
return -1
}

SRM/repair/Adaptive instproc closest-repairor? {} {
$self instvar agent_ requestor_ sent_ round_
if {$sent_ == 1 && $round_ == 1} {
if {[$agent_ set pdistance_] >			 [expr 1.5 * [$self distance? $requestor_]]} {
return 1
} else {
return 0
}
} else {
return -1
}
}

Agent/SRM instproc init {} {
$self next
$self instvar ns_ requestFunction_ repairFunction_
set ns_ [Simulator instance]
$self init-instvar sessionDelay_
foreach var {C1_ C2_ D1_ D2_} {
$self init-instvar $var
}
$self init-instvar requestFunction_
$self init-instvar repairFunction_
$self init-instvar sessionFunction_
$self init-instvar requestBackoffLimit_
$self init-instvar distanceCompute_

$self array set stats_ [list		 dup-req		-1	ave-dup-req	-1	 dup-rep		-1	ave-dup-rep	-1	 req-delay	0.0	ave-req-delay	-1	 rep-delay	0.0	ave-rep-delay	-1	 ]
}

Agent/SRM instproc delete {} {
$self instvar ns_ pending_ done_ session_ tg_
foreach i [array names pending_] {
$pending_($i) cancel DELETE
delete $pending_($i)
}
$self cleanup
delete $session_
if [info exists tg_] {
delete $tg_
}
}

Agent/SRM instproc start {} {
$self instvar node_ dst_addr_	;# defined in Agent base class
set dst_addr_ [expr $dst_addr_]	; # get rid of possibly leading 0x etc.
$self cmd start

$node_ join-group $self $dst_addr_

$self instvar ns_ session_ sessionFunction_
set session_ [new $sessionFunction_ $ns_ $self]
$session_ schedule
}

Agent/SRM instproc start-source {} {
$self instvar tg_
if ![info exists tg_] {
error "No source defined for agent $self"
}
$tg_ start
}

Agent/SRM instproc sessionFunction f {
$self instvar sessionFunction_
set sessionFunction_ $f
}

Agent/SRM instproc requestFunction f {
$self instvar requestFunction_
set requestFunction_ $f
}

Agent/SRM instproc repairFunction f {
$self instvar repairFunction_
set repairFunction_ $f
}

Agent/SRM instproc groupSize? {} {
$self set groupSize_
}

global alpha
if ![info exists alpha] {
set alpha	0.25
}

proc ewma {ave cur} {
if {$ave < 0} {
return $cur
} else {
global alpha
return [expr (1 - $alpha) * $ave + $alpha * $cur]
}
}

proc instantaneous {ave cur} {
set cur
}

Agent/SRM instproc compute-ave var {
$self instvar stats_
set stats_(ave-$var) [ewma $stats_(ave-$var) $stats_($var)]
}


Agent/SRM instproc recv {type args} {
eval $self recv-$type $args
}

Agent/SRM instproc recv-data {sender msgid} {
$self instvar pending_
if ![info exists pending_($sender:$msgid)] {
error "Oy vey!  How did we get here?"
}
if {[$pending_($sender:$msgid) set round_] == 1} {
$pending_($sender:$msgid) cancel DATA
$pending_($sender:$msgid) evTrace Q DATA
delete $pending_($sender:$msgid)
unset pending_($sender:$msgid)
} else {
$pending_($sender:$msgid) recv-repair
}
}

Agent/SRM instproc mark-period period {
$self compute-ave $period
$self set stats_($period) 0
}

Agent/SRM instproc request {sender args} {
$self instvar pending_ ns_ requestFunction_
set newReq 0
foreach msgid $args {
if [info exists pending_($sender:$msgid)] {
error "duplicate loss detection in agent"
}
set pending_($sender:$msgid) [new $requestFunction_ $ns_ $self]
$pending_($sender:$msgid) set-params $sender $msgid
$pending_($sender:$msgid) schedule

if ![info exists old_($sender:$msgid)] {
incr newReq
}
}
if $newReq {
$self mark-period dup-req
}
}

Agent/SRM instproc update-ave {type delay} {
$self instvar stats_
set stats_(${type}-delay) $delay
$self compute-ave ${type}-delay
}

Agent/SRM instproc recv-request {requestor round sender msgid} {
$self instvar pending_ stats_
if [info exists pending_($sender:$msgid)] {
if { $round == 1 } {
incr stats_(dup-req) [$pending_($sender:$msgid)	 dup-request?]
}
$pending_($sender:$msgid) recv-request
} else {
$self repair $requestor $sender $msgid
}
}

Agent/SRM instproc repair {requestor sender msgid} {
$self instvar pending_ ns_ repairFunction_
if [info exists pending_($sender:$msgid)] {
error "duplicate repair detection in agent??  really??"
}
set pending_($sender:$msgid) [new $repairFunction_ $ns_ $self]
$pending_($sender:$msgid) set requestor_ $requestor
$pending_($sender:$msgid) set-params $sender $msgid
$pending_($sender:$msgid) schedule
$self mark-period dup-rep
}

Agent/SRM instproc recv-repair {round sender msgid} {
$self instvar pending_ stats_
if ![info exists pending_($sender:$msgid)] {
$self instvar trace_ ns_ node_ 
if [info exists trace_] {
}
} else {
if { $round == 1 } {
incr stats_(dup-rep) [$pending_($sender:$msgid)	 dup-repair?]
}
$pending_($sender:$msgid) recv-repair
}
}

Agent/SRM/Fixed instproc repair args {
$self set D1_ [expr log10([$self set groupSize_])]
$self set D2_ [expr log10([$self set groupSize_])]
eval $self next $args
}


Agent/SRM instproc clear {obj s m} {
$self instvar pending_ done_ old_ logfile_
set done_($s:$m) $obj
set old_($s:$m) [$obj set round_]
if [info exists logfile_] {
$obj dump-stats $logfile_
}
unset pending_($s:$m)
if {[array size done_] > 32} {
$self instvar ns_
$ns_ at [expr [$ns_ now] + 0.01] "$self cleanup"
}
}

Agent/SRM instproc round? {s m} {
$self instvar old_
if [info exists old_($s:$m)] {
return $old_($s:$m)
} else {
return 0
}
}

Agent/SRM instproc cleanup {} {
$self instvar done_
if [info exists done_] {
foreach i [array names done_] {
delete $done_($i)
}
unset done_
}
}

Agent/SRM instproc trace file {
$self set trace_ $file
}

Agent/SRM instproc log file {
$self set logfile_ $file
}

SRM instproc init {ns agent} {
$self next
$self instvar ns_ agent_ nid_ distf_
set ns_ $ns
set agent_ $agent
set nid_ [[$agent_ set node_] id]
set distf_ [$agent_ set distanceCompute_]
if ![catch "$agent_ set trace_" traceVar] {
$self set trace_ $traceVar
}
$self array set times_ [list		 startTime [$ns_ now] serviceTime -1 distance -1]
}

SRM instproc set-params {sender msgid} {
$self next
$self instvar agent_ sender_ msgid_ round_ sent_
set sender_ $sender
set msgid_  $msgid
set round_  [$agent_ round? $sender_ $msgid_]
set sent_	0
}

SRM instproc cancel {} {
$self instvar ns_ eventID_
if [info exists eventID_] {
$ns_ cancel $eventID_
unset eventID_
}
}

SRM instproc schedule {} {
$self instvar round_
incr round_
}

SRM instproc distance? node {
$self instvar agent_ times_ distf_
set times_(distance) [$distf_ $times_(distance)	 [$agent_ distance? $node]]
}

SRM instproc serviceTime {} {
$self instvar ns_ times_
set times_(serviceTime) [expr ([$ns_ now] - $times_(startTime)) /  ( 2 * $times_(distance))]
}

SRM instproc logpfx fp {
$self instvar ns_ nid_ sender_ msgid_ round_
puts -nonewline $fp [format "%7.4f" [$ns_ now]]
puts -nonewline $fp " n $nid_ m <$sender_:$msgid_> r $round_ "
}

SRM instproc dump-stats fp {
$self instvar times_ statistics_
$self logpfx $fp
puts -nonewline $fp "type [string range [$self info class] 4 end] "
puts $fp "[array get times_] [array get statistics_]"
}

SRM instproc evTrace {tag type args} {
$self instvar trace_
if [info exists trace_] {
$self logpfx $trace_
puts -nonewline $trace_ "$tag $type"
foreach elem $args {
puts -nonewline $trace_ " $elem"
}
puts $trace_ {}
}
}


SRM/request instproc init args {
eval $self next $args
$self array set statistics_ "dupRQST 0 dupREPR 0 #sent 0 backoff 0"
}

SRM/request instproc set-params args {
eval $self next $args
$self instvar agent_ sender_
foreach var {C1_ C2_} {
if ![catch "$agent_ set $var" val] {
$self instvar $var
set $var $val
}
}
$self distance? $sender_
$self instvar backoff_ backoffCtr_ backoffLimit_
set backoff_ 1
set backoffCtr_ 0
set backoffLimit_ [$agent_ set requestBackoffLimit_]

$self evTrace Q DETECT
}

SRM/request instproc dup-request? {} {
$self instvar ns_ round_ ignore_
if {$round_ == 2 && [$ns_ now] <= $ignore_} {
return 1
} else {
return 0
}
}

SRM/request instproc dup-repair? {} {
return 0
}

SRM/request instproc backoff? {} {
$self instvar backoff_ backoffCtr_ backoffLimit_
set retval $backoff_
if {[incr backoffCtr_] <= $backoffLimit_} {
incr backoff_ $backoff_
}
set retval
}

SRM/request instproc compute-delay {} {
$self instvar C1_ C2_
set rancomp [expr $C1_ + $C2_ * [uniform 0 1]]

$self instvar sender_ backoff_
set dist [$self distance? $sender_]
$self evTrace Q INTERVALS C1 $C1_ C2 $C2_ d $dist i $backoff_
set delay [expr $rancomp * $dist]
}

SRM/request instproc schedule {} {
$self instvar ns_ eventID_ delay_
$self next
set now [$ns_ now]
set delay_ [expr [$self compute-delay] * [$self backoff?]]
set fireTime [expr $now + $delay_]

$self evTrace Q NTIMER at $fireTime

set eventID_ [$ns_ at $fireTime "$self send-request"]
}

SRM/request instproc cancel type {
$self next
if {$type == "REQUEST" || $type == "REPAIR"} {
$self instvar agent_ round_
if {$round_ == 1} {
$agent_ update-ave req [$self serviceTime]
}
}
}

SRM/request instproc send-request {} {
$self instvar agent_ round_ sender_ msgid_ sent_ round_
$self evTrace Q SENDNACK

$agent_ send request $round_ $sender_ $msgid_

$self instvar statistics_
incr statistics_(#sent)
set sent_ $round_
}

SRM/request instproc recv-request {} {
$self instvar ns_ agent_ round_ delay_ ignore_ statistics_
if {[info exists ignore_] && [$ns_ now] < $ignore_} {
incr statistics_(dupRQST)
} else {
$self cancel REQUEST
$self schedule          ;# or rather, reschedule-rqst 
set ignore_ [expr [$ns_ now] + ($delay_ / 2)]
incr statistics_(backoff)
$self evTrace Q NACK IGNORE-BACKOFF $ignore_
}
}

SRM/request instproc recv-repair {} {
$self instvar ns_ agent_ sender_ msgid_ ignore_ eventID_
if [info exists eventID_] {
$self serviceTime
set ignore_ [expr [$ns_ now] + 3 * [$self distance? $sender_]]
$ns_ at $ignore_ "$agent_ clear $self $sender_ $msgid_"
$self cancel REPAIR
$self evTrace Q REPAIR IGNORES $ignore_
} else {		;# we must be in the 3dS,B holdDown interval
$self instvar statistics_
incr statistics_(dupREPR)
}
}

SRM/repair instproc init args {
eval $self next $args
$self array set statistics_ "dupRQST 0 dupREPR 0 #sent 0"
}

SRM/repair instproc set-params args {
eval $self next $args
$self instvar agent_ requestor_
foreach var {D1_ D2_} {
if ![catch "$agent_ set $var" val] {
$self instvar $var
set $var $val
}
}
$self distance? $requestor_
$self evTrace P NACK from $requestor_
}

SRM/repair instproc dup-request? {} {
return 0
}

SRM/repair instproc dup-repair? {} {
$self instvar ns_ round_
if {$round_ == 1} {		;# because repairs do not reschedule
return 1
} else {
return 0
}
}
SRM/repair instproc compute-delay {} {
$self instvar D1_ D2_
set rancomp [expr $D1_ + $D2_ * [uniform 0 1]]

$self instvar requestor_
set dist [$self distance? $requestor_]
$self evTrace P INTERVALS D1 $D1_ D2 $D2_ d $dist
set delay [expr $rancomp * $dist]
}

SRM/repair instproc schedule {} {
$self instvar ns_ eventID_
$self next
set fireTime [expr [$ns_ now] + [$self compute-delay]]

$self evTrace P RTIMER at $fireTime

set eventID_ [$ns_ at $fireTime "$self send-repair"]
}

SRM/repair instproc cancel type {
$self next
if {$type == "REQUEST" || $type == "REPAIR"} {
$self instvar agent_ round_
if {$round_ == 1} {
$agent_ update-ave rep [$self serviceTime]
}
}
}

SRM/repair instproc send-repair {} {
$self instvar ns_ agent_ round_ sender_ msgid_ requestor_ sent_ round_
$self evTrace P SENDREP

$agent_ set requestor_ $requestor_
$agent_ send repair $round_ $sender_ $msgid_

$self instvar statistics_
incr statistics_(#sent)
set sent_ $round_
}

SRM/repair instproc recv-request {} {
$self instvar statistics_
incr statistics_(dupRQST)
}

SRM/repair instproc recv-repair {} {
$self instvar ns_ agent_ round_ sender_ msgid_ eventID_ requestor_
if [info exists eventID_] {
set holdDown [expr [$ns_ now] +		 3 * [$self distance? $requestor_]]
$ns_ at $holdDown "$agent_ clear $self $sender_ $msgid_"
$self cancel REPAIR
$self evTrace P REPAIR IGNORES $holdDown
} else {		;# we must in the 3dS,B holdDown interval
$self instvar statistics_
incr statistics_(dupREPR)
}
}

SRM/session instproc init args {
eval $self next $args
$self instvar agent_ sessionDelay_ round_
set sessionDelay_ [$agent_ set sessionDelay_]
set round_ 1
$self array set statistics_ "#sent 0"

$self set sender_ 0
$self set msgid_  0
}

SRM/session instproc delete {} {
$self instvar $ns_ eventID_
$ns_ cancel $eventID_
$self next
}

SRM/session instproc schedule {} {
$self instvar ns_ agent_ sessionDelay_ eventID_

$self next

set fireTime [expr $sessionDelay_ * [uniform 0.9 1.1]]

set eventID_ [$ns_ at [expr [$ns_ now] + $fireTime]		 "$self send-session"]
}

SRM/session instproc send-session {} {
$self instvar agent_ statistics_
$agent_ send session
$self evTrace S SESSION
incr statistics_(#sent)
$self schedule
}

SRM/session instproc evTrace args {}	;# because I don't want to trace

Class SRM/session/log-scaled -superclass SRM/session
SRM/session/log-scaled instproc schedule {} {
$self instvar ns_ agent_ sessionDelay_ eventID_

set fireTime [expr $sessionDelay_ * [uniform 0.9 1.1] *  (1 + log([$agent_ set groupSize_])) ]

set eventID_ [$ns_ at [expr [$ns_ now] + $fireTime]		 "$self send-session"]
}
Agent/SRM/SSM set group_scope_ 32
Agent/SRM/SSM set local_scope_ 2
Agent/SRM/SSM set scope_flag_  2
Agent/SRM/SSM set rep_id_ 0
Agent/SRM/SSM set numrep_ 0
Agent/SRM/SSM set repthresh_up_ 100
Agent/SRM/SSM set repthresh_low_ 7
Agent/SRM/SSM set Z1_ 1.5
Agent/SRM/SSM set S1_ 0.0
Agent/SRM/SSM set S2_ 3.0

Agent/SRM/SSM instproc init {} {
$self next
$self instvar numrep_ numloc_ repthresh_up_ repthresh_low_ Z1_  S1_ S2_
set numrep_ 0
set numloc_ 0
set repthresh_up_ [$class set repthresh_up_]
set repthresh_low_ [$class set repthresh_low_]
set Z1_ [$class set Z1_]
set S1_ [$class set S1_]
set S2_ [$class set S2_]
}

Agent/SRM/SSM instproc start {} {
$self next 
$self instvar deactivateID_ sessionDelay_ ns_
set now [expr [$ns_ now]]
set deactivateID_ [$ns_ at [expr $now + 3 * $sessionDelay_]  "$self deactivate-reps $now"]
}


Agent/SRM/SSM instproc repid { rep} {

$self instvar rep_id_
$self set rep_id_ [$rep set addr_]
$self ch-rep 

}

Agent/SRM/SSM instproc member-scope {scope } {
$self instvar scope_flag_
$self set scope_flag_ $scope

}

Agent/SRM/SSM instproc local-member? {} {
$self instvar scope_flag_
if {$scope_flag_ == 1 } {
return 1
} else {
return 0
}
}

Agent/SRM/SSM instproc global-member? {} {
$self instvar scope_flag_
if {$scope_flag_ == 2 } {
return 1
} else {
return 0
}
}

Agent/SRM/SSM instproc local-member {} {
$self member-scope 1	
}

Agent/SRM/SSM instproc global-rep {} {
$self member-scope 2
set rep_id_ [$self set addr_]
$self ch-rep
}

Agent/SRM/SSM instproc set-local-scope {scope} {
$self instvar local_scope_
$self set local_scope_ $scope
}

Agent/SRM/SSM instproc set-global-scope {scope} {
$self instvar global-scope
$self set global-scope $scope
}

Agent/SRM/SSM instproc set-repid {rep} {
$self instvar rep_id_
$self set rep_id_ [$rep set addr_]
$self ch-rep 
}

Agent/SRM/SSM instproc dump-reps {} {
$self instvar ns_ activerep_ numrep_
puts "[ft $ns_ $self] numreps: $numrep_"
if [info exists activerep_] {
foreach i [array names activerep_] {
set rtime [$activerep_($i) set recvTime_]
set ttl [$activerep_($i) set ttl_]
puts "rep: $i recvtime: [ftime $rtime] ttl: $ttl"
}

}
}

Agent/SRM/SSM instproc dump-locs {} {
$self instvar ns_ activeloc_ numloc_
puts "[ft $ns_ $self] numlocs: $numloc_"
if [info exists activeloc_] {
foreach i [array names activeloc_] {
set rtime [$activeloc_($i) set recvTime_]
set ttl [$activeloc_($i) set ttl_]
set repid [$activeloc_($i) set repid_]
puts "loc: $i recvtime: [ftime $rtime] ttl:  $ttl repid: $repid"
}

}
}


Agent/SRM/SSM instproc send-session {} {
$self instvar session_
$session_ send-session
}




Agent/SRM/SSM instproc repchange-action {} {
$self instvar rep_id_ tentativerep_ tentativettl_
$self instvar ns_
$self cur-num-reps
set rep_id_ $tentativerep_
puts "[ft $ns_ $self] chrep rep : $tentativerep_ ttl : $tentativettl_"
$self set-local-scope $tentativettl_
$self local-member
$self ch-rep
$self send-session
}


Agent/SRM/SSM instproc recv-lsess {sender repid ttl} {

$self instvar activeloc_ ns_ numloc_ sessionDelay_ deactivatelocID_
$self instvar activerep_ numrep_
$self instvar ch_localID_ tentativerep_ addr_ rep_id_ tentativettl_

if [info exists activeloc_($sender)] {
$activeloc_($sender) recv-lsess $repid $ttl
} else {
set activeloc_($sender) [new SRMinfo/loc $sender]
incr numloc_
$activeloc_($sender) set-params $ns_ $self
$activeloc_($sender) recv-lsess	$repid $ttl
}


if [info exists activerep_($sender)] {
delete $activerep_($sender)
unset activerep_($sender)
incr numrep_ -1
if [info exists ch_localID_] {
if {[info exists tentativerep_] && $tentativerep_ == $sender } {
$self cur-num-reps
}
if { $repid == $addr_} {
$ns_ cancel $ch_localID_
$self unset ch_localID_
$self check-status
}
}
if { [$self local-member?]} {
if { $sender == $rep_id_} {
$self repchange-action
}
} else {
if { $sender == $rep_id_} {
puts "[ft $ns_ $self] error"

}
}			
}

set time [expr [$ns_ now] - 3 * $sessionDelay_]
if [info exists deactivatelocID_] {
$ns_ cancel $deactivatelocID_
unset deactivatelocID_
}
$self deactivate-locs $time
}


Agent/SRM/SSM instproc recv-gsess {sender ttl} {
$self instvar activerep_ ns_ numrep_ sessionDelay_
$self instvar deactivateID_ local_scope_

$self instvar activeloc_ numloc_
if [info exists activerep_($sender)] {
$activerep_($sender) recv-gsess $ttl
} else {
set activerep_($sender) [new SRMinfo/rep $sender]
incr numrep_
$activerep_($sender) set-params $ns_ $self
$activerep_($sender) recv-gsess	$ttl
}
set time [expr [$ns_ now] - 3 * $sessionDelay_]
if [info exists deactivateID_] {
$ns_ cancel $deactivateID_
unset deactivateID_
}
if [info exists activeloc_($sender)] {
delete $activeloc_($sender)
unset activeloc_($sender)
incr numloc_ -1
}
if { [$self local-member?]} {
if {$ttl < $local_scope_} {
set rep_id_ $sender
puts "[ft $ns_ $self] closerrep rep : $sender  ttl : $ttl"
$self set-local-scope $ttl
$self local-member
$self ch-rep
$self send-session
}			
}
$self deactivate-reps $time
$self check-status
}

Agent/SRM/SSM instproc bias {} {
$self instvar activerep_  ns_ sessionDelay_
set now [expr [$ns_ now]]
set biasfactor 0
set time [expr $now - 1.5 * $sessionDelay_]
if [info exists activerep_] {
foreach i [array names activerep_] {
set rtime [$activerep_($i) set recvTime_]
if { $rtime >= $time} {
incr biasfactor 
}
}
}
return $biasfactor
}

Agent/SRM/SSM instproc my-loc {} {
$self instvar activeloc_
set num 0
if [info exists activeloc_] {
foreach i [array names activeloc_] {
set repid [$activeloc_($i) set repid_]
if { $repid == [$self set addr_]} {
incr num
}
}
}
return $num
}

Agent/SRM/SSM instproc cur-num-reps {} {
$self instvar activerep_  ns_ sessionDelay_ tentativerep_ tentativettl_ 
$self instvar Z1_
set now [expr [$ns_ now]]
set num 0
set min_ttl 32
set time [expr $now - $Z1_ * $sessionDelay_]
if [info exists activerep_] {
foreach i [array names activerep_] {
set rtime [$activerep_($i) set recvTime_]
set ttl [$activerep_($i) set ttl_]
if { $rtime >= $time} {
if {$min_ttl > $ttl} {
set tentativerep_ $i
set min_ttl $ttl
}
incr num
}
}
}
set tentativettl_ $min_ttl
return $num
}

Agent/SRM/SSM instproc compute-localdelay {} {
$self instvar S1_ S2_ sessionDelay_
set num [$self my-loc]
if {$num > 0} {
set rancomp [expr $S1_+ 1 + $S2_ * [uniform 0 1]]
} else {
set rancomp [expr $S1_+ $S2_ * [uniform 0 1]]
}
set delay [expr $rancomp * $sessionDelay_]
return $delay
}

Agent/SRM/SSM instproc compute-globaldelay {} {
$self instvar S1_ S2_ sessionDelay_
set rancomp [expr $S1_ + $S2_ * [uniform 0 1]]
set delay [expr $rancomp * $sessionDelay_]
return $delay
}



Agent/SRM/SSM instproc schedule-ch-local {} {
$self instvar ns_ ch_localID_
set now [$ns_ now]
set delay [$self compute-localdelay]
set fireTime [expr $now + $delay]
if [info exists ch_localID_] {
puts "[new_ft $ns_ $self] scheduled called without cancel"
$ns_ cancel $ch_localID_
unset ch_localID_
}

set ch_localID_ [$ns_ at $fireTime "$self ch-local"]
puts "[ft $ns_ $self] schlocal [ftime $fireTime] evid : $ch_localID_"

}

Agent/SRM/SSM instproc schedule-ch-global {} {
$self instvar ns_ ch_globalID_
set now [$ns_ now]
set delay [$self compute-globaldelay]
set fireTime [expr $now + $delay]
if [info exists ch_globalID_] {
puts "[ft $ns_ $self] glbscheduled called without cancel"
$ns_ cancel $ch_globalID_
unset ch_globalID_
}

set ch_globalID_ [$ns_ at $fireTime "$self ch-global"]
puts "[ft $ns_ $self] schglobal [ftime $fireTime] evid : $ch_globalID_"

}




Agent/SRM/SSM instproc check-status {} {
$self instvar ns_ numrep_ repthresh_up_ ch_localID_
$self instvar ch_globalID_ repthresh_low_
if { $numrep_ > $repthresh_up_ }  {
if [info exists ch_localID_] {
return;
}
if { [$self local-member?]} {
if [info exists ch_globalID_] {
$ns_ cancel $ch_globalID_
unset ch_globalID_
}
return;
}
$self schedule-ch-local
return;
}
if {$numrep_ < $repthresh_low_} {
if [info exists ch_globalID_] {
return;
}
if { [$self global-member?]} {
if [info exists ch_localID_] {
$ns_ cancel $ch_localID_
unset ch_localID_
}
return;
}
$self schedule-ch-global
return;
}
if [info exists ch_localID_] {
$ns_ cancel $ch_localID_
unset ch_localID_
}
if [info exists ch_globalID_] {
$ns_ cancel $ch_globalID_
unset ch_globalID_
}

}



Agent/SRM/SSM instproc ch-local {} {
$self instvar repthresh_up_ tentativerep_ tentativettl_ ns_ rep_id_
if {[$self cur-num-reps] > $repthresh_up_} {
set rep_id_ $tentativerep_
puts "[ft $ns_ $self] chlocal rep : $tentativerep_ ttl : $tentativettl_"
$self local-member
$self ch-rep
$self send-session
$self set-local-scope $tentativettl_
}
if [info exists ch_localID_] {	
$ns_ cancel ch_localID_
unset ch_localID_
}
}

Agent/SRM/SSM instproc ch-global {} {
$self instvar repthresh_low_ tentativerep_ tentativettl_ ns_ rep_id_
if {[$self cur-num-reps] < $repthresh_low_} {
set rep_id_ [$self set addr_]
puts "[ft $ns_ $self] chglobal rep : $rep_id_ ttl : $tentativettl_"
$self set-local-scope 0
$self global-rep
$self ch-rep
$self send-session
}
if [info exists ch_globalID_] {	
$ns_ cancel ch_globalID_
unset ch_globalID_
}
}


Agent/SRM/SSM instproc deactivate-reps {time} {
$self instvar numrep_ activerep_ deactivateID_ ns_
$self instvar sessionDelay_ rep_id_
if [info exists activerep_] {
foreach i [array names activerep_] {
set rtime [$activerep_($i) set recvTime_]
if { $rtime < $time} {
delete $activerep_($i)
unset activerep_($i)
incr numrep_ -1
if { $i == $rep_id_ } {
puts "[ft $ns_ $self] $i == $rep_id_" 
$self repchange-action
}
}
}
if {$numrep_ <= 0} {
unset activerep_
}
}
set now [expr [$ns_ now]]
set deactivateID_ [$ns_ at [expr $now + 3 * $sessionDelay_]  "$self deactivate-reps $now"]
}

Agent/SRM/SSM instproc deactivate-locs {time} {
$self instvar numloc_ activeloc_ deactivatelocID_ ns_
$self instvar sessionDelay_ local_scope_
set maxttl 0
if [info exists activeloc_] {
foreach i [array names activeloc_] {
set rtime [$activeloc_($i) set recvTime_]
if { $rtime < $time} {
delete $activeloc_($i)
unset activeloc_($i)
incr numloc_ -1
} else {
if { [$self global-member?] } {
set ttl [$activeloc_($i) set ttl_]
if {$maxttl < $ttl} {
set maxttl $ttl
}
set local_scope_ $maxttl
}
}
}
if {$numloc_ <= 0} {
unset activeloc_
}
}
set now [expr [$ns_ now]]
set deactivatelocID_ [$ns_ at [expr $now + 3 * $sessionDelay_]  "$self deactivate-locs $now"]
}




Class SRMinfo

SRMinfo set recvTime_ 0

SRMinfo instproc init {sender} {
$self next
$self instvar sender_ 
set sender_ $sender
}

SRMinfo instproc set-params {ns agent} {
$self instvar ns_ agent_
set ns_ $ns
set agent_ $agent
}

Class SRMinfo/rep -superclass SRMinfo

SRMinfo/rep instproc recv-gsess {ttl} {
$self instvar recvTime_ ns_ ttl_
set now [$ns_ now]
set recvTime_ [expr $now]
set ttl_ [expr $ttl]
}

Class SRMinfo/loc -superclass SRMinfo


SRMinfo/loc instproc recv-lsess {repid ttl} {
$self instvar recvTime_ ns_ ttl_ repid_
set now [$ns_ now]
set recvTime_ [expr $now]
set ttl_ [expr $ttl]
set repid_ [expr $repid]
}

Agent/MFTP/Snd set dtuSize_ 1424            ;# default size of DTUs (in bytes)
Agent/MFTP/Snd set dtusPerBlock_ 1472       ;# default number of DTUs per block
Agent/MFTP/Snd set dtusPerGroup_ 8          ;# default group size
Agent/MFTP/Snd set fileSize_ 1000000        ;# default file size in bytes
Agent/MFTP/Snd set readAheadBufsize_ 2097152;# default size of read-ahead buffer in bytes
Agent/MFTP/Snd set interval_ 512000         ;# default transmission rate is 512kbps
Agent/MFTP/Snd set txStatusLimit_ 100       ;# default max. number of consecutive status requests without NAK
Agent/MFTP/Snd set txStatusDelay_ 2         ;# default time to wait for status responses after a request before polling again
Agent/MFTP/Snd set rspBackoffWindow_ 1      ;# default max. time for receivers to wait before replying with nak(s) after a request
Agent/MFTP/Snd set reply_addr_ undefined    ; # application _must_ specify the sender address (i.e. the one
;# to which NAKs are unicast to). Default is "undefined"
Agent/MFTP/Snd set reply_port_ undefined

Agent/MFTP/Snd set nakCount_ 0
Agent/MFTP/Snd set seekCount_ 0             ;# number of disk seeks performed

Agent/MFTP/Snd instproc init {} {
$self next
$self instvar ns_ dtuSize_ dtusPerBlock_ dtusPerGroup_ fileSize_ 
$self instvar reply_addr_ reply_port_ readAheadBufsize_ interval_ 
$self instvar txStatusLimit_ txStatusDelay_ rspBackoffWindow_ nakCount_ 
$self instvar seekCount_

set ns_ [Simulator instance]
foreach var { dtuSize_ dtusPerBlock_ dtusPerGroup_ fileSize_  readAheadBufsize_ interval_ txStatusLimit_  txStatusDelay_ rspBackoffWindow_ nakCount_ seekCount_ } {
$self init-instvar $var
}
}

Agent/MFTP/Snd instproc send-data { } {
$self instvar ns_ interval_
if { [$self cmd send data] != -1 } {
$ns_ at [expr [$ns_ now] + $interval_] "$self send-data"
}
}

Agent/MFTP/Snd instproc start {} {
$self instvar node_ dst_addr_

set dst_addr_ [expr $dst_addr_]           ;# get rid of possibly leading 0x etc.

$self cmd start
$node_ join-group $self $dst_addr_
$self send-data
}

Agent/MFTP/Snd instproc pass-finished { CurrentPass NbBlocks } {
$self instvar ns_ dtusPerGroup_ interval_ tx_status_requests_ rspBackoffWindow_

set tx_status_requests_ 0       ;# number of consecutively sent status requests
if { $CurrentPass >= $dtusPerGroup_ - 1 } {
$self send status-req $CurrentPass 0 [expr $NbBlocks-1] $rspBackoffWindow_
} else {
$ns_ at [expr [$ns_ now] + $interval_] "$self send-data"
}
}


Agent/MFTP/Snd instproc send-status-req { CurrentPass blockLo blockHi rspBackoffWindow } {
$self instvar ns_ tx_status_requests_ txStatusDelay_

$self cmd send statreq $CurrentPass $blockLo $blockHi $rspBackoffWindow
incr tx_status_requests_
$ns_ at [expr [$ns_ now] + $txStatusDelay_]  "$self status-rsp-pending $CurrentPass $blockLo $blockHi"
}


Agent/MFTP/Snd instproc status-rsp-pending { CurrentPass blockLo blockHi } {
$self instvar nakCount_ tx_status_requests_ txStatusLimit_ rspBackoffWindow_

if { $nakCount_ > 0 } {
set nakCount_ 0
$self send-data
} elseif { $tx_status_requests_ < $txStatusLimit_ } {
$self send status-req $CurrentPass $blockLo $blockHi $rspBackoffWindow_
} else {
$self done
}
}


Agent/MFTP/Snd instproc recv { type args } {
eval $self evTrace $proc $type $args
eval $self $proc-$type $args
}

Agent/MFTP/Snd instproc send { type args } {
eval $self evTrace $proc $type $args
eval $self $proc-$type $args
}

Agent/MFTP/Snd instproc send-notify { args } {
}

Agent/MFTP/Snd instproc recv-nak { passNb block_nb nak_count} {
}


Agent/MFTP/Snd instproc done {} {
}


Agent/MFTP/Snd instproc trace fd {
$self instvar trace_
set trace_ $fd
}


Agent/MFTP/Snd instproc delete {} {
}

Agent/MFTP/Snd instproc evTrace { op type args } {
$self instvar trace_ ns_
if [info exists trace_] {
puts $trace_ [format "%7.4f [[$self set node_] id] $op-$type $args" [$ns_ now]]
}
}


Agent/MFTP/Rcv set dtuSize_ 1424
Agent/MFTP/Rcv set dtusPerBlock_ 1472
Agent/MFTP/Rcv set dtusPerGroup_ 8
Agent/MFTP/Rcv set fileSize_ 1000000
Agent/MFTP/Rcv set nakCount_ 0
Agent/MFTP/Rcv set seekCount_ 0
Agent/MFTP/Rcv set reply_addr_ 0           ; # unicast reply addr (=address of server)
Agent/MFTP/Rcv set reply_port_ 0           ; # unicast reply addr (=address of server)

Agent/MFTP/Rcv instproc init {} {
$self next
$self instvar ns_ dtuSize_ dtusPerBlock_ dtusPerGroup_ fileSize_ 
$self instvar reply_addr_ reply_port_ nakCount_ seekCount_

set ns_ [Simulator instance]
foreach var { dtuSize_ dtusPerBlock_ dtusPerGroup_ fileSize_ reply_addr_ reply_port_ nakCount_ seekCount_} {
$self init-instvar $var
}
}

Agent/MFTP/Rcv instproc start {} {
$self instvar node_ dst_addr_

set dst_addr_ [expr $dst_addr_]           ;# get rid of possibly leading 0x etc.
$self cmd start
$node_ join-group $self $dst_addr_
}

Agent/MFTP/Rcv instproc delete {} {
}

Agent/MFTP/Rcv instproc done-notify { args } {

$self instvar node_ dst_addr_
eval $self evTrace done notify $args
$node_ leave-group $self $dst_addr_
}

Agent/MFTP/Rcv instproc recv { type args } {
eval $self evTrace $proc $type $args
eval $self recv-$type $args
}


Agent/MFTP/Rcv instproc recv-dependent { CurrentPass CurrentGroup CwPat } {
}

Agent/MFTP/Rcv instproc recv-group-full { CurrentPass CurrentGroup CwPat } {
}

Agent/MFTP/Rcv instproc recv-useful { CurrentPass CurrentGroup CwPat } {
}

Agent/MFTP/Rcv instproc recv-status-req { passNb blockLo blockHi txStatusDelay } {
$self instvar ns_
set backoff [uniform 0 $txStatusDelay]
$ns_ at [expr [$ns_ now] + $backoff] "$self send-nak [list $passNb $blockLo $blockHi]"
}

Agent/MFTP/Rcv instproc send-nak { passNb blockLo blockHi } {
while { $blockLo <= $blockHi } {
set bit_count [$self cmd send nak $passNb $blockLo]
$self evTrace send nak $passNb $blockLo $bit_count
incr blockLo
}
}

Agent/MFTP/Rcv instproc trace fd {
$self instvar trace_
set trace_ $fd
}

Agent/MFTP/Rcv instproc evTrace { op type args } {
$self instvar trace_ ns_
if [info exists trace_] {
puts $trace_ [format "%7.4f [[$self set node_] id] $op-$type $args" [$ns_ now]]
}
}


Class Agent/MFTP/Rcv/Stat -superclass Agent/MFTP/Rcv

Agent/MFTP/Rcv/Stat instproc init { } {
$self instvar nb_useful_recv nb_full_disc nb_lin_dep_disc

$self next
foreach var [list nb_useful_recv nb_full_disc nb_lin_dep_disc] {
set $var 0
}
}

Agent/MFTP/Rcv/Stat instproc recv-useful { CurrentPass CurrentGroup CwPat } {
$self instvar nb_useful_recv

puts stdout "recv-useful!"
$self next $CurrentPass $CurrentGroup $CwPat

incr nb_useful_recv
}


Agent/MFTP/Rcv/Stat instproc recv-group-full { CurrentPass CurrentGroup CwPat } {
$self instvar nb_full_disc

puts stdout "recv-group-full!"
$self next $CurrentPass $CurrentGroup $CwPat

incr nb_full_disc
}


Agent/MFTP/Rcv/Stat instproc recv-dependent { CurrentPass CurrentGroup CwPat } {
$self instvar nb_lin_dep_disc

puts stdout "recv-dependent!"
$self next $CurrentPass $CurrentGroup $CwPat

incr nb_lin_dep_disc
}

Agent/MFTP/Rcv/Stat instproc done-notify { args } {
$self instvar nb_useful_recv nb_full_disc nb_lin_dep_disc
eval $self next $args $nb_useful_recv $nb_full_disc $nb_lin_dep_disc
}
Class McastMonitor

McastMonitor instproc init {} {
$self instvar period_ ns_

set ns_ [Simulator instance]
set period_ 0.03
}

McastMonitor instproc trace-topo {} {
$self instvar ns_ period_

$self trace-links [$ns_ all-links-list]
}

McastMonitor instproc trace-links links {
$self instvar pktmon_

foreach l $links {
set pktmon_($l) [new PktInTranMonitor]
$pktmon_($l) attach-link $l
$l add-pktmon $pktmon_($l)
}
}

McastMonitor instproc filter {header field value} {
$self instvar pktmon_

foreach index [array name pktmon_] {
$pktmon_($index) filter $header $field $value
}
}

McastMonitor instproc pktintran {} {
$self instvar ns_ pktmon_

set total 0
foreach index [array name pktmon_] {
if {[$index up?] == "up"} {
incr total [$pktmon_($index) pktintran]
}
}
return $total
}

McastMonitor instproc print-trace {} {
$self instvar ns_ period_ file_

if [info exists file_] {
puts $file_ "[$ns_ now] [$self pktintran]"
} else {
puts "[$ns_ now] [$self pktintran]"
}
$ns_ at [expr [$ns_ now] + $period_] "$self print-trace"
}

McastMonitor instproc attach file {
$self instvar file_
set file_ $file
}


Class PktInTranMonitor

PktInTranMonitor instproc init {} {
$self instvar period_ ns_ front_counter_ rear_counter_ front_filter_ rear_filter_ 
set ns_ [Simulator instance]
set period_ 0.03
set front_counter_ [new PktCounter]
$front_counter_ set pktInTranMonitor_ $self
set front_filter_ [new Filter/MultiField]
$front_filter_ filter-target $front_counter_


set rear_counter_ [new PktCounter]
$rear_counter_ set pktInTranMonitor_ $self
set rear_filter_ [new Filter/MultiField]
$rear_filter_ filter-target $rear_counter_
}

PktInTranMonitor instproc reset {} {
$self instvar front_counter_ rear_counter_  ns_ next_
$front_counter_ reset
$rear_counter_ reset
if {[info exist next_] && $next_ != 0} {
$next_ reset
}
}

PktInTranMonitor instproc filter {header field value} {
$self instvar front_filter_ rear_filter_
$front_filter_ filter-field [PktHdr_offset PacketHeader/$header $field] $value
$rear_filter_ filter-field [PktHdr_offset PacketHeader/$header $field] $value
}

PktInTranMonitor instproc attach-link link {
$self instvar front_filter_ rear_filter_ front_counter_ rear_counter_

set tmp [$link head]
while {[$tmp target] != [$link link]} {
set tmp [$tmp target]
}

$tmp target $front_filter_
$front_filter_ target [$link link]
$front_counter_ target [$link link]

$rear_filter_ target [[$link link] target]
$rear_counter_ target [[$link link] target]
[$link link] target $rear_filter_
}

PktInTranMonitor instproc attach file {
$self instvar file_
set file_ $file
}

PktInTranMonitor instproc pktintran {} {
$self instvar front_counter_ rear_counter_ 
return [expr [$front_counter_ value] - [$rear_counter_ value]]
}

PktInTranMonitor instproc output {} {
$self instvar front_counter_ rear_counter_ ns_ file_ 

puts $file_ "[$ns_ now] [expr [$front_counter_ value] - [$rear_counter_ value]]"
}


PktInTranMonitor instproc periodical-output {} {
$self instvar period_ ns_

$self output
$ns_ at [expr [$ns_ now] + $period_] "$self periodical-output"
}

Simulator instproc all-links-list {} {
$self instvar link_
set links ""
foreach n [array names link_] {
lappend links $link_($n)
}
set links
}

Link instproc add-pktmon pktmon {
$self instvar pktmon_

if [info exists pktmon_] {
$pktmon set next_ $pktmon_
} else {
$pktmon set next_ 0
}
set pktmon_ $pktmon
}


set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25



Class MMG

MMG instproc init { levels } {
$self next

$self instvar debug_ env_ maxlevel_
set debug_ 0
set env_ [lindex [split [$self info class] /] 1]
set maxlevel_ $levels

global rlm_debug_flag
if [info exists rlm_debug_flag] {
set debug_ $rlm_debug_flag
}

$self instvar TD TDVAR state_ subscription_
global rlm_param
set TD $rlm_param(init-td)
set TDVAR $rlm_param(init-td-var)
set state_ /S

$self instvar layer_ layers_
set i 1
while { $i <= $maxlevel_ } {
set layer_($i) [$self create-layer [expr $i - 1]]
lappend layers_ $layer_($i)
incr i
}

set subscription_ 0
$self add-layer

set state_ /S

$self set_TJ_timer
}

MMG instproc set-state s {
$self instvar state_
set old $state_
set state_ $s
$self debug "FSM: $old -> $s"
}

MMG instproc drop-layer {} {
$self dumpLevel
$self instvar subscription_ layer_
set n $subscription_

if { $n > 0 } {
$self debug "DRP-LAYER $n"
$layer_($n) leave-group 
incr n -1
set subscription_ $n
}
$self dumpLevel
}

MMG instproc add-layer {} {
$self dumpLevel
$self instvar maxlevel_ subscription_ layer_
set n $subscription_
if { $n < $maxlevel_ } {
$self debug "ADD-LAYER"
incr n
set subscription_ $n
$layer_($n) join-group
}
$self dumpLevel
}

MMG instproc current_layer_getting_packets {} {
$self instvar subscription_ layer_ TD
set n $subscription_
if { $n == 0 } {
return 0
}

set l $layer_($subscription_)
$self debug "npkts [$l npkts]"
if [$l getting-pkts] {
return 1
}

set delta [expr [$self now] - [$l last-add]]
if { $delta > $TD } {
set TD [expr 1.2 * $delta]
}
return 0
}

MMG instproc mmg_loss {} {
$self instvar layers_
set loss 0
foreach l $layers_ {
incr loss [$l nlost]
}
return $loss
}

MMG instproc mmg_pkts {} {
$self instvar layers_
set npkts 0
foreach l $layers_ {
incr npkts [$l npkts]
}
return $npkts
}

MMG instproc check-equilibrium {} {
global rlm_param
$self instvar subscription_ maxlevel_ layer_

set n [expr $subscription_ + 1]
if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
set eq 1
} else {
set eq 0
}

$self debug "EQ $eq"
}

MMG instproc backoff-one { n alpha } {
$self debug "BACKOFF $n by $alpha"
$self instvar layer_
$layer_($n) backoff $alpha
}

MMG instproc backoff n {
$self debug "BACKOFF $n"
global rlm_param
$self instvar maxlevel_ layer_
set alpha $rlm_param(alpha)
set L $layer_($n)
$L backoff $alpha
incr n
while { $n <= $maxlevel_ } {
$layer_($n) peg-backoff $L
incr n
}
$self check-equilibrium
}

MMG instproc highest_level_pending {} {
$self instvar maxlevel_
set m ""
set n 0
incr n
while { $n <= $maxlevel_ } {
if [$self level_pending $n] {
set m $n
}
incr n
}
return $m
}

MMG instproc rlm_update_D  D {
global rlm_param
$self instvar TD TDVAR

set v [expr abs($D - $TD)]
set TD [expr $TD * (1 - $rlm_param(g1))  + $rlm_param(g1) * $D]
set TDVAR [expr $TDVAR * (1 - $rlm_param(g2))  + $rlm_param(g2) * $v]
}

MMG instproc exceed_loss_thresh {} {
$self instvar h_npkts h_nlost
set npkts [expr [$self mmg_pkts] - $h_npkts]
if { $npkts >= 10 } {
set nloss [expr [$self mmg_loss] - $h_nlost]
set loss [expr double($nloss) / ($nloss + $npkts)]
$self debug "H-THRESH $nloss $npkts $loss"
if { $loss > 0.25 } {
return 1
}
}
return 0
}

MMG instproc enter_M {} {
$self set-state /M
$self set_TD_timer_wait
$self instvar h_npkts h_nlost
set h_npkts [$self mmg_pkts]
set h_nlost [$self mmg_loss]
}

MMG instproc enter_D {} {
$self set-state /D
$self set_TD_timer_conservative
}

MMG instproc enter_H {} {
$self set_TD_timer_conservative
$self set-state /H
}

MMG instproc log-loss {} {
$self debug "LOSS [$self mmg_loss]"

$self instvar state_ subscription_ pending_ts_
if { $state_ == "/M" } {
if [$self exceed_loss_thresh] {
$self cancel_timer TD
$self drop-layer
$self check-equilibrium
$self enter_D
}
return
}
if { $state_ == "/S" } {
$self cancel_timer TD
set n [$self highest_level_pending]
if { $n != "" } {
$self backoff $n
if { $n == $subscription_ } {
set ts $pending_ts_($subscription_)
$self rlm_update_D [expr [$self now] - $ts]
$self drop-layer
$self check-equilibrium
$self enter_D
return
}
if { $n == [expr $subscription_ + 1] } {
$self cancel_timer TJ
$self set_TJ_timer
}
}
if [$self our_level_recently_added] {
$self enter_M
return
}
$self enter_H
return
}
if { $state_ == "/H" || $state_ == "/D" } {
return
}
puts stderr "rlm state machine botched"
exit -1
}

MMG instproc relax_TJ {} {
$self instvar subscription_ layer_
if { $subscription_ > 0 } {
$layer_($subscription_) relax
$self check-equilibrium
}
}

MMG instproc trigger_TD {} {
$self instvar state_
if { $state_ == "/H" } {
$self enter_M
return
}
if { $state_ == "/D" || $state_ == "/M" } {
$self set-state /S
$self set_TD_timer_conservative
return
}
if { $state_ == "/S" } {
$self relax_TJ
$self set_TD_timer_conservative
return
}
puts stderr "trigger_TD: rlm state machine botched $state)"
exit -1
}

MMG instproc set_TJ_timer {} {
global rlm_param
$self instvar subscription_ layer_
set n [expr $subscription_ + 1]
if ![info exists layer_($n)] {
return
}
set I [$layer_($n) timer]
set d [expr $I / 2.0 + [trunc_exponential $I]]
$self debug "TJ $d"
$self set_timer TJ $d
}

MMG instproc set_TD_timer_conservative {} {
$self instvar TD TDVAR
set delay [expr $TD + 1.5 * $TDVAR]
$self set_timer TD $delay
}

MMG instproc set_TD_timer_wait {} {
$self instvar TD TDVAR
$self instvar subscription_
set k [expr $subscription_ / 2. + 1.5]
$self set_timer TD [expr $TD + $k * $TDVAR]
}

MMG instproc is-recent { ts } {
$self instvar TD TDVAR
set ts [expr $ts + ($TD + 2 * $TDVAR)]
if { $ts > [$self now] } {
return 1
}
return 0
}

MMG instproc level_pending n {
$self instvar pending_ts_
if { [info exists pending_ts_($n)] &&  [$self is-recent $pending_ts_($n)] } {
return 1
}
return 0
}

MMG instproc level_recently_joined n {
$self instvar join_ts_
if { [info exists join_ts_($n)] &&  [$self is-recent $join_ts_($n)] } {
return 1
}
return 0
}

MMG instproc pending_inferior_jexps {} {
set n 0
$self instvar subscription_
while { $n <= $subscription_ } { 
if [$self level_recently_joined $n] {
return 1
}
incr n
}
$self debug "NO-PEND-INF"
return 0
}

MMG instproc trigger_TJ {} {
$self debug "trigger-TJ"
$self instvar state_ ctrl_ subscription_
if { ($state_ == "/S" && ![$self pending_inferior_jexps] &&  [$self current_layer_getting_packets])  } {
$self add-layer
$self check-equilibrium
set msg "add $subscription_"
$ctrl_ send $msg
$self local-join
}
$self set_TJ_timer
}

MMG instproc our_level_recently_added {} {
$self instvar subscription_ layer_
return [$self is-recent [$layer_($subscription_) last-add]]
}


MMG instproc recv-ctrl msg {
$self instvar join_ts_ pending_ts_ subscription_
$self debug "X-JOIN $msg"
set what [lindex $msg 0]
if { $what != "add" } {
return
}
set level [lindex $msg 1]
set join_ts_($level) [$self now]
if { $level > $subscription_ } {
set pending_ts_($level) [$self now]
}
}

MMG instproc local-join {} {
$self instvar subscription_ pending_ts_ join_ts_
set join_ts_($subscription_) [$self now]
set pending_ts_($subscription_) [$self now]
}

MMG instproc debug { msg } {
$self instvar debug_ subscription_ state_
if {$debug_} {
puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
}
}

MMG instproc dumpLevel {} {
}



Class Layer

Layer instproc init { mmg } {
$self next

$self instvar mmg_ TJ npkts_
global rlm_param
set mmg_ $mmg
set TJ $rlm_param(init-tj)
set npkts_ 0
}

Layer instproc relax {} {
global rlm_param
$self instvar TJ
set TJ [expr $TJ * $rlm_param(beta)]
if { $TJ <= $rlm_param(init-tj) } {
set TJ $rlm_param(init-tj)
}
}

Layer instproc backoff alpha {
global rlm_param
$self instvar TJ
set TJ [expr $TJ * $alpha]
if { $TJ >= $rlm_param(max) } {
set TJ $rlm_param(max)
}
}

Layer instproc peg-backoff L {
$self instvar TJ
set t [$L set TJ]    
if { $t >= $TJ } {
set TJ $t
}
}

Layer instproc timer {} {
$self instvar TJ
return $TJ
}

Layer instproc last-add {} {
$self instvar add_time_
return $add_time_
}

Layer instproc join-group {} {
$self instvar npkts_ add_time_ mmg_
set npkts_ [$self npkts]
set add_time_ [$mmg_ now]
}

Layer instproc leave-group {} {
}

Layer instproc getting-pkts {} {
$self instvar npkts_
return [expr [$self npkts] != $npkts_]
}

Agent/LossMonitor set npkts_ 0
Agent/LossMonitor set bytes_ 0
Agent/LossMonitor set nlost_ 0
Agent/LossMonitor set lastPktTime_ 0

Class LossTrace -superclass Agent/LossMonitor
LossTrace set expected_ -1

LossTrace instproc init {} {
$self next
$self instvar lastTime
set lastTime 0
}

LossTrace instproc log-loss {} {
$self instvar mmg_
$mmg_ log-loss

global lossTraceFile lossNode
if [info exists lossTraceFile] {
set id [[$mmg_ node] id]
if { [info exists lossNode] && $lossNode != $id } {
return
}
set f $lossTraceFile
$self instvar layerNo seqno_ expected_ lastPktTime_  lastSeqno lastTime
if [info exists lastSeqno] {
set npkt [expr $expected_ - $lastSeqno]
puts $f "p $id $layerNo $lastTime $lastPktTime_ $npkt"
set lastTime $lastPktTime_
}
set lost [expr $seqno_ - $expected_]
set t [ns-now]
puts $f "d $id $layerNo $lastPktTime_ $t $lost"
set lastSeqno $seqno_
set lastTime $t
}
}

LossTrace instproc flush {} {
global lossTraceFile
$self instvar lastSeqno expected_ layerNo lastTime  lastPktTime_ mmg_ seqno_
if [info exists lastSeqno] {
set id [[$mmg_ node] id]
set npkt [expr $seqno_ - $lastSeqno]
if { $npkt != 0 } {
puts $lossTraceFile  "p $id $layerNo $lastTime $lastPktTime_ $npkt"
}
unset lastSeqno
}
}



Class Layer/ns -superclass Layer

Layer/ns instproc init {ns mmg addr layerNo} {
$self next $mmg

$self instvar ns_ addr_ mon_
set ns_ $ns
set addr_ $addr
set mon_ [$ns_ create-agent [$mmg node] LossTrace 0]
$mon_ set layerNo $layerNo
$mon_ set mmg_ $mmg
$mon_ set dst_ $addr
}

Layer/ns instproc join-group {} {
$self instvar mon_ mmg_ addr_
$mon_ clear
[$mmg_ node] join-group $mon_ $addr_
$self next
}

Layer/ns instproc leave-group {} {
$self instvar mon_ mmg_ addr_
[$mmg_ node] leave-group $mon_ $addr_
$self next
}

Layer/ns instproc npkts {} {
$self instvar mon_
return [$mon_ set npkts_]
}

Layer/ns instproc nlost {} {
$self instvar mon_
return [$mon_ set nlost_]
}

Layer/ns instproc mon {} {
$self instvar mon_
return $mon_
}

Class MMG/ns -superclass MMG

MMG/ns instproc init {ns localNode caddr addrs} {
$self instvar ns_ node_ addrs_
set ns_ $ns
set node_ $localNode
set addrs_ $addrs

$self next [llength $addrs]

$self instvar ctrl_
set ctrl_ [$ns create-agent $node_ Agent/Message 0]
$ctrl_ set dst_ $caddr
$ctrl_ proc handle msg "$self recv-ctrl \$msg"
$node_ join-group $ctrl_ $caddr
}

MMG/ns instproc create-layer {layerNo} {
$self instvar ns_ addrs_
return [new Layer/ns $ns_ $self [lindex $addrs_ $layerNo] $layerNo]
}

MMG/ns instproc now {} {
$self instvar ns_
return [$ns_ now]
}

MMG/ns instproc set_timer {which delay} {
$self instvar ns_ timers_
if [info exists timers_($which)] {
puts "timer botched ($which)"
exit 1
}
set time [expr [$ns_ now] + $delay]
set timers_($which) [$ns_ at $time "$self trigger_timer $which"]
}

MMG/ns instproc trigger_timer {which} {
$self instvar timers_
unset timers_($which)
$self trigger_$which
}

MMG/ns instproc cancel_timer {which} {
$self instvar ns_ timers_
if [info exists timers_($which)] {
$ns_ at $timers_($which)
unset timers_($which)
}
}




MMG/ns instproc node {} {
$self instvar node_
return $node_
}

MMG/ns instproc debug { msg } {
$self instvar debug_
if {!$debug_} { return }

$self instvar subscription_ state_ node_
set time [format %.05f [ns-now]]
puts stderr "$time node [$node_ id] layer $subscription_ $state_ $msg"
}

MMG/ns instproc trace { trace } {
$self instvar layers_
foreach s $layers_ {
[$s mon] trace $trace
}
}


MMG/ns instproc total_bytes_delivered {} {
$self instvar layers_
set v 0
foreach s $layers_ {
incr v [[$s mon] set bytes]
}
return $v
}

Class SessionSim -superclass Simulator
SessionSim set MixMode_ 0

SessionSim instproc create-session { srcNode srcAgent } {
$self instvar session_

set nid [$srcNode id]
set dst [$srcAgent set dst_addr_]
set session_($nid:$dst:$nid) [new SessionHelper]
$session_($nid:$dst:$nid) set-node $nid
if [SessionSim set rc_] {
$session_($nid:$dst:$nid) set rc_ 1
}

set trace [$self get-nam-traceall]
if {$trace != ""} {
set p [$self create-trace SessEnque $trace $nid $dst "nam"]
$srcAgent target $p
$p target $session_($nid:$dst:$nid)
} else {
$srcAgent target $session_($nid:$dst:$nid)
}

return $session_($nid:$dst:$nid)
}

SessionSim instproc update-loss-dependency { src dst owner agent group } {
$self instvar session_ routingTable_ loss_

set loss_rcv 1
set tmp $dst
while {$tmp != $owner} {
set next [$routingTable_ lookup $tmp $owner]
if {[info exists loss_($next:$tmp)] && $loss_($next:$tmp) != 0} {
if {$loss_rcv} {
set dep_loss [$session_($src:$group:$owner) update-loss-rcv $loss_($next:$tmp) $agent]
} else {
set dep_loss [$session_($src:$group:$owner) update-loss-loss $loss_($next:$tmp) $dep_loss]
}

if {$dep_loss == 0} { 
return 
}
set loss_rcv 0
}
set tmp $next
}

if [info exists dep_loss] {
$session_($src:$group:$owner) update-loss-top $dep_loss
}
}

SessionSim instproc join-group { rcvAgent group } {
$self instvar session_ routingTable_ delay_ bw_

foreach index [array names session_] {
set tri [split $index :]
if {[lindex $tri 1] == $group} {
set src [lindex $tri 0]
set dst [[$rcvAgent set node_] id]
set delay 0
set accu_bw 0
set ttl 0
set tmp $dst
while {$tmp != $src} {
set next [$routingTable_ lookup $tmp $src]
set delay [expr $delay + $delay_($tmp:$next)]
if {$accu_bw} {
set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
} else {
set accu_bw $bw_($tmp:$next)
}
incr ttl
set tmp $next
}

$self puts-nam-config "G -t [$self now] -i $group -a $dst"

set f [$self get-nam-traceall]
if {$f != ""} { 
set p [$self create-trace SessDeque $f $src $dst "nam"]
$p target $rcvAgent
$session_($index) add-dst $accu_bw $delay $ttl $dst $p
$self update-loss-dependency $src $dst $src $p $group
} else {
$session_($index) add-dst $accu_bw $delay $ttl $dst $rcvAgent
$self update-loss-dependency $src $dst $src $rcvAgent $group
}
}
}
}

SessionSim instproc leave-group { rcvAgent group } {
$self instvar session_

foreach index [array names session_] {
set tri [split $index :]
if {[lindex $tri 1] == $group} {
set dst [[$rcvAgent set node_] id]
$self puts-nam-traceall  "G -t [$self now] -i $group -x $dst"
}
}
}

SessionSim instproc insert-loss { lossmodule from to } {
$self instvar loss_ bw_ Node_

if {[SessionSim set MixMode_] && [$self detailed-link? [$from id] [$to id]]} {
$self lossmodel $lossmodule $from $to
} elseif [info exists bw_([$from id]:[$to id])] {
set loss_([$from id]:[$to id]) $lossmodule
}
}

SessionSim instproc get-delay { src dst } {
$self instvar routingTable_ delay_
set delay 0
set tmp $src
while {$tmp != $dst} {
set next [$routingTable_ lookup $tmp $dst]
set delay [expr $delay + $delay_($tmp:$next)]
set tmp $next
}
return $delay
}

SessionSim instproc get-bw { src dst } {
$self instvar routingTable_ bw_
set accu_bw 0
set tmp $src
while {$tmp != $dst} {
set next [$routingTable_ lookup $tmp $dst]
if {$accu_bw} {
set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
} else {
set accu_bw $bw_($tmp:$next)
}
set tmp $next
}
return $accu_bw
}

SessionSim instproc node args {
$self instvar sessionNode_
if {[llength $args] == 0} {
set node [new SessionNode]
} else {
set node [new SessionNode $args]
}
set sessionNode_([$node id]) $node
$node set ns_ $self
return $node
}

SessionSim instproc simplex-link { n1 n2 bw delay type } {
$self instvar bw_ delay_ linkAttr_
set sid [$n1 id]
set did [$n2 id]

set bw_($sid:$did) [bw_parse $bw]
set delay_($sid:$did) [delay_parse $delay]

set linkAttr_($sid:$did:ORIENT) ""
set linkAttr_($sid:$did:COLOR) "black"
}

SessionSim instproc duplex-link { n1 n2 bw delay type } {
$self simplex-link $n1 $n2 $bw $delay $type
$self simplex-link $n2 $n1 $bw $delay $type

$self session-register-nam-linkconfig [$n1 id]:[$n2 id]
}

SessionSim instproc simplex-link-of-interfaces { n1 n2 bw delay type } {
$self simplex-link $n1 $n2 $bw $delay $type
}

SessionSim instproc duplex-link-of-interfaces { n1 n2 bw delay type } {
$self simplex-link $n1 $n2 $bw $delay $type
$self simplex-link $n2 $n1 $bw $delay $type

$self session-register-nam-linkconfig [$n1 id]:[$n2 id]
}

SessionSim instproc detailed-node { id address } {
$self instvar Node_

if { [Simulator info vars EnableMcast_] != "" } {
warn "Flag variable Simulator::EnableMcast_ discontinued.\n\t Use multicast methods as:\n\t\t % set ns \[new Simulator -multicast on]\n\t\t % \$ns multicast"
$self multicast
Simulator unset EnableMcast_
}
if ![info exist Node_($id)] {
set node [new [Simulator set node_factory_] $address]
Node set nn_ [expr [Node set nn_] - 1]
$node set id_ $id
set Node_($id) $node

if [$self multicast?] {
$node enable-mcast $self
}
return $node
} else {
return $Node_($id)
}
}

SessionSim instproc detailed-duplex-link { from to } {
$self instvar bw_ delay_

SessionSim set MixMode_ 1
set fromNode [$self detailed-node [$from id] [$from set address_]]
set toNode [$self detailed-node [$to id] [$from set address_]]

$self simulator-duplex-link $fromNode $toNode $bw_([$from id]:[$to id]) $delay_([$from id]:[$to id]) DropTail
}

SessionSim instproc simulator-duplex-link { n1 n2 bw delay type args } {
$self instvar link_
set i1 [$n1 id]
set i2 [$n2 id]
if [info exists link_($i1:$i2)] {
$self remove-nam-linkconfig $i1 $i2
}

eval $self simulator-simplex-link $n1 $n2 $bw $delay $type $args
eval $self simulator-simplex-link $n2 $n1 $bw $delay $type $args
}

SessionSim instproc simulator-simplex-link { n1 n2 bw delay qtype args } {
$self instvar link_ queueMap_ nullAgent_
set sid [$n1 id]
set did [$n2 id]

if [info exists queueMap_($qtype)] {
set qtype $queueMap_($qtype)
}
set qtypeOrig $qtype
switch -exact $qtype {
ErrorModule {
if { [llength $args] > 0 } {
set q [eval new $qtype $args]
} else {
set q [new $qtype Fid]
}
}
intserv {
set qtype [lindex $args 0]
set q [new Queue/$qtype]
}
default {
set q [new Queue/$qtype]
}
}

switch -exact $qtypeOrig {
RTM {
set c [lindex $args 1]
set link_($sid:$did) [new CBQLink        $n1 $n2 $bw $delay $q $c]
}
CBQ -
CBQ/WRR {
if {[llength $args] == 0} {
set c [new Classifier/Hash/Fid 33]
} else {
set c [lindex $args 1]
}
set link_($sid:$did) [new CBQLink        $n1 $n2 $bw $delay $q $c]
}
intserv {
set link_($sid:$did) [new IntServLink    $n1 $n2 $bw $delay $q	 [concat $qtypeOrig $args]]
}
default {
set link_($sid:$did) [new SimpleLink     $n1 $n2 $bw $delay $q]
}
}
$n1 add-neighbor $n2

if {[string first "RED" $qtype] != -1} {
$q link [$link_($sid:$did) set link_]
}

set trace [$self get-ns-traceall]
if {$trace != ""} {
$self trace-queue $n1 $n2 $trace
}
set trace [$self get-nam-traceall]
if {$trace != ""} {
$self namtrace-queue $n1 $n2 $trace
}

$self register-nam-linkconfig $link_($sid:$did)
}

SessionSim instproc duplex-link-op { n1 n2 op args } {
$self instvar linkAttr_ bw_

set sid [$n1 id]
set did [$n2 id]

if ![info exists bw_($sid:$did)] {
error "Non-existent link [$n1 id]:[$n2 id]"
}

switch $op {
"orient" {
set linkAttr_($sid:$did:ORIENT) $args
set linkAttr_($did:$sid:ORIENT) $args
}
"color" {
set ns [Simulator instance]
$ns puts-nam-traceall  [eval list "l -t [$self now] -s $sid -d $did  -S COLOR -c $args -o $linkAttr_($sid:$did:COLOR)"]
$ns puts-nam-traceall  [eval list "l -t [$self now] -s $did -d $sid  -S COLOR -c $args -o $linkAttr_($sid:$did:COLOR)"]
eval set attr_($sid:$did:COLOR) $args
eval set attr_($did:$sid:COLOR) $args
}
default {
eval puts "Duplex link option $args not implemented  in SessionSim"
}
} 
}

SessionSim instproc session-register-nam-linkconfig link {
$self instvar sessionLinkConfigList_ bw_ linkAttr_
if [info exists sessionLinkConfigList_] {
set tmp [split $link :]
set i1 [lindex $tmp 0]
set i2 [lindex $tmp 1]
if [info exists bw_($i2:$i1)] {
set pos [lsearch $sessionLinkConfigList_ $i2:$i1]
if {$pos >= 0} {
set a1 $linkAttr_($i2:$i1:ORIENT)
set a2 $linkAttr_($link:ORIENT)
if {$a1 == "" && $a2 != ""} {
set sessionLinkConfigList_ [lreplace $sessionLinkConfigList_ $pos $pos]
} else {
return
}
}
}

set pos [lsearch $sessionLinkConfigList_ $link]
if {$pos >= 0} {
set sessionLinkConfigList_  [lreplace $sessionLinkConfigList_ $pos $pos]
}
}
lappend sessionLinkConfigList_ $link
}

SessionSim instproc dump-namlinks {} {
$self instvar bw_ delay_ sessionLinkConfigList_ linkAttr_

set ns [Simulator instance]
foreach lnk $sessionLinkConfigList_ {
set tmp [split $lnk :]
set i1 [lindex $tmp 0]
set i2 [lindex $tmp 1]
$ns puts-nam-traceall  "l -t * -s $i1 -d $i2 -S UP -r $bw_($lnk) -D  $delay_($lnk) -o $linkAttr_($lnk:ORIENT)"
}
}

SessionSim instproc dump-namnodes {} {
$self instvar sessionNode_
if ![$self is-started] {
return
}
foreach nn [array names sessionNode_] {
if ![$sessionNode_($nn) is-lan?] {
$sessionNode_($nn) dump-namconfig
}
}
}     
SessionSim instproc compute-routes {} {
if [Simulator set EnableHierRt_] {
$self compute-hier-routes 
} else {
$self compute-flat-routes
}
}

SessionSim instproc compute-flat-routes {} {
$self instvar bw_
set r [$self get-routelogic]
foreach ln [array names bw_] {
set L [split $ln :]
set srcID [lindex $L 0]
set dstID [lindex $L 1]
if {$bw_($ln) != 0} {
$r insert $srcID $dstID
} else {
$r reset $srcID $dstID
}
}
$r compute
}

SessionSim instproc compute-hier-routes {} {
$self instvar bw_
set r [$self get-routelogic]
set level [AddrParams set hlevel_]
$r hlevel-is $level
$self hier-topo $r

foreach ln [array names bw_] {
set L [split $ln :]
set srcID [[$self get-node-by-id [lindex $L 0]] node-addr]
set dstID [[$self get-node-by-id [lindex $L 1]] node-addr]
if { $bw_($ln) != 0 } {
$r hier-insert $srcID $dstID
} else {
$r hier-reset $srcID $dstID
}
}       
$r hier-compute
}

SessionSim instproc compute-algo-routes {} {
set r [$self get-routelogic]


$r BFS
$r compute
}

SessionSim instproc dump-routelogic-distance {} {
$self instvar routingTable_ sessionNode_ bw_
if ![info exists routingTable_] {
puts "error: routing table is not computed yet!"
return 0
}

set n [Node set nn_]
set i 0
puts -nonewline "\t"
while { $i < $n } {
if ![info exists sessionNode_($i)] {
incr i
continue
}
puts -nonewline "$i\t"
incr i
}

set i 0
while { $i < $n } {
if ![info exists sessionNode_($i)] {
incr i
continue
}
puts -nonewline "\n$i\t"
set n1 $sessionNode_($i)
set j 0
while { $j < $n } {
if { $i != $j } {
set nh [$routingTable_ lookup $i $j]
if { $nh >= 0 } {
set distance 0
set tmpfrom $i
set tmpto $j
while {$tmpfrom != $tmpto} {
set tmpnext [$routingTable_ lookup $tmpfrom $tmpto]
set distance [expr $distance + 1]
set tmpfrom $tmpnext
}
puts -nonewline "$distance\t"
} else {
puts -nonewline "0\t"
}
} else {
puts -nonewline "0\t"
}
incr j
}
incr i
}
puts ""
}

SessionSim instproc run args {
$self rtmodel-configure                 ;# in case there are any
[$self get-routelogic] configure
$self instvar scheduler_ sessionNode_ started_

set started_ 1

foreach nn [array names sessionNode_] {
$sessionNode_($nn) reset
}

if [SessionSim set MixMode_] {
foreach nn [array names Node_] {
$Node_($nn) reset
}
}

$self dump-namcolors
$self dump-namnodes
$self dump-namlinks
$self dump-namagents

return [$scheduler_ run]
}

SessionSim instproc get-mcast-tree { src grp } {
$self instvar treeLinks_ session_

if [info exists treeLinks_] {
unset treeLinks_
}

set sid [$src id] 

foreach idx [array names session_] {
set tri [split $idx :]
if {[lindex $tri 0] == $sid && [lindex $tri 1] == $grp} {
set mbrs [$session_($idx) list-mbr]
break
}
}		

foreach mbr $mbrs {
while {![string match "Agent*" [$mbr info class]]} {
set mbr [$mbr target]
}
set mid [[$mbr set node_] id]
if {$sid == $mid} {
continue
}
$self merge-path $sid $mid
}

foreach lnk [array names treeLinks_] {
lappend res $lnk $treeLinks_($lnk)
}
return $res
}

SessionSim instproc merge-path { src mbr } {
$self instvar routingTable_ treeLinks_ bw_

set tmp $mbr
while {$tmp != $src} {
set nxt [$routingTable_ lookup $tmp $src]
if ![info exists treeLinks_($nxt:$tmp)] {
set treeLinks_($nxt:$tmp) $bw_($nxt:$tmp)
}
if [info exists treeLinks_($tmp:$nxt)] {
error "Reverse links in a SPT!"
}
set tmp $nxt
}
}

SessionSim instproc get-node-by-id id {
$self instvar sessionNode_ Node_
if [info exists Node_($id)] {
set Node_($id)
} else {
set sessionNode_($id)
}
}

SessionSim instproc get-node-id-by-addr address {
$self instvar sessionNode_
set n [Node set nn_]
for {set q 0} {$q < $n} {incr q} {
set nq $sessionNode_($q)
if {[string compare [$nq node-addr] $address] == 0} {
return $q
}
}
error "get-node-id-by-addr:Cannot find node with given address"
}

Class SessionNode -superclass Node
SessionNode instproc init args {
$self instvar id_ np_ address_
set id_ [Node getid]
set np_ 0
if {[llength $args] > 0} {
set address_ $args
} else {
set address_ $id_
}
}

SessionNode instproc id {} {
$self instvar id_
return $id_
}

SessionNode instproc reset {} {
}

SessionNode instproc alloc-port {} {
$self instvar np_
set p $np_
incr np_
return $p
}

SessionNode instproc attach agent {
$self instvar id_ address_

$agent set node_ $self
set port [$self alloc-port]

set mask 0xffffffff
set shift 0
if [Simulator set EnableHierRt_] {
set nodeaddr [AddrParams set-hieraddr $address_]
} else {
set nodeaddr [expr [expr $address_ & [AddrParams set NodeMask_(1)]] << [AddrParams set NodeShift_(1)]]
}
$agent set agent_addr_ $nodeaddr
$agent set agent_port_ $port
}

SessionNode instproc join-group { rcvAgent group } {
set group [expr $group]
if [SessionSim set MixMode_] {
[Simulator instance] join-intermediate-session $rcvAgent $group
} else {
[Simulator instance] join-group $rcvAgent $group
}
}

SessionNode instproc leave-group { rcvAgent group } {
set group [expr $group]
[Simulator instance] leave-group $rcvAgent $group
}


Agent/LossMonitor instproc show-delay { seqno delay } {
$self instvar node_

puts "[$node_ id] $seqno $delay"
}



SessionSim instproc RPF-link { src from to } {
$self instvar routingTable_ link_
if [info exists routingTable_] {
set tmp $to
while {$tmp != $src} {
set reverse [$routingTable_ lookup $tmp $src]
if [info exists link_($reverse:$tmp)] {
return $link_($reverse:$tmp)
}
set tmp $reverse
}
}
return ""
}

SessionSim instproc detailed-link? { from to } {
$self instvar link_

return [info exist link_($from:$to)]
}

SessionSim instproc create-intermediate-session { src group nid } {
$self instvar session_

set session_($src:$group:$nid) [new SessionHelper]
$session_($src:$group:$nid) set-node $nid

if [SessionSim set rc_] {
$session_($src:$group:$nid) set rc_ 1
}

set trace [$self get-nam-traceall]
if {$trace != ""} {
set p [$self create-trace SessEnque $trace $nid $dst "nam"]
$p target $session_($src:$group:$nid)
return $p
} else {
return $session_($src:$group:$nid)
}

}

SessionSim instproc join-intermediate-session { rcvAgent group } {
$self instvar session_ routingTable_ delay_ bw_ link_ Node_ dlist_

foreach index [array names session_] {
set tri [split $index :]
set src [lindex $tri 0]
set grp [lindex $tri 1]
set owner [lindex $tri 2]
if {$grp == $group && $src == $owner} {
set session_area 1
set dst [[$rcvAgent set node_] id]
set delay 0
set accu_bw 0
set ttl 0
set tmp $dst
while {$tmp != $src} {
set next [$routingTable_ lookup $tmp $src]

if {$session_area} {
if [info exist link_($tmp:$next)] {

set session_area 0
if ![info exist session_($src:$grp:$tmp)] {
set inter_session [$self create-intermediate-session $src $grp $tmp]
} else {
set inter_session $session_($src:$grp:$tmp)
}
if {![info exist dlist_($src:$grp:$tmp)] || [lsearch $dlist_($src:$grp:$tmp) $rcvAgent] < 0 } {
$inter_session add-dst $accu_bw $delay $ttl $dst $rcvAgent
$self update-loss-dependency $src $dst $tmp $rcvAgent $group
lappend dlist_($src:$grp:$tmp) $rcvAgent
}
$Node_($tmp) join-group $inter_session $group

} else {

set delay [expr $delay + $delay_($tmp:$next)]
if {$accu_bw} {
set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
} else {
set accu_bw $bw_($tmp:$next)
}
incr ttl
}
} else {
if [info exist link_($tmp:$next)] {

} else {

set session_area 1
set accu_bw $bw_($tmp:$next)
set delay $delay_($tmp:$next)
set ttl 1
set dst $tmp
set rcvAgent [$Node_($tmp) entry]
}
}
set tmp $next
}

$self puts-nam-config "G -t [$self now] -i $group -a $dst"

set f [$self get-nam-traceall]

if {$session_area} {
if {$f != ""} { 
set p [$self create-trace SessDeque $f $src $dst "nam"]
$p target $rcvAgent
if {![info exist dlist_($index)] || [lsearch $dlist_($index) $rcvAgent] < 0 } {
$session_($index) add-dst $accu_bw $delay $ttl $dst $p
$self update-loss-dependency $src $dst $src $p $group
lappend dlist_($index) $rcvAgent
}
} else {
if {![info exist dlist_($index)] || [lsearch $dlist_($index) $rcvAgent] < 0 } {
$session_($index) add-dst $accu_bw $delay $ttl $dst $rcvAgent
$self update-loss-dependency $src $dst $src $rcvAgent $group
lappend dlist_($index) $rcvAgent
}
}
} else {
if {$f != ""} { 
set p [$self create-trace SessDeque $f $src $src "nam"]
$p target [$Node_($tmp) entry]
if {![info exist dlist_($index)] || [lsearch $dlist_($index) [$Node_($tmp) entry]] < 0 } {
$session_($index) add-dst 0 0 0 $src $p
$self update-loss-dependency $src $src $src $p $group
lappend dlist_($index) [$Node_($tmp) entry]
}
} else {
if {![info exist dlist_($index)] || [lsearch $dlist_($index) [$Node_($tmp) entry]] < 0 } {
$session_($index) add-dst 0 0 0 $src [$Node_($tmp) entry]
$self update-loss-dependency $src $src $src [$Node_($tmp) entry] $group
lappend dlist_($index) [$Node_($tmp) entry]
}
}
}
}
}
}



PagePool instproc gen-page { pageid thismod } {
set size [$self gen-size $pageid]
if {$thismod >= 0} {
set age [expr [$self gen-modtime $pageid $thismod] - $thismod]
} else {
set age -1
}
return "size $size age $age modtime $thismod"
}

Class PagePool/CompMath/noc -superclass PagePool/CompMath

PagePool/CompMath/noc instproc gen-page { pageid thismod } {
set res [eval $self next $pageid $thismod]
if {$pageid == 0} {
return "$res noc 1"
} else {
return $res
}
}


Http/Server instproc init args {
eval $self next $args
$self instvar node_ stat_
$node_ color "HotPink"
array set stat_ [list hit-num 0 mod-num 0 barrival 0]
}

Http/Server instproc set-page-generator { pagepool } {
$self instvar pgtr_
set pgtr_ $pagepool
}

Http/Server instproc gen-init-modtime { id } {
$self instvar pgtr_ ns_
if [info exists pgtr_] {
return [$pgtr_ gen-init-modtime $id]
} else {
return [$ns_ now]
}
}

Http/Server instproc stale-time { pageid modtime } {
$self instvar modseq_ modtimes_ ns_
for {set i $modseq_($pageid)} {$i >= 0} {incr i -1} {
if {$modtimes_($pageid:$i) <= $modtime} {
break
}
}
if {$i < 0} {
error "Non-existent modtime $modtime for page $pageid"
}
set ii [expr $i + 1]
set t1 [expr abs($modtimes_($pageid:$i) - $modtime)]
set t2 [expr abs($modtimes_($pageid:$ii) - $modtime)]
if {$t1 > $t2} {
incr ii
}
return [expr [$ns_ now] - $modtimes_($pageid:$ii)]
}

Http/Server instproc modify-page { pageid } {
$self instvar ns_ id_ stat_ pgtr_

incr stat_(mod-num)
set id [lindex [split $pageid :] end]

set modtime [$ns_ now]
if [info exists pgtr_] {
set pginfo [$pgtr_ gen-page $id $modtime]
} else {
set pginfo "size 2000 age 50 modtime $modtime"
}
array set data $pginfo
set age $data(age)
$self schedule-nextmod [expr [$ns_ now] + $age] $pageid
eval $self enter-page $pageid $pginfo

$ns_ trace-annotate "S $id_ INV $pageid"
$self evTrace S MOD p $pageid m [$ns_ now] n [expr [$ns_ now] + $age]

$self instvar modtimes_ modseq_
incr modseq_($pageid)
set modtimes_($pageid:$modseq_($pageid)) $modtime
}

Http/Server instproc schedule-nextmod { time pageid } {
$self instvar ns_
$ns_ at $time "$self modify-page $pageid"
}

Http/Server instproc gen-page { pageid } {
set pginfo [$self gen-pageinfo $pageid]
eval $self enter-page $pageid $pginfo
return $pginfo
}

Http/Server instproc gen-pageinfo { pageid } {
$self instvar ns_ pgtr_ 

if [$self exist-page $pageid] {
error "$self: shouldn't use gen-page for existing pages"
}

set id [lindex [split $pageid :] end]

set modtime [$self gen-init-modtime $id]
if [info exists pgtr_] {
set pginfo [$pgtr_ gen-page $id $modtime]
} else {
set pginfo "size 2000 age 50 modtime $modtime"
}
array set data $pginfo
set age $data(age)
if {$modtime >= 0} {
$self schedule-nextmod [expr [$ns_ now] + $age] $pageid
}
$self evTrace S MOD p $pageid m [$ns_ now] n [expr [$ns_ now] + $age]

$self instvar modtimes_ modseq_
set modseq_($pageid) 0
set modtimes_($pageid:0) $modtime

return [join $pginfo]
}

Http/Server instproc disconnect { client } {
$self instvar ns_ clist_ node_
set pos [lsearch $clist_ $client]
if {$pos >= 0} {
lreplace $clist_ $pos $pos
} else { 
error "Http/Server::disconnect: not connected to $server"
}
set tcp [[$self get-cnc $client] agent]
$self cmd disconnect $client
$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
$tcp close
}

Http/Server instproc alloc-connection { client fid } {
Http instvar TRANSPORT_
$self instvar ns_ clist_ node_ fid_

lappend clist_ $client
set snk [new Agent/TCP/$TRANSPORT_]
$snk set fid_ $fid
$ns_ attach-agent $node_ $snk
$snk listen
set wrapper [new Application/TcpApp $snk]
$self cmd connect $client $wrapper
return $wrapper
}

Http/Server instproc handle-request-GET { pageid args } {
$self instvar ns_

if [$self exist-page $pageid] {
set pageinfo [$self get-page $pageid]
} else {
set pageinfo [$self gen-page $pageid]
}

lappend res [$self get-size $pageid]
eval lappend res $pageinfo
}

Http/Server instproc handle-request-IMS { pageid args } {
array set data $args
set mt [$self get-modtime $pageid]
if {$mt <= $data(modtime)} {
set size [$self get-invsize]
set pageinfo  "size $size modtime $mt time [$self get-cachetime $pageid]"
$self evTrace S SND p $pageid m $mt z $size t IMS-NM
} else {
set size [$self get-size $pageid]
set pageinfo [$self get-page $pageid]
$self evTrace S SND p $pageid m $mt z $size t IMS-M
}

lappend res $size
eval lappend res $pageinfo
return $res
}

Http/Server instproc get-request { client type pageid args } {
$self instvar ns_ id_ stat_

incr stat_(hit-num)
array set data $args
incr stat_(barrival) $data(size)
unset data


set res [eval $self handle-request-$type $pageid $args]
set size [lindex $res 0]
set pageinfo [lrange $res 1 end]

$self send $client $size  "$client get-response-$type $self $pageid $pageinfo"
}

Http/Server instproc set-parent-cache { cache } {
}



Class Http/Server/epa -superclass Http/Server

Http/Server/epa instproc start-update { interval } {
$self instvar pm_itv_ ns_
set pm_itv_ $interval
$ns_ at [expr [$ns_ now] + $pm_itv_] "$self modify-page"
}

Http/Server/epa instproc schedule-nextmod { time pageid } {
$self instvar ns_ pm_itv_
$ns_ at [expr [$ns_ now]+$pm_itv_] "$self modify-page $pageid"
}

Http/Server/epa instproc modify-page args {
$self instvar pgtr_
set pageid $self:[$pgtr_ pick-pagemod]
eval $self next $pageid
}

Http/Server/epa instproc gen-pageinfo { pageid } {
$self instvar ns_ pgtr_ 

if [$self exist-page $pageid] {
error "$self: shouldn't use gen-page for existing pages"
}

set id [lindex [split $pageid :] end]

set modtime [$self gen-init-modtime $id]
if [info exists pgtr_] {
set pginfo [$pgtr_ gen-page $id $modtime]
} else {
set pginfo "size 2000 age 50 modtime $modtime"
}
array set data $pginfo
set age $data(age)

$self instvar modtimes_ modseq_
set modseq_($pageid) 0
set modtimes_($pageid:0) $modtime

return [join $pginfo]
}


Http/Server/Inval instproc modify-page { pageid } {
$self next $pageid
$self instvar ns_ id_
$self invalidate $pageid [$ns_ now]
}

Http/Server/Inval instproc handle-request-REF { pageid args } {
return [eval $self handle-request-GET $pageid $args]
}


Class Http/Server/Inval/Ucast -superclass Http/Server/Inval

Http/Server/Inval/Ucast instproc get-request { client type pageid args } {
eval $self next $client $type $pageid $args

$self instvar cacheList_
if [info exists cacheList_($pageid)] {
set pos [lsearch $cacheList_($pageid) $client]
} else {
set pos -1
}

if {$pos < 0 && [regexp "Cache" [$client info class]]} {
lappend cacheList_($pageid) $client
}
}

Http/Server/Inval/Ucast instproc invalidate { pageid modtime } {
$self instvar cacheList_ 

if ![info exists cacheList_($pageid)] {
return
}
foreach c $cacheList_($pageid) {
set size [$self get-invsize]

set agent [[$self get-cnc $c] agent]
set fid [$agent set fid_]
$agent_ set fid_ [Http set PINV_FID_]
$self send $c $size  "$c invalidate $pageid $modtime"
$agent_ set fid_ $fid
$self evTrace S INV p $pageid m $modtime z $size
}
}


Http/Server/Inval/Yuc instproc set-tlc { tlc } {
$self instvar tlc_
set tlc_ $tlc
}

Http/Server/Inval/Yuc instproc get-tlc { tlc } {
$self instvar tlc_
return $tlc_
}

Http/Server/Inval/Yuc instproc next-hb {} {
Http/Server/Inval/Yuc instvar hb_interval_ 
return [expr $hb_interval_ * [uniform 0.9 1.1]]
}

Http/Server/Inval/Yuc instproc set-parent-cache { cache } {
$self instvar pcache_
set pcache_ $cache

$self send $pcache_ [$self get-joinsize]  "$pcache_ server-join $self $self"

Http instvar TRANSPORT_
$self instvar ns_ node_

set tcp [new Agent/TCP/$TRANSPORT_]
$tcp set fid_ [Http set HB_FID_]
$ns_ attach-agent $node_ $tcp
set dst [$pcache_ setup-unicast-hb]
set snk [$dst agent]
$ns_ connect $tcp $snk
$tcp set window_ 100

set wrapper [new Application/TcpApp/HttpInval $tcp]
$wrapper connect $dst
$wrapper set-app $self

$self add-inval-sender $wrapper

$self instvar ns_
$ns_ at [expr [$ns_ now] + [$self next-hb]] "$self heartbeat"
}

Http/Server/Inval/Yuc instproc heartbeat {} {
$self instvar pcache_ ns_

$self cmd send-hb
$ns_ at [expr [$ns_ now] + [$self next-hb]]  "$self heartbeat"
}

Http/Server/Inval/Yuc instproc get-request { cl type pageid args } {
eval $self next $cl $type $pageid $args
if {($type == "GET") || ($type == "REF")} {
$self count-request $pageid
}
}

Http/Server/Inval/Yuc instproc invalidate { pageid modtime } {
$self instvar pcache_ id_ enable_upd_

if ![info exists pcache_] {
error "Server $id_ doesn't have a parent cache!"
}

$self count-inval $pageid

if [$self is-pushable $pageid] {
$self push-page $pageid $modtime
return
}


$self cmd add-inv $pageid $modtime
$self evTrace S INV p $pageid m $modtime 
}

Http/Server/Inval/Yuc instproc push-page { pageid modtime } {
$self instvar pcache_ id_

if ![info exists pcache_] {
error "Server $id_ doesn't have a parent cache!"
}
set size [$self get-size $pageid]
set pageinfo [$self get-page $pageid]

set agent [[$self get-cnc $pcache_] agent]
set fid [$agent set fid_]
$agent set fid_ [Http set PINV_FID_]
$self send $pcache_ $size  "$pcache_ push-update $pageid $pageinfo"
$agent set fid_ $fid
$self evTrace S UPD p $pageid m $modtime z $size
}

Http/Server/Inval/Yuc instproc get-req-notify { pageid } {
$self count-request $pageid
}

Http/Server/Inval/Yuc instproc handle-request-TLC { pageid args } {
$self instvar tlc_
array set data $args
lappend res $data(size)	;# Same size of queries
lappend res $tlc_
return $res
}


Class Http/Server/Compound -superclass Http/Server

Class Http/Server/Inval/MYuc -superclass  { Http/Server/Inval/Yuc Http/Server/Compound}


Http/Cache instproc init args {
eval $self next $args

$self instvar node_ stat_
$node_ color "yellow"	;# no page
array set stat_ [list hit-num 0 barrival 0 ims-num 0]
}

Http instproc set-cachesize { size } {
$self instvar pool_
$pool_ set max_size_ $size
}

Http instproc get-cachesize {} {
$self instvar pool_
return [$pool_ set max_size_]
}

Http/Cache instproc connect { server } {
$self next $server
}

Http/Cache instproc disconnect { http } {
$self instvar slist_ clist_

if [$http info class Http/Cache] {
error "Cannot disconnect a cache from another cache"
}

if {[lsearch $slist_ $http] >= 0} {
$self disconnect-server $http
} else {
$self disconnect-client $http
}
}

Http/Cache instproc disconnect-server { server } {
$self instvar ns_ slist_ node_
set pos [lsearch $slist_ $server]
if {$pos >= 0} {
lreplace $slist_ $pos $pos
} else { 
error "Http::disconnect: not connected to $server"
}
set tcp [[$self get-cnc $server] agent]
$self cmd disconnect $server
$server disconnect $self
$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
$tcp close

$self instvar pending_
foreach p [array names pending_] {
if {$server == [lindex [split $p :] 0]} {
unset pending_($p)
}
}
}

Http/Cache instproc disconnect-client { client } {
$self instvar ns_ clist_ node_
set pos [lsearch $clist_ $client]
if {$pos >= 0} {
lreplace $clist_ $pos $pos
} else { 
error "Http/Cache::disconnect: not connected to $server"
}
set tcp [[$self get-cnc $client] agent]
$self cmd disconnect $client
$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
$tcp close

$self instvar creq_
foreach p [array names creq_] {
set res {}
for {set i 0} {$i < [llength $creq_($p)]} {incr i} {
set clt [lindex $creq_($p) $i]
if {$client != [lindex [split clt /] 0]} {
lappend res $clt
}
}
if {[llength $res] == 0} {
unset creq_($p)
} else {
set creq_($p) $res
}
}
}

Http/Cache instproc set-parent { server } {
$self instvar parent_
set parent_ $server
}


Http/Cache instproc alloc-connection { client fid } {
Http instvar TRANSPORT_
$self instvar ns_ clist_ node_ id_ fid_

lappend clist_ $client
set snk [new Agent/TCP/$TRANSPORT_]
$snk set fid_ $fid
$ns_ attach-agent $node_ $snk
$snk listen
set wrapper [new Application/TcpApp $snk]
$self cmd connect $client $wrapper
return $wrapper
}

Http/Cache instproc send-request { server type pageid size args } {
$self instvar ns_ pending_	;# pending requests, includes those 
;# from itself

if ![$self is-connected $server] {
return
}
set pending_($pageid) [$ns_ now]
$self send $server $size  "$server get-request $self $type $pageid size $size [join $args]"
}

Http/Cache instproc get-request { cl type pageid args } {
$self instvar slist_ clist_ ns_ id_ pending_ stat_

incr stat_(hit-num)
array set data $args
if ![info exists data(size)] {
error "Http/Cache $id_: client [$cl id] must include request size in its request"
}

if [$self exist-page $pageid] {
$self cache-hit $cl $type $pageid 
} else {
$self cache-miss $cl $type $pageid
}
}

Http/Cache instproc cache-miss { cl type pageid } {
$self instvar parent_ pending_  creq_ ;# pending client requests

lappend creq_($pageid) $cl/$type

if [info exists pending_($pageid)] {
return
}

set server [lindex [split $pageid :] 0]
if [info exists parent_] {
set server $parent_
}

set size [$self get-reqsize]
$self evTrace E MISS p $pageid c [$cl id] s [$server id] z $size
$self send-request $server $type $pageid $size
}

Http/Cache instproc is-consistent { cl type pageid } {
return 1
}

Http/Cache instproc refetch-pending { cl type pageid } {
return 0
}

Http/Cache instproc refetch args {
}

Http/Cache instproc cache-hit { cl type pageid } {
if ![$self is-consistent $cl $type $pageid] {
if ![$self refetch-pending $cl $type $pageid] {
$self refetch $cl $type $pageid
}
return
}
set server [lindex [split $pageid :] 0]
$self evTrace E HIT p $pageid c [$cl id] s [$server id]

eval $self answer-request-$type $cl $pageid [$self get-page $pageid]
}

Http/Cache instproc get-response-GET { server pageid args } {
array set data $args

if ![info exists data(noc)] {
if ![$self exist-page $pageid] {
eval $self enter-page $pageid $args
$self evTrace E ENT p $pageid m $data(modtime)  z $data(size) s [$server id]
} else {
$self instvar id_ ns_
puts stderr "At [$ns_ now], cache $id_ has requested a page which it already has."
}
}
eval $self answer-pending-requests $pageid $args

$self instvar stat_
incr stat_(barrival) $data(size)

$self instvar node_
$node_ color "blue"	;# valid page
}

Http/Cache instproc answer-pending-requests { pageid args } {
$self instvar creq_ pending_

array set data $args
if [info exists creq_($pageid)] {
foreach clt $creq_($pageid) {
set tmp [split $clt /]
set cl [lindex $tmp 0]
set type [lindex $tmp 1]
eval $self answer-request-$type $cl $pageid $args
}
unset creq_($pageid)
unset pending_($pageid)
} else {
unset pending_($pageid)
}
}

Http/Cache instproc answer-request-GET { cl pageid args } {
array set data $args
$self send $cl $data(size)  "$cl get-response-GET $self $pageid $args"
$self evTrace E SND c [$cl id] p $pageid z $data(size)
}


Class Http/Cache/TTL -superclass Http/Cache

Http/Cache/TTL set updateThreshold_ 0.1

Http/Cache/TTL instproc init args {
eval $self next $args

$self instvar thresh_
set thresh_ [Http/Cache/TTL set updateThreshold_]
}

Http/Cache/TTL instproc set-thresh { th } {
$self instvar thresh_
set thresh_ $th
}

Http/Cache/TTL instproc answer-request-IMS { client pageid args } {
if ![$self exist-page $pageid] {
error "At [$ns_ now], cache [$self id] gets an IMS of a non-cacheable page."
}

set mt [$self get-modtime $pageid]
if ![$client exist-page $pageid] {
error "client [$client id] IMS a page which it doesn't have"
}
if {$mt < [$client get-modtime $pageid]} {
error "client [$client id] IMS a newer page"
}

if {$mt > [$client get-modtime $pageid]} {
set pginfo [$self get-page $pageid]
set size [$self get-size $pageid]
} else {
set size [$self get-invsize]
set pginfo "size $size modtime $mt time [$self get-cachetime $pageid]"
}
$self evTrace E SND c [$client id] t IMS z $size
$self send $client $size  "$client get-response-IMS $self $pageid $pginfo"
}

Http/Cache/TTL instproc get-response-IMS { server pageid args } {
$self instvar ns_

array set data $args
if {$data(modtime) > [$self get-modtime $pageid]} {
eval $self enter-page $pageid $args
$self evTrace E ENT p $pageid m [$self get-modtime $pageid]  z [$self get-size $pageid] s [$server id]
$self set-cachetime $pageid $data(time)
} else {
$self set-cachetime $pageid [$ns_ now]
}
eval $self answer-pending-requests $pageid [$self get-page $pageid]

$self instvar stat_
incr stat_(barrival) $data(size)
}


Http/Cache/TTL instproc is-expired { pageid } {
$self instvar thresh_ ns_
set cktime [expr [$ns_ now] - [$self get-cachetime $pageid]]
set age [expr ([$ns_ now] - [$self get-modtime $pageid]) * $thresh_]
if {$cktime <= $age} {
return 0
}
return 1
}

Http/Cache/TTL instproc is-consistent { cl type pageid } { 
return ![$self is-expired $pageid]
}

Http/Cache/TTL instproc refetch-pending { cl type pageid } {
$self instvar creq_ 
if [info exists creq_($pageid)] {
if [regexp $cl:* $creq_($pageid)] {
return 1
}
lappend creq_($pageid) $cl/$type
return 1
}
lappend creq_($pageid) $cl/$type
return 0
}

Http/Cache/TTL instproc refetch { cl type pageid } {
$self instvar parent_

set server [lindex [split $pageid :] 0]
set size [$self get-imssize]
if [info exists parent_] {
set server $parent_
}

$self instvar stat_
incr stat_(ims-num)

$self evTrace E IMS p $pageid c [$cl id] s [$server id] z $size  t [$self get-cachetime $pageid] m [$self get-modtime $pageid]
$self send-request $server IMS $pageid $size  modtime [$self get-modtime $pageid]
return 0
}


Class Http/Cache/TTL/Plain -superclass Http/Cache/TTL

Http/Cache/TTL/Plain set updateThreshold_ 100

Http/Cache/TTL/Plain instproc init { args } {
eval $self next $args
$self instvar thresh_
set thresh_ [[$self info class] set updateThreshold_]
}

Http/Cache/TTL/Plain instproc is-expired { pageid } {
$self instvar ns_ thresh_
set cktime [expr [$ns_ now] - [$self get-cachetime $pageid]]
if {$cktime < $thresh_} {
return 0
}
return 1
}


Class Http/Cache/TTL/Omniscient -superclass Http/Cache/TTL

Http/Cache/TTL/Omniscient instproc is-expired { pageid } {
$self instvar ns_ 

set nmt [expr [$self get-modtime $pageid] + [$self get-age $pageid]]
if {[$ns_ now] >= $nmt} {
return 1
} 
return 0
}



Http/Cache/Inval instproc mark-invalid {} {
$self instvar node_
$node_ color "red"
}

Http/Cache/Inval instproc mark-valid {} {
$self instvar node_ 
$node_ color "blue"
}

Http/Cache/Inval instproc mark-leave {} {
$self instvar node_ 
$node_ add-mark down "cyan"
}

Http/Cache/Inval instproc mark-rejoin {} {
$self instvar node_ 
$node_ delete-mark down
}

Http/Cache/Inval instproc answer-request-REF { cl pageid args } {
if ![$self exist-page $pageid] {
error "At [$ns_ now], cache [$self id] gets a REF of a non-cacheable page."
}

set pginfo [$self get-page $pageid]
set size [$self get-size $pageid]
$self evTrace E SND c [$cl id] t REF p $pageid z $size
$self send $cl $size  "$cl get-response-REF $self $pageid $pginfo"
}

Http/Cache/Inval instproc get-response-GET { server pageid args } {
set sid [[lindex [split $pageid :] 0] id]
set cid [$server id]
$self check-sstate $sid $cid
eval $self next $server $pageid $args
}

Http/Cache/Inval instproc get-response-REF { server pageid args } {
$self instvar creq_ id_ 

set sid [[lindex [split $pageid :] 0] id]
set cid [$server id]
$self check-sstate $sid $cid

array set data $args
if {[$self get-modtime $pageid] > $data(modtime)} {
puts stderr "At [$ns_ now], cache $self ($id_) refetched an old page $pageid ($data(modtime), new time [$self get-modtime $pageid]) from [$server id]"
} else {
eval $self enter-page $pageid $args
$self evTrace E UPD p $pageid m [$self get-modtime $pageid]  z [$self get-size $pageid] s [$server id]
}
eval $self answer-pending-requests $pageid [$self get-page $pageid]

$self instvar node_ marks_ ns_
set mk [lindex $marks_($pageid) 0]
$node_ delete-mark $mk
set marks_($pageid) [lreplace $marks_($pageid) 0 0]
$node_ color "blue"
}

Http/Cache/Inval instproc is-consistent { cl type pageid } {
return [$self is-valid $pageid]
}

Http/Cache/Inval instproc refetch-pending { cl type pageid } {
$self instvar creq_ 
if [info exists creq_($pageid)] {
if [regexp $cl:* $creq_($pageid)] {
return 1
}
lappend creq_($pageid) $cl/$type
return 1
}
lappend creq_($pageid) $cl/$type
return 0
}

Http/Cache/Inval instproc refetch { cl type pageid } {
$self instvar parent_

set size [$self get-refsize]
set server [lindex [split $pageid :] 0]

if [info exists parent_] {
set par $parent_
} else {
set par $server
}

$self evTrace E REF p $pageid s [$server id] z $size
$self send-request $par REF $pageid $size

$self instvar node_ marks_ ns_
lappend marks_($pageid) $pageid:[$ns_ now]
$node_ add-mark $pageid:[$ns_ now] "brown"
}



Http/Cache/Inval/Mcast instproc init args {
eval $self next $args
$self add-to-map
}

Http/Cache/Inval/Mcast instproc get-response-GET { server pageid args } {
eval $self next $server $pageid $args

set sid [[lindex [split $pageid :] 0] id]
set cid [$server id]
$self register-server $cid $sid
}

Http/Cache/Inval/Mcast instproc set-parent { parent } {
$self next $parent
$self cmd set-parent $parent
}

Http/Cache/Inval/Mcast instproc join-inval-group { group } {
$self instvar invalListener_ invListenGroup_ ns_ node_

if [info exists invalListener_] {
return
}
set invalListener_ [new Agent/HttpInval]
set invListenGroup_ $group
$invalListener_ set dst_addr_ $group
$invalListener_ set dst_port_ 0

$self add-inval-listener $invalListener_
$ns_ attach-agent $node_ $invalListener_

$node_ join-group $invalListener_ $group
}

Http/Cache/Inval/Mcast instproc init-inval-group { group } {
$self instvar invalSender_ invSndGroup_ ns_ node_
if [info exists invalSender_] {
return
}
set invalSender_ [new Agent/HttpInval]
set invSndGroup_ $group
$invalSender_ set dst_addr_ $group
$invalSender_ set dst_port_ 0

$self add-inval-sender $invalSender_
$ns_ attach-agent $node_ $invalSender_
$node_ join-group $invalSender_ $group

$self start-hbtimer
}

Http/Cache/Inval/Mcast instproc parent-cache { server } {
$self instvar parent_

set par [$self cmd parent-cache [$server id]]
if {$par == ""} {
if [info exists parent_] {
set par $parent_
} else {
set par $server
}
}
return $par
}

Http/Cache/Inval/Mcast instproc refetch { cl type pageid } {
set size [$self get-refsize]
set server [lindex [split $pageid :] 0]
set par [$self parent-cache $server]

$self evTrace E REF p $pageid s [$server id] z $size
$self send-request $par REF $pageid $size

$self instvar node_ marks_ ns_
lappend marks_($pageid) $pageid:[$ns_ now]
$node_ add-mark $pageid:[$ns_ now] "brown"
}

Http/Cache/Inval/Mcast instproc cache-miss { cl type pageid } {
$self instvar parent_ pending_ creq_ ;# pending client requests

lappend creq_($pageid) $cl/$type

if [info exists pending_($pageid)] {
return
}

set size [$self get-reqsize]
set server [lindex [split $pageid :] 0]
$self evTrace E MISS p $pageid c [$cl id] s [$server id] z $size

set par [$self cmd parent-cache [$server id]]
if {$par == ""} {
if [info exists parent_] {
set par $parent_
} else {
$self instvar ns_ id_
$self send-request $server TLC $pageid $size
return
}
}
$self send-request $par $type $pageid $size
}

Http/Cache/Inval/Mcast instproc invalidate { pageid modtime } {
if [$self recv-inv $pageid $modtime] {
$self instvar parent_ 
if ![info exists parent_] {
return
}
set size [$self get-invsize]
$self evTrace E SND t INV c [$parent_ id] p $pageid z $size

set agent [[$self get-cnc $parent_] agent]
set fid [$agent set fid_]
$agent set fid_ [Http set PINV_FID_]
$self send $parent_ $size  "$parent_ invalidate $pageid $modtime"
$agent set fid_ $fid
}
}

Http/Cache/Inval/Mcast instproc get-request { cl type pageid args } {
eval $self next $cl $type $pageid $args
if {(($type == "GET") || ($type == "REF")) &&  [$self exist-page $pageid]} {
$self count-request $pageid
if [$self is-unread $pageid] {
$self send-req-notify $pageid
$self set-read $pageid
}
}
}

Http/Cache/Inval/Mcast instproc get-req-notify { pageid } {
$self count-request $pageid
if [$self is-unread $pageid] {
$self set-read $pageid
$self send-req-notify $pageid
}
}

Http/Cache/Inval/Mcast instproc send-req-notify { pageid } {
set server [lindex [split $pageid :] 0]
set par [$self parent-cache $server]
$self send $par [$self get-ntfsize] "$par get-req-notify $pageid"
}

Http/Cache/Inval/Mcast instproc push-update { pageid args } {
if [eval $self recv-push $pageid $args] {

$self instvar parent_ 
if [info exists parent_] {
set pginfo [$self get-page $pageid]
set size [$self get-size $pageid]
$self evTrace E UPD c [$parent_ id] p $pageid z $size
$self send $parent_ $size  "$parent_ push-update $pageid $pginfo"
}
$self push-children $pageid
}
}

Http/Cache/Inval/Mcast instproc init-update-group { group } {
$self instvar ns_ node_ updSender_ updSendGroup_

set snd [new Agent/HttpInval]
$snd set dst_addr_ $group
$snd set dst_port_ 0
$self add-upd-sender $snd
$ns_ attach-agent $node_ $snd
$node_ join-group $snd $group
}

Http/Cache/Inval/Mcast instproc join-update-group { group }  {
$self instvar updListener_ updListenGroup_ ns_ node_

set updListenGroup_ $group
if ![info exists updListener_] {
set updListener_ [new Agent/HttpInval]
$self add-upd-listener $updListener_
$updListener_ set dst_addr_ $updListenGroup_
$updListener_ set dst_port_ 0
$ns_ attach-agent $node_ $updListener_
}
$node_ join-group $updListener_ $updListenGroup_
}

Http/Cache/Inval/Mcast instproc leave-update-group {} {
$self instvar updListener_ updListenGroup_ ns_ node_
if ![info exists updListener_] {
return
}
$node_ leave-group $updListener_ $updListenGroup_
$node_ delete-mark "Updating"
}

Http/Cache/Inval/Mcast instproc setup-unicast-hb {} {
Http instvar TRANSPORT_
$self instvar node_ ns_

set snk [new Agent/TCP/$TRANSPORT_]
$snk set fid_ [Http set HB_FID_]
$ns_ attach-agent $node_ $snk
$snk listen
set wrapper [new Application/TcpApp/HttpInval $snk]
$wrapper set-app $self
return $wrapper
}

Http/Cache/Inval/Mcast instproc server-join { server cache } {
$self cmd join [$server id] $cache


$self instvar parent_
if ![info exists parent_] {
return
}

$self send $parent_ [$self get-joinsize]  "$parent_ server-join $server $self"

Http instvar TRANSPORT_
$self instvar ns_ node_

set tcp [new Agent/TCP/$TRANSPORT_]
$tcp set fid_ [Http set HB_FID_]
$ns_ attach-agent $node_ $tcp
set dst [$parent_ setup-unicast-hb]
set snk [$dst agent]
$ns_ connect $tcp $snk
$tcp set window_ 100

set wrapper [new Application/TcpApp/HttpInval $tcp]
$wrapper connect $dst
$wrapper set-app $self

$self set-pinv-agent $wrapper

$self start-hbtimer
}

Http/Cache/Inval/Mcast instproc request-mpush { page } {
$self instvar mpush_refresh_ ns_ hb_interval_
if [info exists mpush_refresh_($page)] {
return
}
$self set-mandatory-push $page

set server [lindex [split $page :] 0]
set cache [$self parent-cache $server]

set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_]  "$self send-refresh-mpush $cache $page"]
$self send $cache [$self get-mpusize] "$cache request-mpush $page"
}

Http/Cache/Inval/Mcast instproc refresh-mpush { page } {
$self cmd set-mandatory-push $page
}

Http/Cache/Inval/Mcast instproc send-refresh-mpush { cache page } {
$self instvar mpush_refresh_ ns_ hb_interval_
$self send $cache [$self get-mpusize] "$cache refresh-mpush $page"
set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_]  "$self send-refresh-mpush $cache $page"]
}

Http/Cache/Inval/Mcast instproc cancel-mpush-refresh { page } {
$self instvar mpush_refresh_ ns_ 
if [info exists mpush_refresh_($page)] {
$ns_ cancel $mpush_refresh_($page)
} else {
error "Cache [$self id]: No mpush to stop!"
}
}

Http/Cache/Inval/Mcast instproc stop-mpush { page } {
$self cancel-mpush-refresh $page

$self cmd stop-mpush $page

set server [lindex [split $page :] 0]
set cache [$self parent-cache $server]
$self send $cache [$self get-mpusize] "$cache stop-mpush $page"
}

Http/Cache/Inval/Mcast instproc join-tlc-group { group } {
$self instvar tlcAgent_ tlcGroup_ ns_ node_

if [info exists tlcAgent_] {
return 
}
set tlcAgent_ [new Agent/HttpInval]
set tlcGroup_ $group
$tlcAgent_ set dst_addr_ $group
$tlcAgent_ set dst_port_ 0

$self add-inval-sender $tlcAgent_
$self add-inval-listener $tlcAgent_
$ns_ attach-agent $node_ $tlcAgent_
$node_ join-group $tlcAgent_ $group
}

Http/Cache/Inval/Mcast instproc get-response-TLC { server pageid tlc } {
$self register-server [$tlc id] [$server id]
$self instvar ns_ id_
$self send-request $tlc GET $pageid [$self get-reqsize]
}



Http/Cache/Inval/Mcast/Perc instproc check-sstate {sid cid} {
$self instvar direct_request_
if !$direct_request_ {
$self cmd check-sstate $sid $cid
}
}

Http/Cache/Inval/Mcast/Perc instproc register-server {cid sid} {
$self instvar parent_ direct_request_
if {$direct_request_ && [info exists parent_]} {
$self cmd register-server [$parent_ id] $sid
} 
}

Http/Cache/Inval/Mcast/Perc instproc cache-miss { cl type pageid } {
$self instvar direct_request_

if !$direct_request_ {
$self next $cl $type $pageid
return
}


$self instvar parent_ pending_ creq_ ;# pending client requests
$self instvar dreq_ ;# pending direct requests

lappend creq_($pageid) $cl/$type

if [info exists pending_($pageid)] {
return
}

$self instvar dreq_
set dreq_($pageid) 1

set server [lindex [split $pageid :] 0]
set size [$self get-reqsize]
$self evTrace E MISS p $pageid c [$cl id] s [$server id] z $size
$self send-request $server $type $pageid $size
}

Http/Cache/Inval/Mcast/Perc instproc refetch { cl type pageid } {
$self instvar direct_request_

if !$direct_request_ {
$self next $cl $type $pageid
return
}

$self instvar dreq_
set dreq_($pageid) 1

set size [$self get-refsize]
set server [lindex [split $pageid :] 0]
$self evTrace E REF p $pageid s [$server id] z $size 
$self send-request $server REF $pageid $size

$self instvar node_ marks_ ns_
lappend marks_($pageid) $pageid:[$ns_ now]
$node_ add-mark $pageid:[$ns_ now] "brown"
}

Http/Cache/Inval/Mcast/Perc instproc get-response-GET { server pageid args } {
eval $self next $server $pageid $args

$self instvar dreq_ 
if [info exists dreq_($pageid)] {
eval $self send-proforma $pageid $args
unset dreq_($pageid)
}
}

Http/Cache/Inval/Mcast/Perc instproc get-response-REF { server pageid args } {
eval $self next $server $pageid $args
$self instvar dreq_
if [info exists dreq_($pageid)] {
eval $self send-proforma $pageid $args
unset dreq_($pageid)
}
}

Http/Cache/Inval/Mcast/Perc instproc send-proforma { pageid args } {
set server [lindex [split $pageid :] 0]
set par [$self parent-cache $server]
if {$par == $server} {
return
} elseif {$par == ""} {
set par [$server get-tlc]
}
$self send $par [$self get-pfsize]  "$par recv-proforma $self $pageid [join $args]"
$self evTrace E SPF p $pageid c [$par id]
}

Http/Cache/Inval/Mcast/Perc instproc get-response-IMS { server pageid args } {
$self instvar ns_ 

array set data $args
if {$data(modtime) <= [$self get-modtime $pageid]} {
return
}
$self invalidate $pageid 
eval $self enter-page $pageid $args
$self mark-valid
}

Http/Cache/Inval/Mcast/Perc instproc mark-valid-hdr {} {
$self instvar node_
$node_ color "orange"
}

Http/Cache/Inval/Mcast/Perc instproc recv-proforma { cache pageid args } {
$self instvar stat_
incr stat_(hit-num)

$self evTrace E RPF p $pageid c [$cache id]

array set data $args
if ![$self exist-page $pageid] {
eval $self enter-metadata $pageid $args
$self mark-valid-hdr

set server [lindex [split $pageid :] 0]
set par [$self parent-cache $server]
if {$par == $server} {
$self send-request $par IMS $pageid  [$self get-imssize] modtime $data(modtime)
} else {
eval $self send-proforma $pageid $args
}
} elseif [$self is-valid $pageid] {
set mt [$self get-modtime $pageid]
if {$data(modtime) < $mt} {
$self recv-inv $pageid $data(modtime)
return
} elseif {$data(modtime) > $mt} {
$self recv-inv $pageid $data(modtime)
eval $self enter-metadata $pageid $args
$self mark-valid-hdr
eval $self send-proforma $pageid $args
}
$self count-request $pageid
if [$self is-unread $pageid] {
$self set-read $pageid
}
} else {
array set data $args
set mt [$self get-modtime $pageid]
if {$data(modtime) < $mt} {
return
} 
eval $self enter-metadata $pageid $args
$self mark-valid-hdr

eval $self send-proforma $pageid $args
}
}


Http set id_ 0	;# required by TclCL
Http set TRANSPORT_ FullTcp
Http set HB_FID_ 40
Http set PINV_FID_ 41

Http set INVSize_ 43	;# unicast invalidation
Http set REQSize_ 43	;# Request
Http set REFSize_ 50	;# Refetch request
Http set IMSSize_ 50	;# If-Modified-Since
Http set JOINSize_ 10	;# Server join/leave
Http set HBSize_ 1	;# Used by Http/Server/Inval only
Http set PFSize_ 1	;# Pro forma
Http set NTFSize_ 10	;# Request Notification
Http set MPUSize_ 10	;# Mandatory push request

Http/Server set id_ 0
Http/Server/Inval set id_ 0
Http/Server/Inval/Yuc set hb_interval_ 60
Http/Server/Inval/Yuc set enable_upd_ 0
Http/Server/Inval/Yuc set Ca_ 1
Http/Server/Inval/Yuc set Cb_ 4
Http/Server/Inval/Yuc set push_thresh_ 4
Http/Server/Inval/Yuc set push_low_bound_ 0
Http/Server/Inval/Yuc set push_high_bound_ 8

Http/Cache set id_ 0
Http/Cache/Inval set id_ 0
Http/Cache/Inval/Mcast set hb_interval_ 60
Http/Cache/Inval/Mcast set upd_interval_ 5
Http/Cache/Inval/Mcast set enable_upd_ 0
Http/Cache/Inval/Mcast set Ca_ 1
Http/Cache/Inval/Mcast set Cb_ 4
Http/Cache/Inval/Mcast set push_thresh_ 4
Http/Cache/Inval/Mcast set push_low_bound_ 0
Http/Cache/Inval/Mcast set push_high_bound_ 8
Http/Cache/Inval/Mcast/Perc set direct_request_ 0

PagePool/CompMath set num_pages_ 1
PagePool/CompMath set main_size_ 1024
PagePool/CompMath set comp_size_ 10240

Http set MEDIA_TRANSPORT_ RAP
Http set MEDIA_APP_ MediaApp
Application/MediaApp set segmentSize_ 1024
Application/MediaApp set MAX_LAYER_ 10
Application/MediaApp/QA set LAYERBW_ 2500 ;# Byte per-second
Application/MediaApp/QA set MAXACTIVELAYERS_ 10
Application/MediaApp/QA set SRTTWEIGHT_ 0.95
Application/MediaApp/QA set SMOOTHFACTOR_ 4
Application/MediaApp/QA set MAXBKOFF_ 100
Application/MediaApp/QA set debug_output_ 0
Application/MediaApp/QA set pref_srtt_ 0.6
PagePool/Client/Media set max_size_ 104857600 


Http instproc init { ns node } {
$self next
$self instvar ns_ node_ id_ pool_
set ns_ $ns
set node_ $node
$self set id_ [$node_ id]
set pool_ [$self create-pagepool]
}

Http instproc create-pagepool {} {
set pool [new PagePool/Client]
$self set-pagepool $pool
return $pool
}

Http instproc addr {} {
$self instvar node_ 
return [$node_ node-addr]
}

Http set fid_ -1
Http instproc getfid {} {
$self instvar fid_
set fid_ [Http set fid_]
Http set fid_ [incr fid_]
}

Http instproc get-mpusize {} {
return [Http set MPUSize_]
}

Http instproc get-ntfsize {} {
return [Http set NTFSize_]
}

Http instproc get-pfsize {} {
return [Http set PFSize_]
}

Http instproc get-hbsize {} {
return [Http set HBSize_]
}

Http instproc get-imssize {} {
return [Http set IMSSize_]
}

Http instproc get-invsize {} {
return [Http set INVSize_]
}

Http instproc get-reqsize {} {
return [Http set REQSize_]
}

Http instproc get-refsize {} {
return [Http set REFSize_]
}

Http instproc get-joinsize {} {
return [Http set JOINSize_]
}

Http instproc connect { server } {
Http instvar TRANSPORT_
$self instvar ns_ slist_ node_ fid_ id_

lappend slist_ $server
set tcp [new Agent/TCP/$TRANSPORT_]
$tcp set fid_ [$self getfid]
$ns_ attach-agent $node_ $tcp

set ret [$server alloc-connection $self $fid_]
set snk [$ret agent]
$ns_ connect $tcp $snk
$tcp set window_ 100

set wrapper [new Application/TcpApp $tcp]
$self cmd connect $server $wrapper
$wrapper connect $ret
}

Http instproc stat { name } {
$self instvar stat_
return $stat_($name)
}


Http/Client set hb_interval_ 60

Http/Client instproc init args {
eval $self next $args
$self instvar node_ stat_
$node_ color "SteelBlue"
array set stat_ [list req-num 0 stale-num 0 stale-time 0 rep-time 0  rt-min 987654321 rt-max 0 st-min 987654321 st-max 0]
}

Http/Client instproc disconnect { server } {
$self instvar ns_ slist_ 
set pos [lsearch $slist_ $server]
if {$pos >= 0} {
lreplace $slist_ $pos $pos
} else { 
error "Http::disconnect: not connected to $server"
}

$self instvar ns_ node_ cache_
$self stop-session $server

set tcp [[$self get-cnc $server] agent]
$self cmd disconnect $server
$server disconnect $self
$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
$tcp close
}

Http/Client instproc send-request { server type pageid args } {
$self instvar ns_ pending_ 	;# unansewered requests

if ![$self cmd is-connected $server] {
return
}

if ![info exists pending_($pageid)] { 
lappend pending_($pageid) [$ns_ now]
} else {
return
}

set size [$self get-reqsize]
$self send $server $size  "$server get-request $self $type $pageid size $size [join $args]"
$self evTrace C GET p $pageid s [$server id] z $size
$self instvar stat_ simStartTime_
if [info exists simStartTime_] {
incr stat_(req-num)
}

$self mark-request $pageid
}

Http/Client instproc mark-request { pageid } {
$self instvar node_ marks_ ns_
$node_ add-mark $pageid:[$ns_ now] "purple"
lappend marks_($pageid) $pageid:[$ns_ now]
}

Http/Client instproc get-response-GET { server pageid args } {
$self instvar pending_ id_ ns_ stat_ simStartTime_

if ![info exists pending_($pageid)] {
error "Client $id_: Unrequested response page $pageid from server [$server id]"
}

array set data $args

set origsvr [lindex [split $pageid :] 0]
set modtime [$origsvr get-modtime $pageid]
set reqtime [lindex $pending_($pageid) 0]
set reqrtt [expr [$ns_ now] - $reqtime]

if {$modtime > $data(modtime)} {
set tmp [$origsvr stale-time $pageid $data(modtime)]
if {$tmp > $reqrtt/2} {
$self evTrace C STA p $pageid s [$origsvr id] l $tmp
if [info exists simStartTime_] {
incr stat_(stale-num)
set stat_(stale-time) [expr  $stat_(stale-time) + $tmp]
if {$stat_(st-min) > $tmp} {
set stat_(st-min) $tmp
}
if {$stat_(st-max) < $tmp} {
set stat_(st-max) $tmp
}
}
}
}

$self evTrace C RCV p $pageid s [$server id] l $reqrtt z $data(size)
if [info exists simStartTime_] {
set stat_(rep-time) [expr $stat_(rep-time) + $reqrtt]
if {$stat_(rt-min) > $reqrtt} {
set stat_(rt-min) $reqrtt
}
if {$stat_(rt-max) < $reqrtt} {
set stat_(rt-max) $reqrtt
}
}

set pending_($pageid) [lreplace $pending_($pageid) 0 0]
if {[llength $pending_($pageid)] == 0} {
unset pending_($pageid)
}
$self mark-response $pageid
}

Http/Client instproc mark-response { pageid } {
$self instvar node_ marks_ ns_
set mk [lindex $marks_($pageid) 0]
$node_ delete-mark $mk
set marks_($pageid) [lreplace $marks_($pageid) 0 0]
}

Http/Client instproc get-response-REF { server pageid args } {
eval $self get-response-GET $server $pageid $args
}

Http/Client instproc get-response-IMS { server pageid args } {
eval $self get-response-GET $server $pageid $args
}

Http/Client instproc set-page-generator { pagepool } {
$self instvar pgtr_ 	;# Page generator
set pgtr_ $pagepool
}

Http/Client instproc set-interval-generator { ranvar } {
$self instvar rvInterPage_
set rvInterPage_ $ranvar
}

Http/Client instproc gen-request {} {
$self instvar pgtr_ rvInterPage_ id_

if ![info exists pgtr_] {
error "Http/Client requires a page generator (pgtr_)!"
}

if [info exists rvInterPage_] {
return [list [$rvInterPage_ value] [$pgtr_ gen-pageid $id_]]
} else {
return [$pgtr_ gen-request $id_]
}
}

Http/Client instproc next-request { server pageid } {
$self instvar ns_ cache_ nextreq_

if [info exists cache_] {
$self send-request $cache_ GET $pageid
} else {
$self send-request $server GET $pageid
}

set req [$self gen-request]
set pageid $server:[lindex $req 1]
set itvl [lindex $req 0]
if {$itvl >= 0} {
set nextreq_([$server id]) [$ns_ at [expr [$ns_ now] + $itvl]  "$self next-request $server $pageid"]
} ;# otherwise it's the end of the request stream 
}

Http/Client instproc set-cache { cache } {
$self instvar cache_
set cache_ $cache
}

Http/Client instproc start-session { cache server } {
$self instvar ns_ cache_ simStartTime_

$self instvar simStartTime_ pgtr_
set simStartTime_ [$ns_ now]
if [info exists pgtr_] {
if {[$pgtr_ get-start-time] > $simStartTime_} {
$pgtr_ set-start-time $simStartTime_
}
}


set cache_ $cache

set req [$self gen-request]
set pageid $server:[lindex $req 1]
set itvl [lindex $req 0]
if {$itvl >= 0} {
$ns_ at [expr [$ns_ now] + $itvl]  "$self next-request $server $pageid"
} ;# otherwise it's the end of the request stream 
}

Http/Client instproc stop-session { server } {
$self instvar ns_ nextreq_ pending_ cache_
set sid [$server id]

if [info exists nextreq_($sid)] {
$ns_ cancel $nextreq_($sid)
}
if {![info exists pending_]} {
return
}
if {[info exists cache_] && ($server == $cache_)} {
unset pending_
} else {
foreach p [array names pending_] {
if {$server == [lindex [split $p :] 0]} {
unset pending_($p)
}
}
}
}

Http/Client instproc populate { cache server } {
$self instvar pgtr_ curpage_ status_ ns_

if ![info exists status_] {
set status_ "POPULATE"
set curpage_ 0
}

if [info exists pgtr_] {
if {$curpage_ < [$pgtr_ get-poolsize]} {
$self send-request $cache GET $server:$curpage_
incr curpage_
$ns_ at [expr [$ns_ now] + 1]  "$self populate $cache $server"
return
}
}

$ns_ at [expr [$ns_ now] + 10] "$self start-session $cache $server"
}

Http/Client instproc start { cache server } {
$self instvar cache_
set cache_ $cache
$self populate $cache $server
}

Http/Client instproc request-mpush { page } {
$self instvar mpush_refresh_ ns_ cache_
$self send $cache_ [$self get-mpusize]  "$cache_ request-mpush $page"
Http/Client instvar hb_interval_
set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_]  "$self send-refresh-mpush $page"]
}

Http/Client instproc send-refresh-mpush { page } {
$self instvar mpush_refresh_ ns_ cache_
$self send $cache_ [$self get-mpusize] "$cache_ refresh-mpush $page"
Http/Client instvar hb_interval_
set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_]  "$self send-refresh-mpush $page"]
}

Http/Client instproc stop-mpush { page } {
$self instvar mpush_refresh_ ns_ cache_

if [info exists mpush_refresh_($page)] {
$ns_ cancel $mpush_refresh_($page)
} else {
error "no mpush to cancel!"
}
$self send $cache_ [$self get-mpusize] "$cache_ stop-mpush $page"
}


Class Http/Client/Compound -superclass Http/Client

Http/Client/Compound instproc set-interobj-generator { ranvar } {
$self instvar rvInterObj_
set rvInterObj_ $ranvar
}

Http/Client/Compound instproc next-request { server pageid } {
eval $self next $server $pageid

}

Http/Client/Compound instproc next-obj { server args } {
$self instvar pgtr_ cache_ req_objs_ ns_ rvInterObj_

if ![llength $args] {
return
}

if [info exists cache_] {
set dest $cache_
} else {
set dest $server
}

set pageid [lindex $args 0]
set mpgid [$pgtr_ get-mainpage $pageid] ;# main page id
set max 0
set origsvr [lindex [split $pageid :] 0]

foreach pageid $args {
set id [lindex [split $pageid :] 1]
if {$max < $id} {
set max $id
}
incr req_objs_($mpgid) -1
$self send-request $dest GET $pageid
}
if {$req_objs_($mpgid) <= 0} {
return
}

set objid [join [$pgtr_ get-next-objs $origsvr:$max]]
puts "At [$ns_ now], client [$self id] get objs $objid"
if [info exists rvInterObj_] {
$ns_ at [expr [$ns_ now] + [$rvInterObj_ value]]  "$self next-obj $server $objid"
} else {
$self next-obj $server $objid
}
}

Http/Client/Compound instproc get-response-GET { server pageid args } {
$self instvar pending_ id_ ns_ recv_objs_ max_stale_ stat_  simStartTime_ pgtr_

if ![info exists pending_($pageid)] {
error "Client $id_: Unrequested response page $pageid from server/cache [$server id]"
}

if [$pgtr_ is-mainpage $pageid] {
set mpgid $pageid
$self instvar req_objs_ recv_objs_ rvInterObj_
set recv_objs_($pageid) [$pgtr_ get-obj-num $pageid] 
set req_objs_($pageid) $recv_objs_($pageid) 
set objid [join [$pgtr_ get-next-objs $pageid]]
if [info exists rvInterObj_] {
$ns_ at [expr [$ns_ now] + [$rvInterObj_ value]]  "$self next-obj $server $objid"
} else {
eval $self next-obj $server $objid
}
} else {
set mpgid [$pgtr_ get-mainpage $pageid]
}

array set data $args

set origsvr [lindex [split $pageid :] 0]
set modtime [$origsvr get-modtime $pageid]
set reqtime [lindex $pending_($pageid) 0]
set reqrtt [expr [$ns_ now] - $reqtime]
if {$modtime > $data(modtime)} {
$self instvar ns_
set tmp [$origsvr stale-time $pageid $data(modtime)]
if {$tmp > $reqrtt/2} {
if ![info exists max_stale_($mpgid)] {
set max_stale_($mpgid) $tmp
} elseif {$max_stale_($mpgid) < $tmp} {
set max_stale_($mpgid) $tmp
}
}
}

if [$pgtr_ is-mainpage $pageid] {
return
}

$self evTrace C RCV p $pageid s [$server id] l $reqrtt z $data(size)
unset pending_($pageid)

incr recv_objs_($mpgid) -1
if {$recv_objs_($mpgid) > 0} {
return
}

$self instvar pgtr_
set reqtime [lindex $pending_($mpgid) 0]
$self evTrace C RCV p $mpgid s [$origsvr id] l  [expr [$ns_ now] - $reqtime] z $data(size)
unset pending_($mpgid)

if [info exists simStartTime_] {
set tmp [expr [$ns_ now] - $reqtime]
set stat_(rep-time) [expr $stat_(rep-time) + $tmp]
if {$stat_(rt-min) > $tmp} {
set stat_(rt-min) $tmp
}
if {$stat_(rt-max) < $tmp} {
set stat_(rt-max) $tmp
}
unset tmp
}
if [info exists max_stale_($mpgid)] {
$self evTrace C STA p $mpgid s [$origsvr id]  l $max_stale_($mpgid)
if [info exists simStartTime_] {
incr stat_(stale-num)
set stat_(stale-time) [expr  $stat_(stale-time) + $max_stale_($mpgid)]
if {$stat_(st-min) > $max_stale_($mpgid)} {
set stat_(st-min) $max_stale_($mpgid)
}
if {$stat_(st-max) < $max_stale_($mpgid)} {
set stat_(st-max) $max_stale_($mpgid)
}
}
unset max_stale_($mpgid)
}
$self mark-response $mpgid
}

Http/Client/Compound instproc mark-request { pageid } {
set id [lindex [split $pageid :] end]
if {$id == 0} {
$self next $pageid
}
}



Http/Client/Media instproc create-pagepool {} {
set pool [new PagePool/Client/Media]
$self set-pagepool $pool
return $pool
}

Http/Client/Media instproc get-response-GET { server pageid args } {
eval $self next $server $pageid $args

if [$self exist-page $pageid] {
error "Http/Client/Media: receives an \"active\" page!"
}
eval $self enter-page $pageid $args

array set data $args
if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
$self media-connect $server $pageid
}
}

Http/Client/Media instproc send-request { server type pageid args } {
$self instvar mmapp_ 
if [info exists mmapp_($pageid)] {
return
}
eval $self next $server $type $pageid $args
}

Http/Client/Media instproc media-connect { server pageid } {


$self instvar mmapp_ ns_ node_ 
Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
if [info exists mmapp_($pageid)] {
puts "Media client [$self id] got a request for an existing stream"
return
}
set agent [new Agent/$MEDIA_TRANSPORT_]
$ns_ attach-agent $node_ $agent
set app [new Application/$MEDIA_APP_ $pageid]
$app attach-agent $agent
$app target $self
$server alloc-mcon $self $pageid $agent
set mmapp_($pageid) $app
$app set-layer [$self get-layer $pageid]
}

Http/Client/Media instproc media-disconnect { server pageid } {
$self instvar mmapp_ ns_ node_

if {![info exists mmapp_($pageid)]} {
error "Media client [$self id] disconnect: not connected to  server [$server id] with page $pageid"
}
set app $mmapp_($pageid)
set agent [$app agent]
$ns_ detach-agent $node_ $agent


$server media-disconnect $self $pageid

delete $agent
delete $app
unset mmapp_($pageid)

$self stream-received $pageid
}



Http/Server/Media instproc gen-page { pageid } {
$self instvar pgtr_ 
set pginfo [$self next $pageid]
if [$pgtr_ is-media-page $pageid] {
return [lappend pginfo pgtype MEDIA]
} else {
return $pginfo
}
}

Http/Server/Media instproc create-pagepool {} {
set pool [new PagePool/Client/Media]
$self set-pagepool $pool
$pool set max_size_ 2147483647
return $pool
}

Http/Server/Media instproc medialog-on {} {
$self instvar MediaLog_
set MediaLog_ 1
}

Http/Server/Media instproc alloc-mcon { client pageid dst_agent } {
$self instvar ns_ node_ mmapp_ 
Http instvar MEDIA_TRANSPORT_ MEDIA_APP_

set agent [new Agent/$MEDIA_TRANSPORT_]
$ns_ attach-agent $node_ $agent
set app [new Application/$MEDIA_APP_ $pageid]
$app attach-agent $agent
$app target $self 
set mmapp_($client/$pageid) $app
$app set-layer [$self get-layer $pageid]

$self register-client $app $client $pageid

$self instvar MediaLog_
if [info exists MediaLog_] {
set lf [$self log]
if {$lf != ""} {
$app log $lf
}
}

$ns_ connect $agent $dst_agent
$agent start
}

Http/Server/Media instproc media-disconnect { client pageid } { 
$self instvar mmapp_ ns_ node_


if {![info exists mmapp_($client/$pageid)]} {
error "Media server [$self id] disconnect: not connected to  client [$client id] with page $pageid"
}
set app $mmapp_($client/$pageid)
set agent [$app agent]
$ns_ detach-agent $node_ $agent

$self unregister-client $app $client $pageid


delete $agent
delete $app
unset mmapp_($client/$pageid)
}

Http/Server/Media instproc finish-stream { app } {
$self instvar mmapp_ 
foreach n [array names mmapp_] {
if {$mmapp_($n) == $app} {
set tmp [split $n /]
set client [lindex $tmp 0]
set pageid [lindex $tmp 1]
$self send $client [$self get-reqsize]  "$client media-disconnect $self $pageid"
return
}
}
}

Http/Server/Media instproc handle-request-GET { pageid args } {
set pginfo [eval $self next $pageid $args]
if {[$self get-pagetype $pageid] == "MEDIA"} {
set pginfo [lreplace $pginfo 0 0 [$self get-reqsize]]
}
return $pginfo
}

Http/Server/Media instproc gen-pageinfo { pageid } {
set pginfo [eval $self next $pageid]
$self instvar pgtr_
if [$pgtr_ is-media-page $pageid] {
return [lappend pginfo pgtype MEDIA layer  [$pgtr_ get-layer $pageid]]
} else {
return $pginfo
}
}


Http/Server/Media instproc get-request { client type pageid args } {
if {$type == "PREFSEG"} {
set pagenum [lindex [split $pageid :] 1]
set conid [lindex $args 0]
set layer [lindex $args 1]
set seglist [lrange $args 2 end]
eval $self register-prefetch $client $pagenum $conid  $layer $seglist
$client start-prefetch $self $pageid $conid
$self evTrace S PREF p $pageid l $layer [join $seglist]
} elseif {$type == "STOPPREF"} {
set pagenum [lindex [split $pageid :] 1]
set conid [lindex $args 0]
if [$self stop-prefetching $client $conid $pagenum] {
$client media-disconnect $self $pageid $conid
}
} elseif {$type == "OFFLPREF"} {
if ![$self exist-page $pageid] {
error "Server [$self id] offline-prefetch non-existent page $pageid!"
}
set size [$self get-size $pageid]
$self send $client $size "$client offline-complete $pageid"
} else {
eval $self next $client $type $pageid $args
}
}




Http/Cache/Media instproc create-pagepool {} {
set pool [new PagePool/Client/Media]
$self set-pagepool $pool
return $pool
}

Http/Cache/Media instproc start-prefetch { server pageid conid } {
$self instvar pref_ ns_
if [info exists pref_($server/$pageid)] {
if {[lsearch -exact $pref_($server/$pageid) $conid] == -1} {
lappend pref_($server/$pageid) $conid
}
return
} else {
lappend pref_($server/$pageid) $conid
}
Http instvar MEDIA_APP_
set oldapp $MEDIA_APP_
set oldipg [Agent/RAP set ipg_]
set oldsrtt [Agent/RAP set srtt_]
Agent/RAP set ipg_ 0.01
Agent/RAP set srtt_ 0.01
set MEDIA_APP_ MediaApp
$self media-connect $server $pageid
set MEDIA_APP_ $oldapp
Agent/RAP set ipg_ $oldipg
Agent/RAP set srtt_ $oldsrtt
}

Http/Cache/Media instproc media-connect { server pageid } {
$self instvar s_mmapp_ ns_ node_ 


Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
if [info exists s_mmapp_($server/$pageid)] {
error "Media client [$self id] got a request for an existing  stream"
}
set agent [new Agent/$MEDIA_TRANSPORT_]
$ns_ attach-agent $node_ $agent
set app [new Application/$MEDIA_APP_ $pageid]
$app attach-agent $agent
$app target $self
$server alloc-mcon $self $pageid $agent
set s_mmapp_($server/$pageid) $app
$app set-layer [$self get-layer $pageid]
}

Http/Cache/Media instproc alloc-mcon { client pageid dst_agent } {
$self instvar ns_ node_ c_mmapp_ 
Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
if [info exists c_mmapp_($client/$pageid)] {
error "Media cache [$self id] got a request for an existing  stream $pageid from client [$client id]"
}

set agent [new Agent/$MEDIA_TRANSPORT_]
$ns_ attach-agent $node_ $agent
set app [new Application/$MEDIA_APP_ $pageid]
$app attach-agent $agent
$app target $self 
set c_mmapp_($client/$pageid) $app
$app set-layer [$self get-layer $pageid]

$self register-client $app $client $pageid

$self instvar MediaLog_
if [info exists MediaLog_] {
set lf [$self log]
if {$lf != ""} {
$app log $lf
}
}

$ns_ connect $agent $dst_agent
$agent start
}

Http/Cache/Media instproc medialog-on {} {
$self instvar MediaLog_
set MediaLog_ 1
}

Http/Cache/Media instproc media-disconnect { host pageid args } {
$self instvar c_mmapp_ s_mmapp_ ns_ node_ pref_ c_tbt_

set cntdisco 0 
set svrdisco 0

set server [lindex [split $pageid :] 0]

if {($host != $server) && [info exists c_mmapp_($host/$pageid)]} {
set app $c_mmapp_($host/$pageid)
set agent [$app agent]
$ns_ detach-agent $node_ $agent
$self unregister-client $app $host $pageid

if {[info exists pref_($server/$pageid)] &&  [lsearch -exact $pref_($server/$pageid) $app] != -1} {
$self send $server [$self get-reqsize] "$server get-request $self STOPPREF $pageid $app"
set c_tbt_($host/$pageid) $app
$app stop
} else {
delete $app
}
delete $agent
unset c_mmapp_($host/$pageid)

$self instvar pool_
foreach p [lsort [$pool_ list-pages]] {
$self dump-page $p
}
set cntdisco 1

} elseif [info exists s_mmapp_($host/$pageid)] {
set svrdisco 1
if [info exists pref_($server/$pageid)] {
set teardown 0
set conid [lindex $args 0]
set pos [lsearch -exact $pref_($server/$pageid) $conid]
if {$pos == -1} {
error "media-disconnect cannot find $conid!!"
}
set pref_($server/$pageid) [lreplace  $pref_($server/$pageid) $pos $pos]
if {[llength $pref_($server/$pageid)] == 0} {
$self evTrace E STP s [$server id] p $pageid
unset pref_($server/$pageid)
set teardown 1
}
delete $conid
} else {
set teardown 1
}
if {$teardown} {
set app $s_mmapp_($host/$pageid)
set agent [$app agent]
$ns_ detach-agent $node_ $agent
$host media-disconnect $self $pageid
delete $agent
delete $app
unset s_mmapp_($host/$pageid)
}
$self instvar firstreq_
if {([$self get-pref-style] == "OFFLINE_PREF") &&  [info exists firstreq_($pageid)]} { 
$self send $server [$self get-reqsize]  "$server get-request $self OFFLPREF $pageid"
}
if [info exists firstreq_($pageid)] {
unset firstreq_($pageid)
}
} else {
error "At [$ns_ now] Media cache [$self id] tries to  disconnect from a non-connected host [$host id]"
}

if {$svrdisco == 1} {
$self stream-received $pageid
}
}

Http/Cache/Media instproc finish-stream { app } {
$self instvar c_mmapp_ s_mmapp_
foreach n [array names c_mmapp_] {
if {$c_mmapp_($n) == $app} {
set tmp [split $n /]
set client [lindex $tmp 0]
set pageid [lindex $tmp 1]
$self send $client [$self get-reqsize]  "$client media-disconnect $self $pageid"
return
}
}
}

Http/Cache/Media instproc get-response-GET { server pageid args } {
$self instvar firstreq_
if ![$self exist-page $pageid] {
set firstreq_($pageid) 1
}

eval $self next $server $pageid $args


array set data $args
if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
$self media-connect $server $pageid
}
}

Http/Cache/Media instproc answer-request-GET { cl pageid args } {
array set data $args
if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
set size [$self get-reqsize]
} else {
set size $data(size)
}
$self send $cl $size  "$cl get-response-GET $self $pageid $args"
$self evTrace E SND c [$cl id] p $pageid z $data(size)
}

Http/Cache/Media instproc pref-segment {conid pageid layer args} {
set server [lindex [split $pageid :] 0]
set size [$self get-reqsize]
$self send $server $size "$server get-request $self PREFSEG  $pageid $conid $layer [join $args]"
}

Http/Cache/Media instproc set-repl-style { style } {
$self instvar pool_
$pool_ set-repl-style $style
}


PagePool/WebTraf set debug_ false
PagePool/WebTraf set TCPTYPE_ Reno

PagePool/WebTraf instproc launch-req { id clnt svr ctcp csnk stcp ssnk size } {
set ns [Simulator instance]


$ns attach-agent $clnt $ctcp
$ns attach-agent $svr $csnk
$ns connect $ctcp $csnk
$ctcp set fid_ $id

$ns attach-agent $svr $stcp
$ns attach-agent $clnt $ssnk
$ns connect $stcp $ssnk
$stcp set fid_ $id

$ctcp proc done {} "$self done-req $id $clnt $svr $ctcp $csnk $stcp $size"
$stcp proc done {} "$self done-resp $id $clnt $svr $stcp $ssnk"

$ctcp advanceby 1
}

PagePool/WebTraf instproc done-req { id clnt svr ctcp csnk stcp size } {
set ns [Simulator instance]


$ns detach-agent $clnt $ctcp
$ns detach-agent $svr $csnk
$ctcp reset
$csnk reset
$self recycle $ctcp $csnk
$stcp advanceby $size
}

PagePool/WebTraf instproc done-resp { id clnt svr stcp ssnk } {
set ns [Simulator instance]


$ns detach-agent $clnt $ssnk
$ns detach-agent $svr $stcp
$stcp reset
$ssnk reset
$self recycle $stcp $ssnk
}

PagePool/WebTraf instproc alloc-tcp {} {
return [new Agent/TCP/[PagePool/WebTraf set TCPTYPE_]]
}

PagePool/WebTraf instproc alloc-tcp-sink {} {
return [new Agent/TCPSink]
}


Node instproc shape { shape } {
$self instvar attr_ 
set attr_(SHAPE) $shape
}

Node instproc get-shape {} {
$self instvar attr_
if [info exists attr_(SHAPE)] {
return $attr_(SHAPE)
} else {
return ""
}
}

Node instproc color { color } {
$self instvar attr_ id_

set ns [Simulator instance]

if [$ns is-started] {

$ns puts-nam-config  [eval list "n -t [$ns now] -s $id_ -S COLOR -c $color -o $attr_(COLOR) -i $color -I $attr_(LCOLOR)"]
set attr_(COLOR) $color
set attr_(LCOLOR) $color
} else {
set attr_(COLOR) $color
set attr_(LCOLOR) $color
}
}

Node instproc label { str} {
$self instvar attr_ id_

set ns [Simulator instance]

if [info exists attr_(DLABEL)] {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DLABEL -l \"$str\" -L $attr_(DLABEL)"
} else {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DLABEL -l \"$str\" -L \"\""
}
set attr_(DLABEL) \"$str\"
}

Node instproc label-color { str} {
$self instvar attr_ id_

set ns [Simulator instance]

if [info exists attr_(DCOLOR)] {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DCOLOR -e \"$str\" -E $attr_(DCOLOR)"
} else {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DCOLOR -e \"$str\" -E \"\""
}
set attr_(DCOLOR) \"$str\"
}

Node instproc label-at { str } {
$self instvar attr_ id_

set ns [Simulator instance]

if [info exists attr_(DIRECTION)] {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DIRECTION -p \"$str\" -P $attr_(DIRECTION)"
} else {
$ns puts-nam-config "n -t [$ns now] -s $id_ -S DIRECTION -p \"$str\" -P \"\""
}
set attr_(DIRECTION) \"$str\"
}

Node instproc dump-namconfig {} {
$self instvar attr_ id_ address_
set ns [Simulator instance]

if ![info exists attr_(SHAPE)] {
set attr_(SHAPE) "circle"
} 
if ![info exists attr_(COLOR)] {
set attr_(COLOR) "black"
set attr_(LCOLOR) "black"
}
if ![info exists attr_(DCOLOR)] {
set attr_(DCOLOR) "black"
}
$ns puts-nam-config  [eval list "n -t * -a $address_ -s $id_ -S UP -v $attr_(SHAPE) -c $attr_(COLOR) -i $attr_(LCOLOR)"]
}

Node instproc change-color { color } {
puts "Warning: Node::change-color is obsolete. Use Node::color instead"
$self color $color
}

Node instproc get-attribute { name } {
$self instvar attr_
if [info exists attr_($name)] {
return $attr_($name)
} else {
return ""
}
}

Node instproc get-color {} {
puts "Warning: Node::get-color is obsolete. Please use Node::get-attribute"
return [$self get-attribute "COLOR"]
}

Node instproc add-mark { name color {shape "circle"} } {
$self instvar id_ markColor_ shape_
set ns [Simulator instance]

$ns puts-nam-config "m -t [$ns now] -s $id_ -n $name -c $color -h $shape"
set markColor_($name) $color
set shape_($name) $shape
}

Node instproc delete-mark { name } {
$self instvar id_ markColor_ shape_

if ![info exists markColor_($name)] {
return
}

set ns [Simulator instance]
$ns puts-nam-config  "m -t [$ns now] -s $id_ -n $name -c $markColor_($name) -h $shape_($name) -X"
}

SimpleLink instproc dump-namconfig {} {
$self instvar link_ attr_ fromNode_ toNode_

if ![info exists attr_(COLOR)] {
set attr_(COLOR) "black"
}

if ![info exists attr_(ORIENTATION)] {
set attr_(ORIENTATION) ""
}

set ns [Simulator instance]
set bw [$link_ set bandwidth_]
set delay [$link_ set delay_]

$ns puts-nam-config  "l -t * -s [$fromNode_ id] -d [$toNode_ id] -S UP -r $bw -D $delay -c $attr_(COLOR) -o $attr_(ORIENTATION)"
}

Link instproc dump-nam-queueconfig {} {
$self instvar attr_ fromNode_ toNode_

if ![info exists attr_(COLOR)] {
set attr_(COLOR) "black"
}

set ns [Simulator instance]
if [info exists attr_(QUEUE_POS)] {
$ns puts-nam-config "q -t * -s [$fromNode_ id] -d [$toNode_ id] -a $attr_(QUEUE_POS)"
} else {
set attr_(QUEUE_POS) ""
}
}

Link instproc orient { ori } {
$self instvar attr_
set attr_(ORIENTATION) $ori
[Simulator instance] register-nam-linkconfig $self
}

Link instproc get-attribute { name } {
$self instvar attr_
if [info exists attr_($name)] {
return $attr_($name)
} else {
return ""
}
}

Link instproc queuePos { pos } {
$self instvar attr_
set attr_(QUEUE_POS) $pos
}

Link instproc color { color } {
$self instvar attr_ fromNode_ toNode_ trace_

set ns [Simulator instance]
if [$ns is-started] {
$ns puts-nam-config  [eval list "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S COLOR -c $color -o $attr_(COLOR)"]
set attr_(COLOR) $color
} else {
set attr_(COLOR) $color
}
}

Link instproc change-color { color } {
puts "Warning: Link::change-color is obsolete. Please use Link::color."
$self color $color
}

Link instproc get-color {} {
puts "Warning: Node::get-color is obsolete. Please use Node::get-attribute"
return [$self get-attribute "COLOR"]
}

Link instproc label { label } {
$self instvar attr_ fromNode_ toNode_ trace_
set ns [Simulator instance]
if [info exists attr_(DLABEL)] {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DLABEL -l \"$label\" -L $attr_(DLABEL)"
} else {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DLABEL -l \"$label\" -L \"\""
}
set attr_(DLABEL) \"$label\"
}

Link instproc label-color { str } {
$self instvar attr_ fromNode_ toNode_ trace_
set ns [Simulator instance]
if [info exists attr_(DCOLOR)] {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DCOLOR -e \"$str\" -E $attr_(DCOLOR)"
} else {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DCOLOR -e \"$str\" -E \"\""
}
set attr_(DCOLOR) \"$str\"
}

Link instproc label-at { str } {
$self instvar attr_ fromNode_ toNode_ trace_
set ns [Simulator instance]
if [info exists attr_(DIRECTION)] {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DIRECTION -p \"$str\" -P $attr_(DIRECTION)"
} else {
$ns puts-nam-config  "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DIRECTION -p \"$str\" -P \"\""
}
set attr_(DIRECTION) \"$str\"
}


Simulator instproc snapshot { } {
set ns [Simulator instance]
$ns puts-nam-config  "v -t [$self now] take_snapshot"
}

Simulator instproc rewind-nam { } {
set ns [Simulator instance]
$ns puts-nam-config  "v  -t [$self now] playing_backward"
}

Simulator instproc re-rewind-nam { } {
set ns [Simulator instance]
$ns puts-nam-config  "v  -t [$self now] playing_forward"
}

Simulator instproc terminate-nam { } {
set ns [Simulator instance]
$ns puts-nam-config  "v  -t [$self now] terminating_nam"
}


Simulator instproc add-agent-trace { agent name {f ""} } {
$self instvar tracedAgents_
set tracedAgents_($name) $agent

set trace [$self get-nam-traceall]
if {$f != ""} {
$agent attach-trace $f
} elseif {$trace != ""} {
$agent attach-trace $trace
}
}

Simulator instproc delete-agent-trace { agent } {
$agent delete-agent-trace
}

Simulator instproc monitor-agent-trace { agent } {
$self instvar monitoredAgents_
lappend monitoredAgents_ $agent
}

Agent instproc attach-trace { file } {
$self instvar namTrace_
set namTrace_ $file 
$self attach $file 
}

Simulator instproc dump-namagents {} {
$self instvar tracedAgents_ monitoredAgents_

if {![$self is-started]} {
return
}
if [info exists tracedAgents_] {
foreach id [array names tracedAgents_] {
$tracedAgents_($id) add-agent-trace $id
$tracedAgents_($id) cmd dump-namtracedvars
}
unset tracedAgents_
}
if [info exists monitoredAgents_] {
foreach a $monitoredAgents_ {
$a show-monitor
}
unset monitoredAgents_
}
}

Simulator instproc dump-namversion { v } {
$self puts-nam-config "V -t * -v $v -a 0"
}

Simulator instproc dump-namcolors {} {
$self instvar color_
if ![$self is-started] {
return 
}
foreach id [array names color_] {
$self puts-nam-config "c -t * -i $id -n $color_($id)"
}
}

Simulator instproc dump-namlans {} {
if ![$self is-started] {
return
}
$self instvar Node_
foreach nn [array names Node_] {
if [$Node_($nn) is-lan?] {
$Node_($nn) dump-namconfig
}
}
}

Simulator instproc dump-namlinks {} {
$self instvar linkConfigList_
if ![$self is-started] {
return
}
if [info exists linkConfigList_] {
foreach lnk $linkConfigList_ {
$lnk dump-namconfig
}
unset linkConfigList_
}
}

Simulator instproc dump-namnodes {} {
$self instvar Node_
if ![$self is-started] {
return
}
foreach nn [array names Node_] {
if ![$Node_($nn) is-lan?] {
$Node_($nn) dump-namconfig
}
}
}

Simulator instproc dump-namqueues {} {
$self instvar link_
if ![$self is-started] {
return
}
foreach qn [array names link_] {
$link_($qn) dump-nam-queueconfig
}
}

Simulator instproc dump-namaddress {} {
AddrParams instvar hlevel_ NodeShift_ NodeMask_ McastShift_ McastMask_

$self puts-nam-config  "A -t * -n $hlevel_ -p 0 -o [AddrParams set ALL_BITS_SET] -c $McastShift_ -a $McastMask_"

for {set i 1} {$i <= $hlevel_} {incr i} {
$self puts-nam-config  "A -t * -h $i -m $NodeMask_($i) -s $NodeShift_($i)"
}
}

Simulator instproc init-nam {} {
$self instvar annotationSeq_ 

set annotationSeq_ 0

$self dump-namversion 1.0a5

$self dump-namaddress

$self dump-namcolors

$self dump-namnodes

$self dump-namlinks 
$self dump-namlans

$self dump-namqueues

$self dump-namagents

}

Simulator instproc trace-annotate { str } {
$self instvar annotationSeq_
$self puts-ns-traceall [format  "v %s %s {set sim_annotation {%s}}" [$self now] eval $str]
incr annotationSeq_
$self puts-nam-config  "v -t [$self now] sim_annotation [$self now] $annotationSeq_ $str"
}

proc trace_annotate { str } {
set ns [Simulator instance]

$ns trace-annotate $str
}

proc flash_annotate { start duration msg } {
set ns [Simulator instance]
$ns at $start "trace_annotate {$msg}"
$ns at [expr $start+$duration] "trace_annotate periodic_message"
}

Simulator instproc set-animation-rate { rate } {
set r [time_parse $rate]
$self puts-nam-config "v -t [$self now] set_rate [expr 10*log10($r)] 1"
}

Agent/DSDV set sport_        0
Agent/DSDV set dport_        0
Agent/DSDV set wst0_         6        ;# As specified by Pravin
Agent/DSDV set perup_       15        ;# As given in the paper (update period)
Agent/DSDV set use_mac_      0        ;# Performance suffers with this on
Agent/DSDV set be_random_    1        ;# Flavor the performance numbers :)
Agent/DSDV set alpha_        0.875    ;# 7/8, as in RIP(?)
Agent/DSDV set min_update_periods_ 3  ;# Missing perups before linkbreak
Agent/DSDV set verbose_      0        ;# 
Agent/DSDV set trace_wst_    0        ;# 

set opt(ragent)		Agent/DSDV
set opt(pos)		NONE			;# Box or NONE

if { $opt(pos) == "Box" } {
puts "*** DSDV using Box configuration..."
}

Agent instproc init args {
eval $self next $args
}       

Agent/DSDV instproc init args {
eval $self next $args
}       



proc create-dsdv-routing-agent { node id } {
global ns_ ragent_ tracefd opt

set ragent_($id) [new $opt(ragent)]
set ragent $ragent_($id)

set addr [$node node-addr]

$ragent addr $addr
$ragent node $node
if [Simulator set mobile_ip_] {
$ragent port-dmux [$node set dmux_]
}
$node addr $addr
$node set ragent_ $ragent

$node attach $ragent [Node set rtagent_port_]


$ns_ at 0.0 "$ragent_($id) start-dsdv"	;# start updates

set drpT [cmu-trace Drop "RTR" $node]
$ragent drop-target $drpT

set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ $id
$ragent tracetarget $T
}


proc dsdv-create-mobile-node { id args } {
global ns ns_ chan prop topo tracefd opt node_
global chan prop tracefd topo opt

set ns_ [Simulator instance]
if {[Simulator set EnableHierRt_]} {
if [Simulator set mobile_ip_] {
set node_($id) [new MobileNode/MIPMH $args]
} else {
set node_($id) [new Node/MobileNode/BaseStationNode $args]
}
} else {
set node_($id) [new Node/MobileNode]
}
set node $node_($id)
$node random-motion 0		;# disable random motion
$node topography $topo

if [info exists opt(energy)] {
$node addenergymodel [new $opt(energy) $node 1000 0.5 0.2]
}

set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ $id
$node log-target $T

$node add-interface $chan $prop $opt(ll) $opt(mac)	 $opt(ifq) $opt(ifqlen) $opt(netif) $opt(ant)

create-$opt(rp)-routing-agent $node $id

if { $opt(pos) == "Box" } {
set spacing 200
set maxrow 7
set col [expr ($id - 1) % $maxrow]
set row [expr ($id - 1) / $maxrow]
$node set X_ [expr $col * $spacing]
$node set Y_ [expr $row * $spacing]
$node set Z_ 0.0
$node set speed_ 0.0

$ns_ at 0.0 "$node_($id) start"
}
return $node
}










set opt(rt_port) 255
set opt(cc)      "off"            ;# have god check the caches for bad links?


Class CacheTimer -superclass Timer
CacheTimer instproc timeout {} {
global opt node_;
$self instvar agent;
$agent check-cache
$self sched 1.0
}

proc checkcache {a} {
global cachetimer ns

set cachetimer [new CacheTimer]
$cachetimer set agent $a
$cachetimer sched 1.0
}

Class SRNode -superclass Node/MobileNode

SRNode instproc init {args} {
global ns ns_ opt tracefd RouterTrace
$self instvar dsr_agent_ dmux_ entry_point_ address_
set ns_ [Simulator instance]

eval $self next $args	;# parent class constructor
if {$dmux_ == "" } {
set dmux_ [new Classifier/Port]
$dmux_ set mask_ [AddrParams set PortMask_]
$dmux_ set shift_ [AddrParams set PortShift_]
}
set dsr_agent_ [new Agent/DSRAgent]

$dsr_agent_ addr $address_
$dsr_agent_ node $self
if [Simulator set mobile_ip_] {
$dsr_agent_ port-dmux [$self set dmux_]
}
$self addr $address_

if { $RouterTrace == "ON" } {
set rcvT [cmu-trace Recv "RTR" $self]
$rcvT target $dsr_agent_
set entry_point_ $rcvT	
} else {
set entry_point_ $dsr_agent_
}

set drpT [cmu-trace Drop "RTR" $self]
$dsr_agent_ drop-target $drpT


set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ [$self id]
$dsr_agent_ log-target $T

$dsr_agent_ target $dmux_

set nullAgent_ [$ns_ set nullAgent_]
$dmux_ install $opt(rt_port) $nullAgent_

$self instvar classifier_
set classifier_ "srnode made illegal use of classifier_"

}

SRNode instproc start-dsr {} {
$self instvar dsr_agent_
global opt;

$dsr_agent_ startdsr
if {$opt(cc) == "on"} {checkcache $dsr_agent_}
}

SRNode instproc entry {} {
$self instvar entry_point_
return $entry_point_
}



SRNode instproc add-interface {args} {
global ns ns_ opt RouterTrace

eval $self next $args

$self instvar dsr_agent_ ll_ mac_ ifq_

$dsr_agent_ mac-addr [$mac_(0) id]

if { $RouterTrace == "ON" } {
set sndT [cmu-trace Send "RTR" $self]
$sndT target $ll_(0)
$dsr_agent_ add-ll $sndT $ifq_(0)
} else {
$dsr_agent_ add-ll $ll_(0) $ifq_(0)
}

$dsr_agent_ install-tap $mac_(0)

}

SRNode instproc reset args {
$self instvar dsr_agent_
eval $self next $args

$dsr_agent_ reset
}


proc dsr-create-mobile-node { id args } {
global ns_ chan prop topo tracefd opt node_
set ns_ [Simulator instance] 
if {[Simulator set EnableHierRt_]} {
if [Simulator set mobile_ip_] {
set node_($id) [new SRNode/MIPMH $args]
} else {
set node_($id) [new SRNode $args]
}
} else {
set node_($id) [new SRNode]
}
set node $node_($id)
$node random-motion 0		;# disable random motion
$node topography $topo

if [info exists opt(energy)] {
$node addenergymodel [new $opt(energy) $node 1000 0.5 0.2]
}

$node add-interface $chan $prop $opt(ll) $opt(mac)	 $opt(ifq) $opt(ifqlen) $opt(netif) $opt(ant)

set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ $id
$node log-target $T

$ns_ at 0.0 "$node start-dsr"
return $node
}


proc create-base-station-node {address } {
global topo tracefd opt node node_ ns_
set ns_ [Simulator instance]
if [Simulator set mobile_ip_] {
Simulator set node_factory_ MobileNode/MIPBS
} else {
Simulator set node_factory_ Node/MobileNode/BaseStationNode
}
set node [$ns_ node $address]
set id [$node id]

$node random-motion 0		;# disable random motion
$node topography $topo
set T [new Trace/Generic]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ $id
$node log-target $T
$node base-station [AddrParams set-hieraddr [$node node-addr]]


create-$opt(rp)-bs-node $node $id

Simulator set node_factory_ Node    ;# default value
return $node
}


proc create-dsdv-bs-node {node id} {
global ns_ chan prop opt node_
$node instvar regagent_ ragent_

$node add-interface $chan $prop $opt(ll) $opt(mac)	 $opt(ifq) $opt(ifqlen) $opt(netif)  $opt(ant)

create-$opt(rp)-routing-agent $node $id

if [info exists regagent_] {
$regagent_ ragent $ragent_
}
if { $opt(pos) == "Box" } {
set spacing 200
set maxrow 7
set col [expr ($id - 1) % $maxrow]
set row [expr ($id - 1) / $maxrow]
$node set X_ [expr $col * $spacing]
$node set Y_ [expr $row * $spacing]
$node set Z_ 0.0
$node set speed_ 0.0

$ns_ at 0.0 "$node_($id) start"
}
}

proc create-dsr-bs-node {node id} {
global ns_ chan prop opt
$node instvar regagent_ ragent_

$node add-interface $chan $prop $opt(ll) $opt(mac)	 $opt(ifq) $opt(ifqlen) $opt(netif)  $opt(ant)

create-$opt(rp)-routing-agent $node $id
$node create-xtra-interface 

if [info exists regagent_] {
$regagent_ ragent $ragent_
}

$ns_ at 0.0 "$node start-dsr"
}


proc create-dsr-routing-agent { node id } {
global ns_ ragent_ tracefd opt

set ragent_($id) [new Agent/DSRAgent/BS_DSRAgent]
set ragent $ragent_($id)

set address [$node node-addr]
$ragent addr $address
$ragent node $node
if [Simulator set mobile_ip_] {
$ragent port-dmux [$node set dmux_]
}

$node addr $address
$node set ragent_ $ragent

set dmux [$node set dmux_]
if {$dmux == "" } {
set dmux [new Classifier/Hash/Dest 32]
$dmux set mask_ [AddrParams set PortMask_]
$dmux set shift_ [AddrParams set PortShift_]
if [Simulator set EnableHierRt_] {
$node add-hroute $address $ragent
} else {
$node add-route $address $ragent
}
$node set dmux_ $dmux
}
set level [AddrParams set hlevel_]

if { [Simulator set RouterTrace_] == "ON" } {
set rcvT [cmu-trace Recv "RTR" $node]
$rcvT target $ragent
for {set i 1} {$i <= $level} {incr i} {
[$node set classifiers_($i)] defaulttarget $rcvT
[$node set classifiers_($i)] bcast-receiver $rcvT
}
} else {

for {set i 1} {$i <= $level} {incr i} {
[$node set classifiers_($i)] defaulttarget $ragent
[$node set classifiers_($i)] bcast-receiver $ragent
}
}
set drpT [cmu-trace Drop "RTR" $node]
$ragent drop-target $drpT


$ragent target $dmux

$dmux install $opt(rt_port) $ragent
}


Node/MobileNode/BaseStationNode instproc create-xtra-interface { } {
global ns_ opt 
$self instvar ragent_ ll_ mac_ ifq_

$ragent_ mac-addr [$mac_(0) id]

if { [Simulator set RouterTrace_] == "ON" } {
set sndT [cmu-trace Send "RTR" $self]
$sndT target $ll_(0)
$ragent_ add-ll $sndT $ifq_(0)
} else {
$ragent_ add-ll $ll_(0) $ifq_(0)
}

$ragent_ install-tap $mac_(0)

}

Node/MobileNode/BaseStationNode instproc start-dsr {} {
$self instvar ragent_
global opt;

$ragent_ startdsr
if {$opt(cc) == "on"} {checkcache $dsr_agent_}
}

Node/MobileNode/BaseStationNode instproc reset args {
$self instvar ragent_
eval $self next $args

$ragent_ reset
}


proc create-god { nodes } {
set god [God info instances]
if { $god == "" } {
set god [new God]
}
$god num_nodes $nodes
return $god
}

God proc instance {} {
set god [God info instances]
if { $god != "" } {
return $god
}  
error "Cannot find instance of god"
}      

proc cmu-trace { ttype atype node } {
global ns_ tracefd

if { $tracefd == "" } {
return ""
}
set T [new CMUTrace/$ttype $atype]
$T target [$ns_ set nullAgent_]
$T attach $tracefd
$T set src_ [$node id]

$T node $node

return $T
}

proc log-movement {} {
global logtimer ns_ ns

set ns $ns_
source ../mobility/timer.tcl
Class LogTimer -superclass Timer
LogTimer instproc timeout {} {
global opt node_;
for {set i 0} {$i < $opt(nn)} {incr i} {
$node_($i) log-movement
}
$self sched 0.1
}

set logtimer [new LogTimer]
$logtimer sched 0.1
}    

proc set-wireless-traces { args } {
set len [llength $args]
if { $len <= 0 || [expr $len%2] } {
error "Incorrect number of parameters"
}
for {set n 0} {$n < $len} {incr n 2} {
if {[string compare [lindex $args $n] "-AgentTrace"] == 0 } {
Simulator set AgentTrace_ [lindex $args [expr $n+1]]
} elseif {[string compare [lindex $args $n] "-RouterTrace"] == 0 } {
Simulator set RouterTrace_ [lindex $args [expr $n+1]]
} elseif {[string compare [lindex $args $n] "-MacTrace"] == 0 } {
Simulator set MacTrace_ [lindex $args [expr $n+1]]
} else {
error "Unknown wireless trace type: [lindex $args $n]"
}
}
}  










Class PLM

PLM instproc init {levels chk_estimate n_id} {
$self next
$self instvar PP_estimate wait_loss time_loss 
$self instvar start_loss time_estimate check_estimate node_id
global rates
set PP_estimate {} 
set start_loss -1
set wait_loss 0
set time_loss 0
set time_estimate 0
set check_estimate $chk_estimate
set node_id $n_id

$self instvar debug_ env_ maxlevel_

set debug_ 0
set env_ [lindex [split [$self info class] /] 1]
set maxlevel_ $levels

global plm_debug_flag
if [info exists plm_debug_flag] {
set debug_ $plm_debug_flag
}

$self instvar subscription_

$self instvar layer_ layers_
set i 1
while { $i <= $maxlevel_ } {
set layer_($i) [$self create-layer [expr $i - 1]]
lappend layers_ $layer_($i)
incr i
}

set subscription_ 0
$self add-layer
}



PLM instproc make_estimate {PP_value} {
$self instvar PP_estimate PP_estimate_value ns_ time_estimate check_estimate debug_
global PP_estimation_length

lappend PP_estimate $PP_value

$self stability-drop $PP_value

set ns_time [$ns_ now]
if {$time_estimate==0} {
set time_estimate [expr $ns_time + $check_estimate]
}
if {$debug_>=3} {
trace_annotate "[$self node]: check: $check_estimate $PP_estimate , nb: [llength $PP_estimate]"
}

if {($time_estimate<=$ns_time) && ([llength $PP_estimate] >= $PP_estimation_length)} {
set PP_estimate_value [lindex [lsort -real $PP_estimate] 0]
if {$debug_>=3} {
trace_annotate "[$self node]: check: $check_estimate PP estim: $PP_estimate, value: $PP_estimate_value"
}
if {$debug_>=2} {
trace_annotate [expr round($PP_estimate_value)]
}
set PP_estimate {}
set time_estimate [expr $ns_time + $check_estimate]
$self choose_layer $PP_estimate_value

}
}


PLM instproc stability-drop {PP_value} {
$self instvar subscription_ start_loss time_estimate PP_estimate
$self instvar check_estimate ns_
global rates_cum

set ns_time [$ns_ now]
for {set i 0} {[lindex $rates_cum $i] < [expr round($PP_value)]} {incr i} {
if {$i > [llength $rates_cum]} {break}
}

if {$subscription_ > $i} {
for {set j $subscription_} {$i < $j} {incr j -1} {
set start_loss -1
$self drop-layer	    
}
set PP_estimate {}
set time_estimate [expr $ns_time + $check_estimate]
}
}

proc calc_cum {rates} {
set temp 0
set rates_cum {}
for {set i 0} {$i<[llength $rates]} {incr i} {
set temp [expr $temp + [lindex $rates $i]]
lappend rates_cum $temp
}
return $rates_cum
}

PLM instproc choose_layer {PP_estimate_value} {
$self instvar subscription_ start_loss
global rates_cum

set start_loss -1

for {set i 0} {[lindex $rates_cum $i] < [expr round($PP_estimate_value)]} {incr i} {
if {$i > [llength $rates_cum]} {break}
}

if {$subscription_ < $i} {
for {set j $subscription_} {$j < $i} {incr j} {
$self add-layer	    
}	    
} elseif {$subscription_ > $i} {
for {set j $subscription_} {$i < $j} {incr j -1} {
$self drop-layer	    
}
} elseif {$subscription_ == $i} {
return
}
}


PLM instproc log-loss {} {
$self instvar subscription_ h_npkts h_nlost start_loss debug_
$self instvar time_loss ns_ wait_loss

$self debug "LOSS [$self plm_loss]" 

if {$debug_>=2} {
trace_annotate "$self pkt_lost"
}
set ns_time [$ns_ now]


if {$time_loss <= $ns_time} {
if {$debug_>=2} {
trace_annotate "not enough losses during 1s: reinitialize"
}
set start_loss -1
}

if {($start_loss == -1) || ($wait_loss >= $ns_time)} {
if {$debug_>=2} {
trace_annotate "$start_loss [expr $wait_loss >= $ns_time] reinitialize"
}
set h_npkts [$self plm_pkts]
set h_nlost [$self plm_loss]
set start_loss 1
set time_loss [expr [$ns_ now] + 5]
if {$debug_>=2} {
trace_annotate "time_loss : $time_loss"
}
}

if {([$self exceed_loss_thresh]) && ($wait_loss <= $ns_time)} {
$self drop-layer
set start_loss -1
set wait_loss [expr $ns_time + 0.5]
if {$debug_>=2} {
trace_annotate "drop layer wait_loss: $wait_loss"
}
}
}

PLM instproc exceed_loss_thresh {} {
$self instvar h_npkts h_nlost debug_
set npkts [expr [$self plm_pkts] - $h_npkts]
if { $npkts >= 10 } {
set nloss [expr [$self plm_loss] - $h_nlost]
set loss [expr double($nloss) / ($nloss + $npkts)]
$self debug "H-THRESH $nloss $npkts $loss"
if { $loss > 0.10 } {
return 1
}
}
return 0
}


PLM instproc drop-layer {} {
$self instvar subscription_ layer_ node_id debug_
set n $subscription_

if { $n > 0 } {
$self debug "DRP-LAYER $n"
$layer_($n) leave-group 
incr n -1
set subscription_ $n
if {$debug_>=2} {
trace_annotate " [$self set node_id] : change layer $subscription_ "
}
}

if { $subscription_ == 0 } {
set ns [Simulator instance]
set rejoin_timer 30
$ns at [expr [$ns now] + $rejoin_timer] "$self add-layer"
if {$debug_>=2} {
trace_annotate " Try to re-join the session after dropping all the layers "
}
}
}

PLM instproc add-layer {} {
$self instvar maxlevel_ subscription_ layer_ node_id debug_
set n $subscription_
if { $n < $maxlevel_ } {
$self debug "ADD-LAYER"
incr n
set subscription_ $n
$layer_($n) join-group
if {$debug_>=2} {
trace_annotate " [$self set node_id] : change layer $subscription_ "
}
}
}

PLM instproc plm_loss {} {
$self instvar layers_
set loss 0
foreach l $layers_ {
incr loss [$l nlost]
}
return $loss
}

PLM instproc plm_pkts {} {
$self instvar layers_
set npkts 0
foreach l $layers_ {
incr npkts [$l npkts]
}
return $npkts
}

PLM instproc debug { msg } {
$self instvar debug_ subscription_ ns_

if {$debug_ <1} { return }
set time [format %.05f [$ns_ now]]
puts stderr "PLM: $time  layer $subscription_ $msg"
}

Class PLMLayer

PLMLayer instproc init { plm } {
$self next

$self instvar plm_ npkts_
set plm_ $plm
set npkts_ 0
}

PLMLayer instproc join-group {} {
$self instvar npkts_ add_time_ plm_
set npkts_ [$self npkts]
set add_time_ [$plm_ now]
}

PLMLayer instproc leave-group {} {
}

PLMLayer instproc getting-pkts {} {
$self instvar npkts_
return [expr [$self npkts] != $npkts_]
}


Application/Traffic/CBR_PP instproc set args {
$self instvar packet_size_ rate_ 
if { [lindex $args 0] == "interval_" } {
puts "Cannot use CBR_PP with interval_, specify rate_ instead"
}
eval $self next $args
}

Agent/LossMonitor/PLM instproc log-PP {} {
}

Class PLMLossTrace -superclass Agent/LossMonitor/PLM
PLMLossTrace set expected_ -1

PLMLossTrace instproc init {} {
$self next
$self instvar lastTime measure debug_
set lastTime 0
set measure -1
global plm_debug_flag
if [info exists plm_debug_flag] {
set debug_ $plm_debug_flag
}
}

PLMLossTrace instproc log-loss {} {
$self instvar plm_
$plm_ log-loss
}


PLMLossTrace instproc log-PP {} {
$self instvar plm_ PP_first measure next_pkt debug_
global PP_burst_length packetSize

if {[$self set flag_PP_] == 128} {
set measure 1
set next_pkt [expr [$self set seqno_] + 1]
set PP_first [$self set packet_time_PP_]
if {$debug_>=2} {
trace_annotate "[$plm_ node]:  first PP [$self set seqno_], next: $next_pkt"
} 	
} elseif {$measure>-1} {
if {[$self set seqno_]==$next_pkt} {
set measure [expr $measure + 1]
set next_pkt [expr [$self set seqno_] + 1]	
if {$debug_>=2} {
trace_annotate "[$plm_ node]:   pending measurement : $measure, next $next_pkt"
}
if {$measure==$PP_burst_length} {
set PP_value [expr $packetSize*8.*($PP_burst_length - 1)/([$self set packet_time_PP_] - $PP_first)]
set measure -1
if {$debug_>=2} {
trace_annotate "[$plm_ node]:  measure : $PP_value"
}
$plm_ make_estimate $PP_value
} 
} else {
if {$debug_>=2} {
trace_annotate "[$plm_ node]:  out of sequence : [$self set seqno_], next: $next_pkt"
}
set measure -1
}
}
}




Class PLMLayer/ns -superclass PLMLayer

PLMLayer/ns instproc init {ns plm addr layerNo} {
$self next $plm

$self instvar ns_ addr_ mon_
set ns_ $ns
set addr_ $addr
set mon_ [$ns_ PLMcreate-agent [$plm node] PLMLossTrace 0]
$mon_ set layerNo $layerNo
$mon_ set plm_ $plm
$mon_ set dst_addr_ $addr
$mon_ set dst_port_ 0
}

PLMLayer/ns instproc join-group {} {
$self instvar mon_ plm_ addr_
$mon_ clear
[$plm_ node] join-group $mon_ $addr_
$self next
}

PLMLayer/ns instproc leave-group {} {
$self instvar mon_ plm_ addr_
[$plm_ node] leave-group $mon_ $addr_
$self next
}

PLMLayer/ns instproc npkts {} {
$self instvar mon_
return [$mon_ set npkts_]
}

PLMLayer/ns instproc nlost {} {
$self instvar mon_
return [$mon_ set nlost_]
}

PLMLayer/ns instproc mon {} {
$self instvar mon_
return $mon_
}

Class PLM/ns -superclass PLM

PLM/ns instproc init {ns localNode addrs check_estimate nn} {
$self instvar ns_ node_ addrs_
set ns_ $ns
set node_ $localNode
set addrs_ $addrs

$self next [llength $addrs] $check_estimate $nn
}

PLM/ns instproc create-layer {layerNo} {
$self instvar ns_ addrs_
return [new PLMLayer/ns $ns_ $self [lindex $addrs_ $layerNo] $layerNo]
}

PLM/ns instproc now {} {
$self instvar ns_
return [$ns_ now]
}





PLM/ns instproc node {} {
$self instvar node_
return $node_
}

PLM/ns instproc debug { msg } {
$self instvar debug_ ns_
if {$debug_ <1} { return }

$self instvar subscription_ node_
set time [format %.05f [$ns_ now]]
}

PLM/ns instproc trace { trace } {
$self instvar layers_
foreach s $layers_ {
[$s mon] trace $trace
}
}


PLM/ns instproc total_bytes_delivered {} {
$self instvar layers_
set v 0
foreach s $layers_ {
incr v [[$s mon] set bytes]
}
return $v
}



Simulator instproc PLMcreate-agent { node type pktClass } {
$self instvar Agents PortID 
set agent [new $type]
$agent set fid_ $pktClass
$self attach-agent $node $agent
$agent proc get var {
return [$self set $var]
}
return $agent
}


Simulator instproc PLMcbr_flow_PP { node fid addr bw } {
global packetSize PP_burst_length
set agent [$self PLMcreate-agent $node Agent/UDP $fid]
set cbr [new Application/Traffic/CBR_PP]
$cbr attach-agent $agent

$agent set dst_addr_ $addr
$agent set dst_port_ 0

$cbr set packet_size_ $packetSize
$cbr set rate_ $bw
$cbr set random_ 1
$cbr set PBM_ $PP_burst_length
return $cbr
}



Simulator instproc PLMbuild_source_set { plmName rates addrs baseClass node when } {
global src_plm src_rate
set n [llength $rates]
set r [lindex $rates 0]
set addr [expr [lindex $addrs 0]]
set src_rate($addr) $r
set k $plmName:0
set src_plm($k) [$self PLMcbr_flow_PP $node $baseClass $addr $r]
$self at 0 "$src_plm($k) set maxpkts_ 1; $src_plm($k) start"
$self at $when "$src_plm($k) set maxpkts_ 268435456; $src_plm($k) start"

for {set i 1} {$i<$n} {incr i} {
set r [lindex $rates $i]
set addr [expr [lindex $addrs $i]]

set src_rate($addr) $r
set k $plmName:$i
set src_plm($k) [$self PLMcbr_flow_PP $node $baseClass $addr $r]
$self at 0 "$src_plm($k) set maxpkts_ 1; $src_plm($k) start"
$self at $when "$src_plm($k) set maxpkts_ 268435456; $src_plm($k) start"
}

}

Class PLMTopology

PLMTopology instproc init { simulator } {
$self instvar ns id
set ns $simulator
set id 0
}

PLMTopology instproc mknode nn {
$self instvar node ns
if ![info exists node($nn)] {
set node($nn) [$ns node]
}
}


PLMTopology instproc build_link { a b delay bw } {
global buffers packetSize Queue_sched_
if { $a == $b } {
puts stderr "link from $a to $b?"
exit 1
}
$self instvar node ns
$self mknode $a
$self mknode $b
$ns duplex-link $node($a) $node($b) $bw $delay $Queue_sched_
}

PLMTopology instproc build_link-simple { a b delay bw f} {
global buffers packetSize Queue_sched_ 
if { $a == $b } {
puts stderr "link from $a to $b?"
exit 1
}
$self instvar node ns
$self mknode $a
$self mknode $b
$ns duplex-link-trace $node($a) $node($b) $bw $delay $Queue_sched_ $f
}



PLMTopology instproc place_source { nn when } {
global rates 
$self instvar node ns id addrs

incr id
set addrs($id) {}
foreach r $rates {
lappend addrs($id) [Node allocaddr]
}

$ns PLMbuild_source_set s$id $rates $addrs($id) $id $node($nn) $when

return $id
}

PLMTopology instproc place_receiver { nn id when check_estimate {nb 1}} {
$self instvar ns  
$ns at $when "$self build_receiver $nn $id $check_estimate $nb"
}

PLMTopology instproc build_receiver { nn id check_estimate nb} {
$self instvar node ns addrs
global PLMrcvr
set PLMrcvr($nb) [new PLM/ns $ns $node($nn) $addrs($id) $check_estimate $nn]

global plm_debug_flag
$PLMrcvr($nb) set debug_ $plm_debug_flag
}





Simulator instproc mpls-node args {
$self node-config -MPLS ON
set n [$self node]
$self node-config -MPLS OFF
return $n
}

Simulator instproc LDP-peer { src dst } {
if { ![$src is-neighbor $dst] } {
return
}
set ldpsrc [$src make-ldp]
set ldpdst [$dst make-ldp]
$ldpsrc set peer_node_ [$dst id]
$ldpdst set peer_node_ [$src id]
$self connect $ldpsrc $ldpdst
}

Simulator instproc ldp-notification-color {color} {
$self color 101 $color
}

Simulator instproc ldp-request-color {color} {
$self color 102 $color
}

Simulator instproc ldp-mapping-color {color} {
$self color 103 $color
}

Simulator instproc ldp-withdraw-color {color} {
$self color 104 $color
}

Simulator instproc ldp-release-color {color} {
$self color 105 $color
}





Node instproc mk-default-classifierMPLS {} {
$self instvar linked_ldpagents_ in_label_range_ out_label_range_
set linked_ldpagents_ ""
set in_label_range_  0
set out_label_range_ 1000

$self instvar address_ classifier_ id_
set classifier_ [new Classifier/Addr/MPLS]
$classifier_ set mpls_node_ $self
set address_ $id_
}


Node instproc enable-data-driven {} {
[$self set classifier_] cmd enable-data-driven
}

Node instproc enable-control-driven {} {
[$self set classifier_] cmd enable-control-driven
}

Node instproc new-incoming-label {} {
$self instvar in_label_range_
incr in_label_range_ 
return $in_label_range_
}

Node instproc new-outgoing-label {} {
$self instvar out_label_range_
incr out_label_range_ -1
return $out_label_range_
}

Node instproc make-ldp {} {
set ldp [new Agent/LDP]
$self attach-ldp $ldp
return $ldp
}

Node instproc attach-ldp { agent } {
$self instvar linked_ldpagents_
lappend linked_ldpagents_ $agent
$self attach $agent
}

Node instproc detach-ldp { agent } {
$self instvar linked_ldpagents_
set k [lsearch -exact $linked_ldpagents_ $agent]
if { $k >= 0 } {
set linked_ldpagents_ [lreplace $linked_ldpagents_ $k $k]
}
$self detach $agent
}

Node instproc exist-fec {fec phb} {
$self instvar classifier_ 
return [$classifier_ exist-fec $fec $phb]
}

Node instproc get-incoming-iface {fec lspid} {
$self instvar classifier_ 
return [$classifier_ GetInIface $fec $lspid]
}

Node instproc get-incoming-label {fec lspid} {
$self instvar classifier_ 
return [$classifier_ GetInLabel $fec $lspid]
}

Node instproc get-outgoing-label {fec lspid} {
$self instvar classifier_ 
return [$classifier_ GetOutLabel $fec $lspid]
}

Node instproc get-outgoing-iface {fec lspid} {
$self instvar classifier_ 
return [$classifier_ GetOutIface $fec $lspid]
}

Node instproc get-fec-for-lspid {lspid} {
$self instvar classifier_ 
return [$classifier_ get-fec-for-lspid $lspid]
}

Node instproc in-label-install {fec lspid iface label} {
$self instvar classifier_
set dontcare [Classifier/Addr/MPLS dont-care]
$self label-install $fec $lspid $iface $label $dontcare $dontcare
}

Node instproc out-label-install {fec lspid iface label} {
$self instvar classifier_
set dontcare [Classifier/Addr/MPLS dont-care]
$self label-install $fec $lspid $dontcare $dontcare $iface $label
}

Node instproc in-label-clear {fec lspid} {
$self instvar classifier_ 
set dontcare [Classifier/Addr/MPLS dont-care]
$self label-clear $fec $lspid -1 -1 $dontcare $dontcare
}

Node instproc out-label-clear {fec lspid} {
$self instvar classifier_ 
set dontcare [Classifier/Addr/MPLS dont-care]
$self label-clear $fec $lspid $dontcare $dontcare -1 -1
}

Node instproc label-install {fec lspid iif ilbl oif olbl} {
$self instvar classifier_ 
$classifier_ LSPsetup $fec $lspid $iif $ilbl $oif $olbl
}

Node instproc label-clear {fec lspid iif ilbl oif olbl} {
$self instvar classifier_ 
$classifier_ LSPrelease $fec $lspid $iif $ilbl $oif $olbl
}

Node instproc flow-erlsp-install {fec phb lspid} {
$self instvar classifier_ 
$classifier_ ErLspBinding $fec $phb $lspid
}

Node instproc erlsp-stacking {erlspid tunnelid} {
$self instvar classifier_ 
$classifier_ ErLspStacking -1 $erlspid -1 $tunnelid
}

Node instproc flow-aggregation {fineFec finePhb coarseFec coarsePhb} {
$self instvar classifier_ 
$classifier_ FlowAggregation $fineFec $finePhb $coarseFec $coarsePhb
}

Node instproc enable-reroute {option} {
$self instvar classifier_ 
$classifier_ set enable_reroute_ 1
$classifier_ set reroute_option_ 0
if {$option == "drop"} {
$classifier_ set reroute_option_ 0
}
if {$option == "L3"} {
$classifier_ set reroute_option_ 1
}
if {$option == "new"} {
$classifier_ set reroute_option_ 2
}
}

Node instproc reroute-binding {fec phb lspid} {
$self instvar classifier_ 
$classifier_ aPathBinding $fec $phb -1 $lspid
}

Node instproc lookup-nexthop {node fec} {
set ns [Simulator instance]
set routingtable [$ns get-routelogic]
set nexthop [$routingtable lookup $node $fec]
return $nexthop
}

Node instproc get-nexthop {fec} {
set nodeid [$self id]
set nexthop [$self lookup-nexthop $nodeid $fec]
return $nexthop
}

Node instproc get-link-status {hop} {
if {$hop < 0} {
return "down"
}
set nexthop [$self get-nexthop $hop]
if {$nexthop == $hop} {
set status "up"
} else {
set status "down"
}
return $status
}

Node instproc is-egress-lsr { fec } {
if { [$self id] == $fec } {
return  "1"
}
set ns [Simulator instance]
set nexthopid [$self get-nexthop $fec]
if { $nexthopid < 0 } {
return "-1"
}
set nexthop [$ns set Node_($nexthopid)]
if { [$nexthop node-type] != "MPLS" } {
return  "1"
} else {
return  "-1"
}
}

Node instproc get-ldp-agents {} {
$self instvar linked_ldpagents_
return $linked_ldpagents_
}

Node instproc exist-ldp-agent { dst } {
$self instvar linked_ldpagents_
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] == $dst } {
return "1"
}
}
return "0"
}

Node instproc get-ldp-agent { dst } {
$self instvar linked_ldpagents_
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] == $dst } {
return $ldpagent
}
}
error "(non-existent ldp-agent for peer [$dst id] on node [$self id])  --- in Node::get-ldp-agent{}"
}

Node instproc ldp-trigger-by-routing-table {} {
if { [[$self set classifier_] cmd control-driven?] != 1 } {
return
}
set ns [Simulator instance]
for {set i 0} {$i < [$ns array size Node_]} {incr i} {
set host [$ns get-node-by-id $i]
if { [$self is-egress-lsr [$host id]] == 1 } {
$self ldp-trigger-by-control [$host id] *
}
}
}

Node instproc ldp-trigger-by-control {fec pathvec} {
$self instvar linked_ldpagents_
lappend pathvec [$self id]
set inlabel [$self get-incoming-label $fec -1]
set nexthop [$self get-nexthop $fec]
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] != $nexthop } {
if { $inlabel == -1 } {
if { [$self is-egress-lsr $fec] == 1 } {
set inlabel 0
} else {
set inlabel [$self new-incoming-label]
$self in-label-install $fec -1 -1 $inlabel
}
}
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $inlabel $pathvec -1
}
}   
}

Node instproc ldp-trigger-by-data {reqmsgid src fec pathvec} {
$self instvar linked_ldpagents_
if { [$self is-egress-lsr $fec] == 1 } {
return
}
set outlabel [$self get-outgoing-label $fec -1]
if { $outlabel > -1  } {
set outiface [$self get-outgoing-iface $fec -1]
if { [$self get-link-status $outiface] == "up" } {
return
}
}
lappend pathvec [$self id]      
set nexthop [$self get-nexthop $fec]
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] != $nexthop } {
continue
}
if {$reqmsgid > -1} {
set working [$ldpagent msgtbl-get-msgid $fec -1 $src]
if { $working < 0 } {
set newmsgid [$ldpagent new-msgid]
$ldpagent msgtbl-install $newmsgid $fec -1  $src $reqmsgid
$ldpagent send-request-msg $fec $pathvec
} else {
}
} else {
if {$fec == $nexthop} {
set outlabel 0
} else {
set outlabel [$self new-outgoing-label]
}
$self out-label-install $fec -1 $nexthop $outlabel
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $outlabel $pathvec -1
}
return
}
}

Node instproc make-explicit-route {fec er lspid rc} {
$self ldp-trigger-by-explicit-route -1 [$self id] $fec "*" $er $lspid $rc
}

Node instproc ldp-trigger-by-explicit-route {reqmsgid src fec pathvec  er lspid rc} {
$self instvar linked_ldpagents_ classifier_
set outlabel [$self get-outgoing-label $fec $lspid]
if { $outlabel > -1 } {
return
}
if { [$self id] != $src && [$self id] == $fec } {
set ldpagent [$self get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec 0 $lspid $reqmsgid
return
}
lappend pathvec [$self id]
set er [split $er "_"]
set erlen [llength $er]
for {set i 0} {$i <= $erlen} {incr i 1} {
if { $i != $erlen } {
set erhop [lindex $er $i]
} else {
set erhop $fec
}
set stackERhop -1
if { $erhop >= [Classifier/Addr/MPLS minimum-lspid] } {
set lspidFEC [$self get-fec-for-lspid $erhop]
set inlabel  [$self get-incoming-label -1 $erhop]
set outlabel [$self get-outgoing-label -1 $erhop]
if { $lspidFEC == $fec } {
if { $outlabel <= -1 } {
continue
}
if { $inlabel < 0 } {
set inlabel [$self new-incoming-label]
$self in-label-install -1 $erhop  $src $inlabel
}
set ldpagent [$self get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec $inlabel  $lspid $reqmsgid
return
}
set existExplicitPeer [$self exist-ldp-agent $lspidFEC]
if { $outlabel > -1 && $existExplicitPeer == "1" } {
set stackERhop $erhop 
set erhop $lspidFEC
} elseif { $outlabel > -1 && $existExplicitPeer == "0" } {
set nexthop [$self get-outgoing-iface -1  $erhop]
set iiface  [$self get-incoming-iface -1  $erhop]
set ldpagent [$self get-ldp-agent $nexthop]
set working [$ldpagent msgtbl-get-msgid $fec  $lspid $src]
if { $working < 0 } {
set newmsgid [$ldpagent new-msgid]
$ldpagent msgtbl-install $newmsgid  $fec $lspid $src $reqmsgid
if {($iiface == $src) &&  ($inlabel > -1) } {
$ldpagent msgtbl-set-labelpass $newmsgid
} else {
$ldpagent msgtbl-set-labelstack $newmsgid $erhop
}
$ldpagent send-cr-request-msg $fec  $pathvec $er $lspid $rc
}
return
} else {
continue
}
}
if { [lsearch $pathvec $erhop] < 0 } {
set nexthop [$self get-nexthop $erhop]
if { [$self is-egress-lsr $nexthop] == 1 } {
set ldpagent [$self get-ldp-agent $src]
if { $erhop == $fec } {
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec 0  $lspid $reqmsgid
} else {
$ldpagent new-msgid
$ldpagent send-notification-msg  "NoRoute" $lspid
}
} else {
set ldpagent [$self get-ldp-agent $nexthop]
set working [$ldpagent msgtbl-get-msgid $fec  $lspid $src]
if { $working < 0 } {
set newmsgid [$ldpagent new-msgid]
set id [$ldpagent msgtbl-install  $newmsgid $fec  $lspid $src $reqmsgid]
if { $stackERhop > -1 } {
$ldpagent msgtbl-set-labelstack $newmsgid $stackERhop
}
$ldpagent send-cr-request-msg $fec $pathvec $er $lspid $rc
}
} 
return
}
}
set ldpagent [$self get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-notification-msg "NoRoute" $lspid
}

Node instproc ldp-trigger-by-withdraw {fec lspid} {
$self instvar linked_ldpagents_ 

set inlabel  [$self get-incoming-label $fec $lspid]
set iniface  [$self get-incoming-iface $fec $lspid]

$self in-label-clear $fec $lspid

if {$iniface > -1} {
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] == $iniface } {
$ldpagent new-msgid
$ldpagent send-withdraw-msg $fec $lspid
}
}
} else {
set nexthop [$self get-nexthop $fec]
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] == $nexthop } {
continue
}
$ldpagent new-msgid
$ldpagent send-withdraw-msg $fec $lspid
}
}   
}

Node instproc ldp-trigger-by-release {fec lspid} {
$self instvar linked_ldpagents_ 
set outlabel  [$self get-outgoing-label $fec $lspid]
if {$outlabel < 0} {
return
}
set nexthop [$self get-outgoing-iface $fec $lspid]
$self out-label-clear $fec $lspid 
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
if { [$ldpagent peer-ldpnode] == $nexthop } {
$ldpagent new-msgid
$ldpagent send-release-msg $fec $lspid
}
}   
}


Node instproc trace-mpls {} {
$self instvar classifier_ 
$classifier_ set trace_mpls_ 1
}

Node instproc trace-ldp {} {
$self instvar linked_ldpagents_
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
$ldpagent set trace_ldp_ 1
}
}

Node instproc trace-msgtbl {} {
$self instvar linked_ldpagents_
puts "[$self id] : message-table"
for {set i 0} {$i < [llength $linked_ldpagents_]} {incr i 1} {
set ldpagent [lindex $linked_ldpagents_ $i]
$ldpagent msgtbl-dump
}
}

Node instproc pft-dump {} {
$self instvar classifier_ 

set nodeid [$self id]
$classifier_ PFTdump $nodeid
}

Node instproc erb-dump {} {
$self instvar classifier_ 

set nodeid [$self id]
$classifier_ ERBdump $nodeid
}

Node instproc lib-dump {} {
$self instvar classifier_ 

set nodeid [$self id]
$classifier_ LIBdump $nodeid
}



Agent/LDP instproc init {args} {
$self set peer_node_ 0
eval $self next $args
}

Agent/LDP instproc new-msgid {} {
$self instvar new_msgid_
return [incr new_msgid_]
}

Agent/LDP instproc peer-ldpnode {} {
$self instvar peer_node_
return [$self set peer_node_]
}

Agent/LDP instproc send-notification-msg {status lspid} {
$self set fid_ 101
$self cmd notification-msg $status $lspid
}

Agent/LDP instproc send-request-msg {fec pathvec} {
$self set fid_ 102
$self request-msg $fec $pathvec
}

Agent/LDP instproc send-mapping-msg {fec label pathvec reqmsgid} {
$self set fid_ 103
$self cmd mapping-msg $fec $label $pathvec $reqmsgid
}

Agent/LDP instproc send-withdraw-msg {fec lspid} {
$self set fid_ 104
$self withdraw-msg $fec $lspid
}

Agent/LDP instproc send-release-msg {fec lspid} {
$self set fid_ 105
$self release-msg $fec $lspid
}

Agent/LDP instproc send-cr-request-msg {fec pathvec er lspid rc} {
$self set fid_ 102
$self cr-request-msg $fec $pathvec $er $lspid $rc
}

Agent/LDP instproc send-cr-mapping-msg {fec inlabel lspid prvmsgid} {
$self set fid_ 103
$self cr-mapping-msg $fec $inlabel $lspid $prvmsgid
}

Agent/LDP instproc get-request-msg {msgid src fec pathvec} {
$self instvar node_

set pathvec [split $pathvec "_"]
if {[lsearch $pathvec [$node_ id]] > -1} {
set ldpagent [$node_ get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-notification-msg "LoopDetected" -1           

return
}

set nexthop [$node_ get-nexthop $fec]
if {$src == $nexthop} {
$self request-msg-from-downstream $msgid $src $fec $pathvec
} else {
$self request-msg-from-upstream $msgid $src $fec $pathvec
}
}

Agent/LDP instproc request-msg-from-downstream {msgid src fec pathvec} {
$self instvar node_

set outlabel [$node_ get-outgoing-label $fec -1]
if { $outlabel < 0 } {
if { $fec == $src } {
set outlabel 0
} else {
set outlabel [$node_ new-outgoing-label]
}     
$node_ out-label-install $fec -1 $src $outlabel             
} else {
set outIface [$node_ get-outgoing-iface $fec -1]
if { $src != $outIface} {
$node_ out-label-install $fec -1 $src $outlabel
} 
}

set ldpagent [$node_ get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $outlabel "*" $msgid

$node_ ldp-trigger-by-control $fec $pathvec
}

Agent/LDP instproc request-msg-from-upstream {msgid src fec pathvec} {
$self instvar node_

set ldpagent [$node_ get-ldp-agent $src]

if { [$node_ is-egress-lsr $fec] == 1 } {
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec 0 "*" $msgid
return
}

set inlabel  [$node_ get-incoming-label $fec -1]
set outlabel [$node_ get-outgoing-label $fec -1]
if { [Classifier/Addr/MPLS ordered-control?] == 1 } {
if { $outlabel > -1 } {
if { $inlabel < 0 } {
set inlabel [$node_ new-incoming-label]
}
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec inlabel "*" $msgid
} else {
$node_ ldp-trigger-by-data $msgid $src $fec $pathvec
}
return
}
if { $inlabel < 0 } {
set inlabel [$node_ new-incoming-label]
$node_ in-label-install $fec -1 $src $inlabel
} else {
set inIface [$node_ get-incoming-iface $fec -1]
if { $src != $inIface} {
set classifier [$node_ set classifier_]
set dontcare [$classifier set dont_care_]
$node_ in-label-install $fec -1 -1 $dontcare
} 
}
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $inlabel "*" $msgid
$node_ ldp-trigger-by-data $msgid $src $fec $pathvec
}

Agent/LDP instproc get-cr-request-msg {msgid src fec pathvec er lspid rc} {
$self instvar node_

set pathvec [split $pathvec "_"]
if {[lsearch $pathvec [$node_ id]] > -1} {
set ldpagent [$node_ get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-notification-msg "NoRoute" $lspid
return
}


set ldpagent [$node_ get-ldp-agent $src]

set inlabel [$node_ get-incoming-label $fec $lspid]
set outlabel [$node_ get-outgoing-label $fec $lspid]

if { $outlabel > -1 } {
if { $inlabel < 0 } {
set inlabel [$node_ new-incoming-label]
$node_ in-label-install $fec $lspid $src $inlabel
}
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec $inlabel $lspid $msgid
return
}

$node_ ldp-trigger-by-explicit-route $msgid $src $fec $pathvec $er $lspid $rc
}

Agent/LDP instproc get-cr-mapping-msg {msgid src fec label lspid reqmsgid} {
$self instvar node_ trace_ldp_


set prvsrc   [$self msgtbl-get-src       $reqmsgid]
set prvmsgid [$self msgtbl-get-reqmsgid  $reqmsgid]
set labelop  [$self msgtbl-get-labelop   $reqmsgid]
if {$labelop == 2} {
set tunnelid [$self msgtbl-get-erlspid   $reqmsgid]
} else {
set tunnelid -1
}

$self msgtbl-clear $reqmsgid

if { $trace_ldp_ } {
puts "$src -> [$node_ id] : prvsrc($prvsrc)"
}

if { $labelop == 2 } {
$node_ out-label-install $fec $lspid $src $label
$node_ erlsp-stacking $lspid $tunnelid
} elseif {$labelop == 1} {
set ldpagent [$node_ get-ldp-agent $prvsrc]
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec $label $lspid $prvmsgid
return
} else {
$node_ out-label-install $fec $lspid  $src $label
}

if {$prvsrc == [$node_ id]} {
return
}

set inlabel [$node_ new-incoming-label]
$node_ in-label-install $fec $lspid $prvsrc $inlabel

set ldpagent [$node_ get-ldp-agent $prvsrc]
$ldpagent new-msgid
$ldpagent send-cr-mapping-msg $fec $inlabel $lspid $prvmsgid
}

Agent/LDP instproc get-mapping-msg {msgid src fec label pathvec reqmsgid} {
$self instvar node_ trace_ldp_

if { $trace_ldp_ } {
puts "[[Simulator instance] now]: <mapping-msg> $src -> [$node_ id] : fec($fec), label($label) [$node_ get-nexthop $fec]"
}

set pathvec [split $pathvec "_"]
if {[lsearch $pathvec [$node_ id]] > -1} {
set ldpagent [$node_ get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-notification-msg "LoopDetected" -1           
return
}

set nexthop [$node_ get-nexthop $fec]
if {$src == $nexthop} {
$self mapping-msg-from-downstream $msgid $src $fec $label  $pathvec $reqmsgid
} else {
$self mapping-msg-from-upstream $msgid $src $fec $label  $pathvec $reqmsgid
}
}

Agent/LDP instproc mapping-msg-from-downstream {msgid src fec label  pathvec reqmsgid} {
$self instvar node_

$node_ out-label-install $fec -1 $src $label
if { $reqmsgid > -1 } {

set prvsrc   [$self msgtbl-get-src      $reqmsgid]
set prvmsgid [$self msgtbl-get-reqmsgid $reqmsgid]
$self msgtbl-clear $reqmsgid
if { $prvsrc == [$node_ id] || $prvsrc < 0} {
return
}
if { [Classifier/Addr/MPLS ordered-control?] == 1 } {

set inlabel [$node_ new-incoming-label]
$node_ in-label-install $fec -1 $prvsrc $inlabel
set ldpagent [$node_ get-ldp-agent $prvsrc]
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $inlabel -1 $prvmsgid
return
}
} else {
$node_ ldp-trigger-by-control $fec $pathvec
return
}
}

Agent/LDP instproc mapping-msg-from-upstream {msgid src fec label pathvec  reqmsgid} {
$self instvar node_

set nexthop [$node_ lookup-nexthop $src $fec]
if { $nexthop != [$node_ id] } {
return
}

set inlabel [$node_ get-incoming-label $fec -1]
if { $inlabel == -1 } {
if { [$node_ is-egress-lsr $fec] == 1 } {
if { $label != 0 } {
set ldpagent [$node_ get-ldp-agent $src]
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec 0 "*" $msgid
}
} else {
$node_ in-label-install $fec -1 $src $label
}
} else {
set ldpagent [$node_ get-ldp-agent $src]
if { $reqmsgid < 0 } {
$ldpagent new-msgid
$ldpagent send-mapping-msg $fec $inlabel "*" $msgid
}   
}    
if { $reqmsgid < 0 } {
$node_ ldp-trigger-by-data -1 $src $fec $pathvec
} else {   
$self msgtbl-clear $reqmsgid
}    
}

Agent/LDP instproc get-notification-msg {src status lspid} {
$self instvar node_ trace_ldp_

if { $trace_ldp_ } {
puts "Notification($src->[$node_ id]): $status src=$src lspid=$lspid"
}
set msgid [$self msgtbl-get-msgid -1 $lspid -1]
if {$msgid > -1} {
set prvsrc   [$self msgtbl-get-src      $msgid]
$self msgtbl-clear $msgid            
if { $prvsrc < -1 || $prvsrc == [$node_ id] } {
return
}
set ldpagent [$node_ get-ldp-agent $prvsrc]
$ldpagent new-msgid
$ldpagent send-notification-msg $status $lspid
}
}

Agent/LDP instproc get-withdraw-msg {src fec lspid} {
$self instvar node_

set outiface  [$node_ get-outgoing-iface $fec $lspid]
if {$src == $outiface} {
$node_ out-label-clear $fec $lspid
set inlabel [$node_ get-incoming-label $fec $lspid]
if {$inlabel > -1} {
$node_ ldp-trigger-by-withdraw $fec $lspid
}
}
}

Agent/LDP instproc get-release-msg {src fec lspid} {
$self instvar node_

set iniface  [$node_ get-incoming-iface $fec $lspid]
set outlabel [$node_ get-outgoing-label $fec $lspid]
if {$iniface == $src} {
$node_ in-label-clear $fec $lspid 
if {$outlabel > -1} {
$node_ ldp-trigger-by-release $fec $lspid
}
} 
}

Agent/LDP instproc trace-ldp-packet {src_addr src_port msgtype msgid fec  label pathvec lspid er rc reqmsgid status atime} {
$self instvar node_
puts "$atime [$node_ id]: $src_addr ($msgtype $msgid) $fec $label $pathvec  \[$reqmsgid $status\]  \[$lspid $er $rc\]"
}




Classifier/Addr/MPLS instproc init {args} {
eval $self next $args
$self instvar mpls_node_
$self instvar rtable_

set mpls_node_ ""
set rtable_ ""
}

Classifier/Addr/MPLS instproc no-slot args {
}


Classifier/Addr/MPLS instproc trace-packet-switching { time src dst ptype  ilabel op oiface olabel ttl psize } {
$self instvar mpls_node_ 
puts "$time [$mpls_node_ id]($src->$dst): $ptype $ilabel $op $oiface $olabel $ttl $psize"
}


Classifier/Addr/MPLS instproc ldp-trigger-by-switch { fec } {
$self instvar mpls_node_
if { [Classifier/Addr/MPLS on-demand?] == 1 } {
set msgid  1
} else {
set msgid -1
}
$mpls_node_ ldp-trigger-by-data $msgid [$mpls_node_ id] $fec *
}

Classifier/Addr/MPLS instproc rtable-ready { fec } {
$self instvar rtable_
set ns [Simulator instance]
if { [lsearch $rtable_ $fec] == -1 } {
lappend rtable_ $fec
}
set rtlen [llength $rtable_]
set nodelen [$ns array size Node_]
if { $rtlen == $nodelen } {
return 1
} else {
return 0
}
}

Classifier/Addr/MPLS instproc routing-new { slot time } {
$self instvar mpls_node_ rtable_
if { [$self control-driven?] != 1 } {
return
}
if { [lsearch $rtable_ [$mpls_node_ id]] == -1 } {
lappend rtable_ [$mpls_node_ id]
}
if { [$self rtable-ready $slot] == 1 } {
set rtlen   [llength $rtable_]
for {set i 0} {$i < $rtlen} {incr i 1} {
set nodeid [lindex $rtable_ $i]
if { [$mpls_node_ get-nexthop $nodeid] == -1 } {
set rtable_ "" 
return
}
}
set rtable_ "" 
[Simulator instance] at [expr $time]  "$mpls_node_ ldp-trigger-by-routing-table"
}
}

Classifier/Addr/MPLS instproc routing-nochange {slot time} {
$self instvar mpls_node_ rtable_

if { [$self control-driven?] != 1 } {
return
}
if { [lsearch $rtable_ [$mpls_node_ id]] == -1 } {
lappend rtable_ [$mpls_node_ id]
}
if { [$self rtable-ready $slot] == 1 } {
set rtable_ "" 
[Simulator instance] at $time  "$mpls_node_ ldp-trigger-by-routing-table"
}
}

Classifier/Addr/MPLS instproc routing-update {slot time} {
$self instvar mpls_node_ rtable_
if {[$self control-driven?] != 1} {
return
}
set fec $slot
set pft_outif [$mpls_node_ get-outgoing-iface $fec -1]
set rt_outif  [$mpls_node_ get-nexthop $fec]
if { $pft_outif == -1 || $rt_outif == -1 } {
return
}
$mpls_node_ ldp-trigger-by-control $fec *
return
}






set tcl_precision 17

Connector set debug_ false
TTLChecker set debug_ false

Trace set src_ -1
Trace set dst_ -1
Trace set callback_ 0
Trace set show_tcphdr_ 0
Trace set debug_ false

CMUTrace set debug_ false

Scheduler/RealTime set maxslop_ 0.010; # max allowed slop b4 error (sec)

Integrator set lastx_ 0.0
Integrator set lasty_ 0.0
Integrator set sum_ 0.0

Queue set limit_ 50
Queue set blocked_ false
Queue set unblock_on_resume_ true

Queue set interleave_ false
Queue set acksfirst_ false
Queue set ackfromfront_ false
Queue set debug_ false

Queue/SFQ set maxqueue_ 40
Queue/SFQ set buckets_ 16

Queue/FQ set secsPerByte_ 0
FQLink set queueManagement_ DropTail

Queue/DropTail set drop_front_ false

Queue/DropTail/PriQueue set Prefer_Routing_Protocols    1

Queue/RED set bytes_ false
Queue/RED set queue_in_bytes_ false
Queue/RED set thresh_ 5
Queue/RED set maxthresh_ 15
Queue/RED set mean_pktsize_ 500
Queue/RED set q_weight_ 0.002
Queue/RED set wait_ true
Queue/RED set linterm_ 10
Queue/RED set setbit_ false
Queue/RED set gentle_ false
Queue/RED set drop_tail_ true
Queue/RED set drop_front_ false
Queue/RED set drop_rand_ false
Queue/RED set doubleq_ false
Queue/RED set ns1_compat_ false
Queue/RED set dqthresh_ 50
Queue/RED set ave_ 0.0
Queue/RED set prob1_ 0.0
Queue/RED set curq_ 0

Queue/RED/RIO set bytes_ false
Queue/RED/RIO set queue_in_bytes_ false
Queue/RED/RIO set thresh_ 5
Queue/RED/RIO set maxthresh_ 15
Queue/RED/RIO set in_thresh_ 15
Queue/RED/RIO set in_maxthresh_ 30
Queue/RED/RIO set out_thresh_ 5
Queue/RED/RIO set out_maxthresh_ 15
Queue/RED/RIO set mean_pktsize_ 500
Queue/RED/RIO set q_weight_ 0.002
Queue/RED/RIO set wait_ true
Queue/RED/RIO set linterm_ 10
Queue/RED/RIO set in_linterm_ 50
Queue/RED/RIO set out_linterm_ 5
Queue/RED/RIO set setbit_ false
Queue/RED/RIO set gentle_ false
Queue/RED/RIO set in_gentle_ false
Queue/RED/RIO set out_gentle_ false
Queue/RED/RIO set drop_tail_ true
Queue/RED/RIO set drop_front_ false
Queue/RED/RIO set drop_rand_ false
Queue/RED/RIO set doubleq_ false
Queue/RED/RIO set ns1_compat_ false
Queue/RED/RIO set dqthresh_ 50
Queue/RED/RIO set ave_ 0.0
Queue/RED/RIO set in_ave_ 0.0
Queue/RED/RIO set out_ave_ 0.0
Queue/RED/RIO set prob1_ 0.0
Queue/RED/RIO set in_prob1_ 0.0
Queue/RED/RIO set out_prob1_ 0.0
Queue/RED/RIO set curq_ 0
Queue/RED/RIO set priority_method_ 0

Queue/DRR set buckets_ 10
Queue/DRR set blimit_ 25000
Queue/DRR set quantum_ 250
Queue/DRR set mask_ 0

Queue/CBQ set algorithm_ 0 ;# used by compat only, not bound
Queue/CBQ set maxpkt_ 1024
CBQClass set priority_ 0
CBQClass set level_ 1
CBQClass set extradelay_ 0.0
CBQClass set def_qtype_ DropTail
CBQClass set okborrow_ true
CBQClass set automaxidle_gain_ 0.9375
CBQClass set debug_ false

SnoopQueue/In set debug_ false
SnoopQueue/Out set debug_ false
SnoopQueue/Drop set debug_ false
SnoopQueue/EDrop set debug_ false
SnoopQueue/Tagger set debug_ false

PacketQueue/Semantic set acksfirst_ false
PacketQueue/Semantic set filteracks_ false
PacketQueue/Semantic set replace_head_ false
PacketQueue/Semantic set priority_drop_ false
PacketQueue/Semantic set random_drop_ false
PacketQueue/Semantic set reconsAcks_ false
PacketQueue/Semantic set random_ecn_ false

QueueMonitor set size_ 0
QueueMonitor set pkts_ 0
QueueMonitor set parrivals_ 0
QueueMonitor set barrivals_ 0
QueueMonitor set pdepartures_ 0
QueueMonitor set bdepartures_ 0
QueueMonitor set pdrops_ 0
QueueMonitor set bdrops_ 0
QueueMonitor/ED set epdrops_ 0
QueueMonitor/ED set ebdrops_ 0
QueueMonitor/ED/Flowmon set enable_in_ true
QueueMonitor/ED/Flowmon set enable_out_ true
QueueMonitor/ED/Flowmon set enable_drop_ true
QueueMonitor/ED/Flowmon set enable_edrop_ true
QueueMonitor/ED/Flow set src_ -1
QueueMonitor/ED/Flow set dst_ -1
QueueMonitor/ED/Flow set flowid_ -1
QueueMonitor/ED/Flow/TB set target_rate_ 128000 
QueueMonitor/ED/Flow/TB set bucket_depth_ 10000
QueueMonitor/ED/Flow/TB set tbucket_ 10000
QueueMonitor/ED/Flow/TSW set target_rate_ 0
QueueMonitor/ED/Flow/TSW set win_len_ 10
QueueMonitor/ED/Flow/TSW set wait_ true

DelayLink set bandwidth_ 1.5Mb
DelayLink set delay_ 100ms
DelayLink set debug_ false

DynamicLink set status_ 1
DynamicLink set debug_ false

Filter set debug_ false
Filter/Field set offset_ 0
Filter/Field set match_  -1

Classifier set offset_ 0
Classifier set shift_ 0
Classifier set mask_ 0xffffffff
Classifier set debug_ false

Classifier/Hash set default_ -1; # none
Classifier/Replicator set ignore_ 0

Classifier/Addr/MPLS set ttl_   32
Classifier/Addr/MPLS set trace_mpls_ 0
Classifier/Addr/MPLS set label_ -1
Classifier/Addr/MPLS set enable_reroute_    0
Classifier/Addr/MPLS set reroute_option_ 0
Classifier/Addr/MPLS set control_driven_ 0
Classifier/Addr/MPLS set data_driven_ 0


ErrorModule set debug_ false

ErrorModel set enable_ 1
ErrorModel set markecn_ false
ErrorModel set rate_ 0
ErrorModel set bandwidth_ 2Mb
ErrorModel set debug_ false

ErrorModel/Trace set good_ 123456789
ErrorModel/Trace set loss_ 0
ErrorModel/Periodic set period_ 1.0
ErrorModel/Periodic set offset_ 0.0
ErrorModel/Periodic set burstlen_ 0.0
ErrorModel/MultiState set curperiod_ 0.0
ErrorModel/MultiState set sttype_ pkt
ErrorModel/MultiState set texpired_ 0

SelectErrorModel set enable_ 1
SelectErrorModel set markecn_ false
SelectErrorModel set rate_ 0
SelectErrorModel set bandwidth_ 2Mb
SelectErrorModel set pkt_type_ 2
SelectErrorModel set drop_cycle_ 10
SelectErrorModel set drop_offset_ 1
SelectErrorModel set debug_ false
SRMErrorModel set enable_ 1
SRMErrorModel set markecn_ false
SRMErrorModel set rate_ 0
SRMErrorModel set bandwidth_ 2Mb
SRMErrorModel set pkt_type_ 2
SRMErrorModel set drop_cycle_ 10
SRMErrorModel set drop_offset_ 1
SRMErrorModel set debug_ false

rtModel set startTime_ 0.5
rtModel set finishTime_ "-"
rtModel/Exponential set upInterval_   10.0
rtModel/Exponential set downInterval_  1.0
rtModel/Deterministic set upInterval_   2.0
rtModel/Deterministic set downInterval_ 1.0


Application/Traffic/CBR_PP set rate_ 448Kb ;# corresponds to interval of 3.75ms
Application/Traffic/CBR_PP set packetSize_ 210
Application/Traffic/CBR_PP set random_ 0
Application/Traffic/CBR_PP set maxpkts_ 268435456; # 0x10000000
Application/Traffic/CBR_PP set PBM_ 2

Application/Traffic/Exponential set burst_time_ .5
Application/Traffic/Exponential set idle_time_ .5
Application/Traffic/Exponential set rate_ 64Kb
Application/Traffic/Exponential set packetSize_ 210

Application/Traffic/Pareto set burst_time_ 500ms
Application/Traffic/Pareto set idle_time_ 500ms
Application/Traffic/Pareto set rate_ 64Kb
Application/Traffic/Pareto set packetSize_ 210
Application/Traffic/Pareto set shape_ 1.5

Application/Traffic/CBR set rate_ 448Kb	;# corresponds to interval of 3.75ms
Application/Traffic/CBR set packetSize_ 210
Application/Traffic/CBR set random_ 0
Application/Traffic/CBR set maxpkts_ 268435456; # 0x10000000

Application/Telnet set interval_ 1.0

RandomVariable/Uniform set min_ 0.0
RandomVariable/Uniform set max_ 1.0
RandomVariable/Exponential set avg_ 1.0
RandomVariable/Pareto set avg_ 1.0
RandomVariable/Pareto set shape_ 1.5
RandomVariable/ParetoII set avg_ 10.0
RandomVariable/ParetoII set shape_ 1.2
RandomVariable/Constant set val_ 1.0
RandomVariable/HyperExponential set avg_ 1.0
RandomVariable/HyperExponential set cov_ 4.0
RandomVariable/Empirical set minCDF_ 0
RandomVariable/Empirical set maxCDF_ 1
RandomVariable/Empirical set interpolation_ 0
RandomVariable/Empirical set maxEntry_ 32
RandomVariable/Normal set avg_ 0.0
RandomVariable/Normal set std_ 1.0
RandomVariable/LogNormal set avg_ 1.0
RandomVariable/LogNormal set std_ 1.0

ADC/MS set debug_ false
ADC/HB set debug_ false
ADC/Param set debug_ false
ADC/ACTP set debug_ false
ADC/ACTO set debug_ false

Est/Null set debug_ false
Est/TimeWindow set debug_ false
Est/ExpAvg set debug_ false
Est/PointSample set debug_ false

MeasureMod set debug_ false
SALink set debug_ false


Node set multiPath_ 0
Node set rtagent_port_ 255

Node/MobileNode set X_				0
Node/MobileNode set Y_				0
Node/MobileNode set Z_				0
Node/MobileNode set speed_				0
Node/MobileNode set position_update_interval_	0
Node/MobileNode set bandwidth_			0	;# not used
Node/MobileNode set delay_				0	;# not used
Node/MobileNode set REGAGENT_PORT 0
Node/MobileNode set DECAP_PORT 1

AddrParams set ALL_BITS_SET 0xffffffff
AddrParams PortShift 0
AddrParams PortMask [AddrParams set ALL_BITS_SET]
AddrParams set domain_num_ 1
AddrParams set def_clusters 4
AddrParams set def_nodes 5

AllocAddrBits set DEFADDRSIZE_ 32
AllocAddrBits set MAXADDRSIZE_ 32                ;# leaving the signed bit

Simulator set node_factory_ Node
Simulator set nsv1flag 0
Simulator set mobile_ip_ 0			 ;# flag for mobileIP
Simulator set routingAgent_ ""
Simulator set addressType_   ""
Simulator set MovementTrace_ OFF
Simulator set IMEPFlag_ ""
Simulator set WirelessNewTrace_ 0

SessionSim set rc_ 0

Simulator set McastBaseAddr_ 0x80000000
Simulator set McastAddr_ 0x80000000

Simulator set AgentTrace_ ON
Simulator set RouterTrace_ OFF
Simulator set MacTrace_   OFF

SessionHelper set rc_ 0                      ;# just to eliminate warnings
SessionHelper set debug_ false

NetworkInterface set debug_ false



TBF set rate_ 64k
TBF set bucket_ 1024
TBF set qlen_ 0

MIPEncapsulator set addr_ 0
MIPEncapsulator set port_ 0
MIPEncapsulator set shift_ 0
MIPEncapsulator set mask_ [AddrParams set ALL_BITS_SET]
MIPEncapsulator set ttl_ 32
MIPEncapsulator set debug_ false



Mac set debug_ false
ARPTable set debug_ false
God set debug_ false

Mac/Tdma set slot_packet_len_	1500
Mac/Tdma set max_node_num_	64

LL set mindelay_                50us
LL set delay_                   25us
LL set bandwidth_               0       ;# not used
LL set debug_ false

Antenna/OmniAntenna set X_ 0
Antenna/OmniAntenna set Y_ 0
Antenna/OmniAntenna set Z_ 1.5 
Antenna/OmniAntenna set Gt_ 1.0
Antenna/OmniAntenna set Gr_ 1.0

Phy/WirelessPhy set CPThresh_ 10.0
Phy/WirelessPhy set CSThresh_ 1.559e-11
Phy/WirelessPhy set RXThresh_ 3.652e-10
Phy/WirelessPhy set bandwidth_ 2e6
Phy/WirelessPhy set Pt_ 0.28183815
Phy/WirelessPhy set freq_ 914e+6
Phy/WirelessPhy set L_ 1.0  
Phy/WirelessPhy set debug_ false

Phy/WiredPhy set bandwidth_ 10e6
Phy/WiredPhy set debug_ false
Phy/Repeater set debug_ false
LanRouter set debug_ false

Phy/Sat set debug_ false
Mac/Sat set debug_ false
LL/Sat set debug_ false

Propagation/Shadowing set pathlossExp_ 2.0
Propagation/Shadowing set std_db_ 4.0
Propagation/Shadowing set dist0_ 1.0
Propagation/Shadowing set seed_ 0


Agent set fid_ 0
Agent set prio_ 0
Agent set agent_addr_ -1
Agent set agent_port_ -1
Agent set dst_addr_ -1
Agent set dst_port_ -1
Agent set flags_ 0
Agent set ttl_ 32 ; # arbitrary choice here
Agent set debug_ false
Agent set class_ 0


Agent/Ping set packetSize_ 64

Agent/UDP set packetSize_ 1000
Agent/UDP instproc done {} { }

Agent/TCP set seqno_ 0
Agent/TCP set t_seqno_ 0
Agent/TCP set maxburst_ 0
Agent/TCP set maxcwnd_ 0
Agent/TCP set numdupacks_ 3
Agent/TCP set window_ 20
Agent/TCP set windowInit_ 1
Agent/TCP set windowInitOption_ 1
Agent/TCP set syn_ false
Agent/TCP set windowOption_ 1
Agent/TCP set windowConstant_ 4
Agent/TCP set windowThresh_ 0.002
Agent/TCP set decrease_num_ 0.5
Agent/TCP set increase_num_ 1.0
Agent/TCP set k_parameter_ 0.0 ;	# for binomial congestion control
Agent/TCP set l_parameter_ 1.0 ;  	# for binomial congestion control
Agent/TCP set overhead_ 0
Agent/TCP set ecn_ 0
Agent/TCP set old_ecn_ 0
Agent/TCP set packetSize_ 1000
Agent/TCP set tcpip_base_hdr_size_ 40
Agent/TCP set bugFix_ true
Agent/TCP set timestamps_ false
Agent/TCP set slow_start_restart_ true
Agent/TCP set restart_bugfix_ true
Agent/TCP set tcpTick_ 0.1
Agent/TCP set maxrto_ 100000
Agent/TCP set srtt_init_ 0
Agent/TCP set rttvar_init_ 12
Agent/TCP set rtxcur_init_ 6.0
Agent/TCP set T_SRTT_BITS 3
Agent/TCP set T_RTTVAR_BITS 2
Agent/TCP set rttvar_exp_ 2
Agent/TCP instproc done {} { }
Agent/TCP set noFastRetrans_ false

Agent/TCP set dupacks_ 0
Agent/TCP set ack_ 0
Agent/TCP set cwnd_ 0
Agent/TCP set awnd_ 0
Agent/TCP set ssthresh_ 0
Agent/TCP set rtt_ 0
Agent/TCP set srtt_ 0
Agent/TCP set rttvar_ 0
Agent/TCP set backoff_ 0
Agent/TCP set maxseq_ 0
Agent/TCP set singledup_ 0
Agent/TCP set precisionReduce_ false
Agent/TCP set oldCode_ false

Agent/TCP set ndatapack_ 0
Agent/TCP set ndatabytes_ 0
Agent/TCP set nackpack_ 0
Agent/TCP set nrexmit_ 0
Agent/TCP set nrexmitpack_ 0
Agent/TCP set nrexmitbytes_ 0
Agent/TCP set trace_all_oneline_ false

Agent/TCP set QOption_ 0 
Agent/TCP set EnblRTTCtr_ 0
Agent/TCP set control_increase_ 0

Agent/TCP set nam_tracevar_ false

Agent/TCP/Fack set ss-div4_ false
Agent/TCP/Fack set rampdown_ false

Agent/TCP set eln_ 0
Agent/TCP set eln_rxmit_thresh_ 1
Agent/TCP set delay_growth_ false

Agent/TCP set CoarseTimer_      0

Agent/TCPSink set sport_        0
Agent/TCPSink set dport_        0         

Agent/TCPSink set packetSize_ 40
Agent/TCPSink set maxSackBlocks_ 3
Agent/TCPSink set ts_echo_bugfix_ false
Agent/TCPSink set generateDSacks_ false
Agent/TCPSink set RFC2581_immediate_ack_ true

Agent/TCPSink/DelAck set interval_ 100ms
catch {
Agent/TCPSink/Asym set interval_ 100ms
Agent/TCPSink/Asym set maxdelack_ 5
}
Agent/TCPSink/Sack1/DelAck set interval_ 100ms

Agent/TCP/Newreno set newreno_changes_ 0
Agent/TCP/Newreno set newreno_changes1_ 0
Agent/TCP/Newreno set partial_window_deflation_ 0
Agent/TCP/Newreno set exit_recovery_fix_ 0

Agent/TCP/Vegas set v_alpha_ 1
Agent/TCP/Vegas set v_beta_ 3
Agent/TCP/Vegas set v_gamma_ 1
Agent/TCP/Vegas set v_rtt_ 0

Agent/TCP/Vegas/RBP set rbp_scale_ 0.75
Agent/TCP/Vegas/RBP set rbp_rate_algorithm_ 1
Agent/TCP/Vegas/RBP set rbp_segs_actually_paced_ 0
Agent/TCP/Vegas/RBP set rbp_inter_pace_delay_ 0

Agent/TCP/Reno/RBP set rbp_scale_ 0.75
Agent/TCP/Reno/RBP set rbp_segs_actually_paced_ 0
Agent/TCP/Reno/RBP set rbp_inter_pace_delay_ 0

Agent/TCP/Asym set g_ 0.125
Agent/TCP/Reno/Asym set g_ 0.125
Agent/TCP/Newreno/Asym set g_ 0.125

Agent/TCP/RFC793edu set add793expbackoff_  true 
Agent/TCP/RFC793edu set add793jacobsonrtt_ false
Agent/TCP/RFC793edu set add793fastrtx_     false
Agent/TCP/RFC793edu set add793slowstart_   false
Agent/TCP/RFC793edu set add793additiveinc_ false
Agent/TCP/RFC793edu set add793karnrtt_     true 
Agent/TCP/RFC793edu set rto_               60
Agent/TCP/RFC793edu set syn_               true
Agent/TCP/RFC793edu set add793exponinc_    false

Agent/TFRC set packetSize_ 1000 
Agent/TFRC set df_ 0.95 ;	# decay factor for accurate RTT estimate
Agent/TFRC set tcp_tick_ 0.1 ;	
Agent/TFRC set ndatapack_ 0 ;	# Number of packets sent
Agent/TFRC set srtt_init_ 0 ;	# Variables for tracking RTT	
Agent/TFRC set rttvar_init_ 12  
Agent/TFRC set rtxcur_init_ 6.0	
Agent/TFRC set rttvar_exp_ 2	
Agent/TFRC set T_SRTT_BITS 3	
Agent/TFRC set T_RTTVAR_BITS 2	
Agent/TFRC set InitRate_ 300 ;	# Initial send rate	
Agent/TFRC set overhead_ 0 ;	# If > 0, dither outgoing packets
Agent/TFRC set ssmult_ 2 ; 	# Rate of increase during slow-start:
Agent/TFRC set bval_ 1 ;	# Value of B for TCP formula
Agent/TFRC set ca_ 1 ; 	 	# Enable Sqrt(RTT) congestion avoidance
Agent/TFRC set printStatus_ 0 
Agent/TFRC set maxHeavyRounds_ 1; # Number of rounds for sending rate allowed
Agent/TFRC set conservative_ 0 ;  # Set to true for a conservative 

Agent/TFRCSink set packetSize_ 40
Agent/TFRCSink set InitHistorySize_ 100000
Agent/TFRCSink set NumFeedback_ 1 
Agent/TFRCSink set AdjustHistoryAfterSS_ 1
Agent/TFRCSink set NumSamples_ -1
Agent/TFRCSink set discount_ 1;	# History Discounting
Agent/TFRCSink set printLoss_ 0
Agent/TFRCSink set smooth_ 1 ;	# smoother Average Loss Interval
Agent/TFRCSink set minlc_ 4
Agent/TFRCSink set algo_ 1 ;  	# 1: algo from sigcomm paper 2: ewma 
Agent/TFRCSink set maxint_ 1000 ;     # max loss interval history 
Agent/TFRCSink set history_ 0.75 ;    # loss history for EWMA

if [TclObject is-class Agent/TCP/FullTcp] {
Agent/TCP/FullTcp set segsperack_ 1; # ACK frequency
Agent/TCP/FullTcp set segsize_ 536; # segment size
Agent/TCP/FullTcp set tcprexmtthresh_ 3; # num dupacks to enter recov
Agent/TCP/FullTcp set iss_ 0; # Initial send seq#
Agent/TCP/FullTcp set nodelay_ false; # Nagle disable?
Agent/TCP/FullTcp set data_on_syn_ false; # allow data on 1st SYN?
Agent/TCP/FullTcp set dupseg_fix_ true ; # no rexmt w/dup segs from peer
Agent/TCP/FullTcp set dupack_reset_ false; # exit recov on ack < highest
Agent/TCP/FullTcp set interval_ 0.1 ; # delayed ACK interval 100ms 
Agent/TCP/FullTcp set close_on_empty_ false; # close conn if sent all
Agent/TCP/FullTcp set ts_option_size_ 10; # in bytes
Agent/TCP/FullTcp set reno_fastrecov_ true; # fast recov true by default
Agent/TCP/FullTcp set pipectrl_ false; # use "pipe" ctrl
Agent/TCP/FullTcp set open_cwnd_on_pack_ true; # ^ win on partial acks?
Agent/TCP/FullTcp set halfclose_ false; # do simplex closes (shutdown)?

Agent/TCP/FullTcp/Newreno set recov_maxburst_ 2; # max burst dur recov

Agent/TCP/FullTcp/Sack set sack_block_size_ 8; # bytes in a SACK block
Agent/TCP/FullTcp/Sack set sack_option_size_ 2; # bytes in opt hdr
Agent/TCP/FullTcp/Sack set max_sack_blocks_ 3; # max # of sack blks
}

Agent/Null set sport_           0
Agent/Null set dport_           0

Agent/CBR set sport_            0
Agent/CBR set dport_            0

Agent/HttpInval set inval_hdr_size_ 40

Agent/RTP set seqno_ 0
Agent/RTP set interval_ 3.75ms
Agent/RTP set random_ 0
Agent/RTP set packetSize_ 210
Agent/RTP set maxpkts_ 0x10000000
Agent/RTP instproc done {} { }

Agent/RTCP set seqno_ 0

Agent/Message set packetSize_ 180

Agent/LossMonitor set nlost_ 0
Agent/LossMonitor set npkts_ 0
Agent/LossMonitor set bytes_ 0
Agent/LossMonitor set lastPktTime_ 0
Agent/LossMonitor set expected_ 0

Agent/RAP set packetSize_ 512
Agent/RAP set seqno_ 0
Agent/RAP set sessionLossCount_ 0
Agent/RAP set ipg_ 2.0
Agent/RAP set alpha_ 1.0
Agent/RAP set beta_ 0.5
Agent/RAP set srtt_ 2.0
Agent/RAP set variance_ 0.0
Agent/RAP set delta_ 0.5
Agent/RAP set mu_ 1.2
Agent/RAP set phi_ 4.0
Agent/RAP set timeout_ 2.0
Agent/RAP set overhead_ 0
Agent/RAP set useFineGrain_ 0
Agent/RAP set kfrtt_ 0.9
Agent/RAP set kxrtt_ 0.01
Agent/RAP set debugEnable_ 0
Agent/RAP set rap_base_hdr_size_ 44
Agent/RAP set dpthresh_ 50
Agent/RAP instproc done {} { }

Agent/Mcast/Control set packetSize_ 80

Agent/rtProto set preference_ 200		;# global default preference
Agent/rtProto/Direct set preference_ 100
Agent/rtProto/DV set preference_	120
Agent/rtProto/DV set INFINITY		 [Agent set ttl_]
Agent/rtProto/DV set advertInterval	  2

Agent/Encapsulator set status_ 1
Agent/Encapsulator set overhead_ 20

Agent/DSRAgent set sport_ 255
Agent/DSRAgent set dport_ 255

Agent/MIPBS set adSize_ 48
Agent/MIPBS set shift_ 0
Agent/MIPBS set mask_ [AddrParams set ALL_BITS_SET]
Agent/MIPBS set ad_lifetime_ 2

Agent/MIPMH set home_agent_ 0
Agent/MIPMH set rreqSize_ 52
Agent/MIPMH set reg_rtx_ 3.0
Agent/MIPMH set shift_ 0
Agent/MIPMH set mask_ [AddrParams set ALL_BITS_SET]
Agent/MIPMH set reg_lifetime_ 2

Agent/Diff_Sink set packetSize_ 512
Agent/Diff_Sink set interval_   0.5
Agent/Diff_Sink set random_     1
Agent/Diff_Sink set maxpkts_    10000
Agent/Diff_Sink set data_type_  0

Agent/LossMonitor/PLM set flag_PP_ 0
Agent/LossMonitor/PLM set packet_time_PP_ 0
Agent/LossMonitor/PLM set fid_PP_ 0
Agent/LossMonitor/PLM set seqno_ 0

Agent/LDP set trace_ldp_ 0

if [TclObject is-class Network/Pcap/Live] {
Network/Pcap/Live set snaplen_ 4096;# bpf snap len
Network/Pcap/Live set promisc_ false;
Network/Pcap/Live set timeout_ 0
Network/Pcap/Live set optimize_ true;# bpf code optimizer
Network/Pcap/Live set offset_ 0.0; # 

Network/Pcap/File set offset_ 0.0; # ts for 1st pkt in trace file
}

if [TclObject is-class Agent/Tap] {
Agent/Tap set maxpkt_ 1600
}

if [TclObject is-class Agent/IcmpAgent] {
Agent/IcmpAgent set ttl_ 254
}



if [TclObject is-class ArpAgent] {

ArpAgent set cachesize_ 10; # entries in arp cache
ArpAgent instproc init {} {
$self next
}

ArpAgent instproc config ifname {
$self instvar net_ myether_ myip_
set net_ [new Network/Pcap/Live]
$net_ open readwrite $ifname
set myether_ [$net_ linkaddr]
set myip_ [$net_ netaddr]
$net_ filter "arp and (not ether src $myether_) and  (ether dst $myether_  or ether dst ff:ff:ff:ff:ff:ff)"
$self cmd network $net_
$self cmd myether $myether_
$self cmd myip $myip_
}
}


Simulator instproc init args {
$self create_packetformat
$self use-scheduler Calendar
$self set nullAgent_ [new Agent/Null]
$self set-address-format def
eval $self next $args
}

Simulator instproc nullagent {} {
$self instvar nullAgent_
return $nullAgent_
}

Simulator instproc use-scheduler type {
$self instvar scheduler_
if [info exists scheduler_] {
if { [$scheduler_ info class] == "Scheduler/$type" } {
return
} else {
delete $scheduler_
}
}
set scheduler_ [new Scheduler/$type]
$scheduler_ now
}

Simulator instproc delay_parse { spec } {
return [time_parse $spec]
}

Simulator instproc bw_parse { spec } {
return [bw_parse $spec]
}

Simulator instproc dumper obj {
set t [$self alloc-trace hop stdout]
$t target $obj
return $t
}


Simulator instproc addressType  {val} { $self set addressType_  $val }
Simulator instproc adhocRouting  {val} { $self set routingAgent_  $val }
Simulator instproc llType  {val} { $self set llType_  $val }
Simulator instproc macType  {val} { $self set macType_  $val }
Simulator instproc propType  {val} { $self set propType_  $val }
Simulator instproc propInstance  {val} { $self set propInstance_  $val }
Simulator instproc ifqType  {val} { $self set ifqType_  $val }
Simulator instproc ifqLen  {val} { $self set ifqlen_  $val }
Simulator instproc phyType  {val} { $self set phyType_  $val }
Simulator instproc antType  {val} { $self set antType_  $val }
Simulator instproc channel {val} {$self set channel_ $val}
Simulator instproc channelType {val} {$self set channelType_ $val}
Simulator instproc topoInstance {val} {$self set topoInstance_ $val}
Simulator instproc wiredRouting {val} {$self set wiredRouting_ $val}
Simulator instproc mobileIP {val} {$self set mobileIP_ $val}
Simulator instproc energyModel  {val} { $self set energyModel_  $val }
Simulator instproc initialEnergy  {val} { $self set initialEnergy_  $val }
Simulator instproc txPower  {val} { $self set txPower_  $val }
Simulator instproc rxPower  {val} { $self set rxPower_  $val }
Simulator instproc idlePower  {val} { $self set idlePower_  $val }
Simulator instproc agentTrace  {val} { $self set agentTrace_  $val }
Simulator instproc routerTrace  {val} { $self set routerTrace_  $val }
Simulator instproc macTrace  {val} { $self set macTrace_  $val }
Simulator instproc movementTrace  {val} { $self set movementTrace_  $val }
Simulator instproc toraDebug {val} {$self set toraDebug_ $val }
Simulator instproc MPLS { val } { 
if { $val == "ON" } {
Node enable-module "MPLS"
} else {
Node disable-module "MPLS"
}
}

Simulator instproc get-nodetype {} {
$self instvar addressType_ routingAgent_ wiredRouting_ 
set val ""

if { [info exists addressType_] && $addressType_ == "hierarchical" } {
set val Hier
}
if { [info exists routingAgent_] && $routingAgent_ != "" } {
set val Mobile
}
if { [info exists wiredRouting_] && $wiredRouting_ == "ON" } {
set val Base
}
if { [info exists wiredRouting_] && $wiredRouting_ == "OFF"} {
set val Base
}
if { [Simulator set mobile_ip_] } {
if { $val == "Base" && $wiredRouting_ == "ON" } {
set val MIPBS
}
if { $val == "Base" && $wiredRouting_ == "OFF" } {
set val MIPMH
}
}
return $val
}

Simulator instproc node-config args {
set args [eval $self init-vars $args]

$self instvar addressType_  routingAgent_ propType_  macTrace_  routerTrace_ agentTrace_ movementTrace_ channelType_ channel_  chan topoInstance_ propInstance_ mobileIP_ rxPower_  txPower_ idlePower_

if [info exists macTrace_] {
Simulator set MacTrace_ $macTrace_
}
if [info exists routerTrace_] {
Simulator set RouterTrace_ $routerTrace_
}
if [info exists agentTrace_] {
Simulator set AgentTrace_ $agentTrace_
}
if [info exists movementTrace_] {
Simulator set MovementTrace_ $movementTrace_
}
if {[info exists propType_] && [info exists propInstance_]} {
warn "Both propType and propInstance are set."
}
if {[info exists propType_] && ![info exists propInstance_]} {
set propInstance_ [new $propType_] 
}
if {[info exists channelType_] && [info exists channel_]} { 
error "Can't specify both channel and channelType, error!"
} elseif {[info exists channelType_]} {
warn "Please use -channel as shown in tcl/ex/wireless-mitf.tcl"
if {![info exists chan]} {
set chan [new $channelType_]
}
} elseif {[info exists channel_]} {
set chan $channel_
}
if [info exists topoInstance_] {
$propInstance_  topography $topoInstance_
}
if {[string compare $addressType_ ""] != 0} {
$self set-address-format $addressType_ 
}
if { [info exists mobileIP_] && $mobileIP_ == "ON"} {
Simulator set mobile_ip_  1
} else {
if { [info exists mobileIP_] } {
Simulator set mobile_ip_ 0
}
}
}

Simulator instproc node args {
$self instvar Node_ routingAgent_ wiredRouting_
if { [Simulator info vars EnableMcast_] != "" } {
warn "Flag variable Simulator::EnableMcast_ discontinued.\n\t Use multicast methods as:\n\t\t % set ns \[new Simulator -multicast on]\n\t\t % \$ns multicast"
$self multicast
Simulator unset EnableMcast_
}
if { [Simulator info vars NumberInterfaces_] != "" } {
warn "Flag variable Simulator::NumberInterfaces_ discontinued.\n\t Setting this variable will not affect simulations."
Simulator unset NumberInterfaces_
}

if { [info exists routingAgent_] && ($routingAgent_ != "") } {
set node [eval $self create-wireless-node $args]
set Node_([$node id]) $node
return $node
}

set node [eval new [Simulator set node_factory_] $args]
set Node_([$node id]) $node
$node set ns_ $self
$self check-node-num
return $node
}

Simulator instproc imep-support {} {
return [Simulator set IMEPFlag_]
}

Simulator instproc create-wireless-node args {
$self instvar routingAgent_ wiredRouting_ propInstance_ llType_  macType_ ifqType_ ifqlen_ phyType_ chan antType_ energyModel_  initialEnergy_ txPower_ rxPower_ idlePower_  topoInstance_ level1_ level2_

Simulator set IMEPFlag_ OFF

set node [eval $self create-node-instance $args]

if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
$node base-station [AddrParams addr2id [$node node-addr]]
}
switch -exact $routingAgent_ {
DSDV {
set ragent [$self create-dsdv-agent $node]
}
DSR {
$self at 0.0 "$node start-dsr"
}
AODV {
set ragent [$self create-aodv-agent $node]
}
TORA {
Simulator set IMEPFlag_ ON
set ragent [$self create-tora-agent $node]
}
NOAH {
set ragent [$self create-noah-agent $node]
}
DIFFUSION/RATE {
eval $node addr $args
set ragent [$self create-diffusion-rate-agent $node]
}
DIFFUSION/PROB {
eval $node addr $args
set ragent [$self create-diffusion-probability-agent $node]
}
FLOODING {
eval $node addr $args
set ragent [$self create-flooding-agent $node]
}
OMNIMCAST {
eval $node addr $args
set ragent [$self create-omnimcast-agent $node]
}
default {
puts "Wrong node routing agent!"
exit
}
}
$node add-interface $chan $propInstance_ $llType_ $macType_  $ifqType_ $ifqlen_ $phyType_ $antType_
if {$routingAgent_ != "DSR"} {
$node attach $ragent [Node set rtagent_port_]
}
if {$routingAgent_ == "DIFFUSION/RATE" ||
$routingAgent_ == "DIFFUSION/PROB" ||
$routingAgent_ == "FLOODING" ||
$routingAgent_ == "OMNIMCAST" } {
$ragent port-dmux [$node demux]
$node instvar ll_
$ragent add-ll $ll_(0)
}

if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
if { $routingAgent_ != "DSR" } {
$node mip-call $ragent
}
}
set tracefd [$self get-ns-traceall]
if {$tracefd != "" } {
$node nodetrace $tracefd
$node agenttrace $tracefd
}
set namtracefd [$self get-nam-traceall]
if {$namtracefd != "" } {
$node namattach $namtracefd
}
if [info exists energyModel_] {
if  [info exists level1_] {
set l1 $level1_
} else {
set l1 0.5
}
if  [info exists level2_] {
set l2 $level2_
} else {
set l2 0.2
}
$node addenergymodel [new $energyModel_ $node  $initialEnergy_ $l1 $l2]
}
if [info exists txPower_] {
$node setPt $txPower_
}
if [info exists rxPower_] {
$node setPr $rxPower_
}
if [info exists idlePower_] {
$node setPidle $idlePower_
}
$node topography $topoInstance_
return $node
}

Simulator instproc create-node-instance args {
$self instvar routingAgent_
if {$routingAgent_ == "DSR"} {
set nodeclass [$self set-dsr-nodetype]
} else {
set nodeclass Node/MobileNode
}
return [eval new $nodeclass $args]
}

Simulator instproc set-dsr-nodetype {} {
$self instvar wiredRouting_ 
set nodetype SRNodeNew
if [Simulator set mobile_ip_] {
set nodetype SRNodeNew/MIPMH
} 
if { [info exists wiredRouting_] && $wiredRouting_ == "ON"} {
set nodetype Node/MobileNode/BaseStationNode
}
return $nodetype
}

Simulator instproc create-tora-agent { node } {
set ragent [new Agent/TORA [$node id]]
$node set ragent_ $ragent
return $ragent
}

Simulator instproc create-dsdv-agent { node } {
set ragent [new Agent/DSDV]
set addr [$node node-addr]
$ragent addr $addr
$ragent node $node
if [Simulator set mobile_ip_] {
$ragent port-dmux [$node demux]
}
$node addr $addr
$node set ragent_ $ragent
$self at 0.0 "$ragent start-dsdv"    ;# start updates
return $ragent
}

Simulator instproc create-noah-agent { node } {
set ragent [new Agent/NOAH]

set addr [$node node-addr]

$ragent addr $addr
$ragent node $node

if [Simulator set mobile_ip_] {
$ragent port-dmux [$node set dmux_]
}
$node addr $addr
$node set ragent_ $ragent



return $ragent
}

Simulator instproc create-aodv-agent { node } {
set ragent [new Agent/AODV [$node id]]
$self at 0.0 "$ragent start"     ;# start BEACON/HELLO Messages
$node set ragent_ $ragent
return $ragent
}

Simulator instproc use-newtrace {} {
Simulator set WirelessNewTrace_ 1
} 

Simulator instproc hier-node haddr {
error "hier-nodes should be created with [$ns_ node $haddr]"
}

Simulator instproc now {} {
$self instvar scheduler_
return [$scheduler_ now]
}

Simulator instproc at args {
$self instvar scheduler_
return [eval $scheduler_ at $args]
}

Simulator instproc at-now args {
$self instvar scheduler_
return [eval $scheduler_ at-now $args]
}

Simulator instproc cancel args {
$self instvar scheduler_
return [eval $scheduler_ cancel $args]
}

Simulator instproc after {ival args} {
eval $self at [expr [$self now] + $ival] $args
}

Simulator instproc check-node-num {} {
if {[Node set nn_] > [expr pow(2, [AddrParams nodebits])]} {
error "Number of nodes exceeds node-field-size of [AddrParams nodebits] bits"
}
}

Simulator instproc chk-hier-field-lengths {} {
AddrParams instvar domain_num_ cluster_num_ nodes_num_
if [info exists domain_num_] {
if {[expr $domain_num_ - 1]> [AddrParams NodeMask 1]} {
error "\# of domains exceed dom-field-size "
}
} 
if [info exists cluster_num_] {
set maxval [expr [find-max $cluster_num_] - 1] 
if {$maxval > [expr pow(2, [AddrParams NodeMask 2])]} {
error "\# of clusters exceed clus-field-size "
}
}
if [info exists nodes_num_] {
set maxval [expr [find-max $nodes_num_] -1]
if {$maxval > [expr pow(2, [AddrParams NodeMask 3])]} {
error "\# of nodess exceed node-field-size"
}
}
}

Simulator instproc run {} {
$self check-node-num
$self rtmodel-configure			;# in case there are any
[$self get-routelogic] configure
$self instvar scheduler_ Node_ link_ started_ 

set started_ 1

foreach nn [array names Node_] {
$Node_($nn) reset
}
foreach qn [array names link_] {
set q [$link_($qn) queue]
$q reset
}

$self init-nam

return [$scheduler_ run]
}

Simulator instproc halt {} {
$self instvar scheduler_
$scheduler_ halt
}

Simulator instproc dumpq {} {
$self instvar scheduler_
$scheduler_ dumpq
}

Simulator instproc is-started {} {
$self instvar started_
return [info exists started_]
}

Simulator instproc clearMemTrace {} {
$self instvar scheduler_
$scheduler_ clearMemTrace
}

Simulator instproc simplex-link { n1 n2 bw delay qtype args } {
$self instvar link_ queueMap_ nullAgent_
set sid [$n1 id]
set did [$n2 id]

if [info exists queueMap_($qtype)] {
set qtype $queueMap_($qtype)
}
set qtypeOrig $qtype
switch -exact $qtype {
ErrorModule {
if { [llength $args] > 0 } {
set q [eval new $qtype $args]
} else {
set q [new $qtype Fid]
}
}
intserv {
set qtype [lindex $args 0]
set q [new Queue/$qtype]
}
default {
if { [llength $args] == 0} {
set q [new Queue/$qtype]
} else {
set q [new Queue/$qtype $args]
}
}
}
switch -exact $qtypeOrig {
RTM {
set c [lindex $args 1]
set link_($sid:$did) [new CBQLink        $n1 $n2 $bw $delay $q $c]
}
CBQ -
CBQ/WRR {
if {[llength $args] == 0} {
set c [new Classifier/Hash/Fid 33]
} else {
set c [lindex $args 0]
}
set link_($sid:$did) [new CBQLink        $n1 $n2 $bw $delay $q $c]
}
FQ      {
set link_($sid:$did) [new FQLink $n1 $n2 $bw $delay $q]
}
intserv {
set link_($sid:$did) [new IntServLink    $n1 $n2 $bw $delay $q	 [concat $qtypeOrig $args]]
}
default {
set link_($sid:$did) [new SimpleLink     $n1 $n2 $bw $delay $q]
}
}
$n1 add-neighbor $n2

if {[string first "RED" $qtype] != -1} {
$q link [$link_($sid:$did) set link_]
}

if {[string first "RIO" $qtype] != -1} {
$q link [$link_($sid:$did) set link_]
}

set trace [$self get-ns-traceall]
if {$trace != ""} {
$self trace-queue $n1 $n2 $trace
}
set trace [$self get-nam-traceall]
if {$trace != ""} {
$self namtrace-queue $n1 $n2 $trace
}

$self register-nam-linkconfig $link_($sid:$did)
}

Simulator instproc register-nam-linkconfig link {
$self instvar linkConfigList_ link_
if [info exists linkConfigList_] {
set i1 [[$link src] id]
set i2 [[$link dst] id]
if [info exists link_($i2:$i1)] {
set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
if {$pos >= 0} {
set a1 [$link_($i2:$i1) get-attribute  "ORIENTATION"]
set a2 [$link get-attribute "ORIENTATION"]
if {$a1 == "" && $a2 != ""} {
set linkConfigList_ [lreplace  $linkConfigList_ $pos $pos]
} else {
return
}
}
}
set pos [lsearch $linkConfigList_ $link]
if {$pos >= 0} {
set linkConfigList_  [lreplace $linkConfigList_ $pos $pos]
}
}
lappend linkConfigList_ $link
}

Simulator instproc remove-nam-linkconfig {i1 i2} {
$self instvar linkConfigList_ link_
if ![info exists linkConfigList_] {
return
}
set pos [lsearch $linkConfigList_ $link_($i1:$i2)]
if {$pos >= 0} {
set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
return
}
set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
if {$pos >= 0} {
set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
}
}

Simulator instproc duplex-link { n1 n2 bw delay type args } {
$self instvar link_
set i1 [$n1 id]
set i2 [$n2 id]
if [info exists link_($i1:$i2)] {
$self remove-nam-linkconfig $i1 $i2
}
eval $self simplex-link $n1 $n2 $bw $delay $type $args
eval $self simplex-link $n2 $n1 $bw $delay $type $args
}

Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
eval $self duplex-link $n1 $n2 $bw $pd intserv $sched $signal $adc $args
}

Simulator instproc simplex-link-op { n1 n2 op args } {
$self instvar link_
eval $link_([$n1 id]:[$n2 id]) $op $args
}

Simulator instproc duplex-link-op { n1 n2 op args } {
$self instvar link_
eval $link_([$n1 id]:[$n2 id]) $op $args
eval $link_([$n2 id]:[$n1 id]) $op $args
}

Simulator instproc flush-trace {} {
$self instvar alltrace_
if [info exists alltrace_] {
foreach trace $alltrace_ {
$trace flush
}
}
}

Simulator instproc namtrace-all file   {
$self instvar namtraceAllFile_
if {$file != ""} {
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}
}

Simulator instproc energy-color-change {level1 level2} {
$self instvar level1_ level2_
set level1_ $level1
set level2_ $level2
}

Simulator instproc namtrace-all-wireless {file optx opty} {
$self instvar namtraceAllFile_
if {$file != ""} {
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}
if { $optx != "" && $opty != "" } {
$self puts-nam-config "W -t * -x $optx -y $opty"
}
}

Simulator instproc nam-end-wireless {stoptime} {
$self instvar namtraceAllFile_

if {$namtraceAllFile_ != ""} {
$self puts-nam-config "W -t $stoptime"
}
}

Simulator instproc namtrace-some file {
$self instvar namtraceSomeFile_
set namtraceSomeFile_ $file
}

Simulator instproc namtrace-all-wireless {file optx opty} {
$self instvar namtraceAllFile_  

if {$file != ""} { 
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}       
$self puts-nam-config "W -t * -x $optx -y $opty"
}

Simulator instproc initial_node_pos {nodep size} {
$self instvar addressType_
$self instvar energyModel_ 

if [info exists energyModel_] {  
set nodeColor "green"
} else {
set nodeColor "black"
}
if { [info exists addressType_] && $addressType_ == "hierarchical" } {
$self puts-nam-config "n -t * -a [$nodep set address_]  -s [$nodep id] -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_]  -z $size -v circle -c $nodeColor"
} else { 
$self puts-nam-config "n -t * -s [$nodep id]  -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size  -v circle -c $nodeColor"
}
}

Simulator instproc trace-all file {
$self instvar traceAllFile_
set traceAllFile_ $file
}

Simulator instproc get-nam-traceall {} {
$self instvar namtraceAllFile_
if [info exists namtraceAllFile_] {
return $namtraceAllFile_
} else {
return ""
}
}

Simulator instproc get-ns-traceall {} {
$self instvar traceAllFile_
if [info exists traceAllFile_] {
return $traceAllFile_
} else {
return ""
}
}

Simulator instproc puts-ns-traceall { str } {
$self instvar traceAllFile_
if [info exists traceAllFile_] {
puts $traceAllFile_ $str
}
}

Simulator instproc puts-nam-traceall { str } {
$self instvar namtraceAllFile_
if [info exists namtraceAllFile_] {
puts $namtraceAllFile_ $str
} elseif [info exists namtraceSomeFile_] {
puts $namtraceSomeFile_ $str
}
}

Simulator instproc namtrace-config { f } {
$self instvar namConfigFile_
set namConfigFile_ $f
}

Simulator instproc get-nam-config {} {
$self instvar namConfigFile_
if [info exists namConfigFile_] {
return $namConfigFile_
} else {
return ""
}
}

Simulator instproc puts-nam-config { str } {
$self instvar namtraceAllFile_ namConfigFile_

if [info exists namConfigFile_] {
puts $namConfigFile_ $str
} elseif [info exists namtraceAllFile_] {
puts $namtraceAllFile_ $str
} elseif [info exists namtraceSomeFile_] {
puts $namtraceSomeFile_ $str
}
}

Simulator instproc color { id name } {
$self instvar color_
set color_($id) $name
}

Simulator instproc get-color { id } {
$self instvar color_
return $color_($id)
}

Simulator instproc create-trace { type file src dst {op ""} } {
$self instvar alltrace_
set p [new Trace/$type]
if [catch {$p set src_ [$src id]}] {
$p set src_ $src
}
if [catch {$p set dst_ [$dst id]}] {
$p set dst_ $dst
}
lappend alltrace_ $p
if {$file != ""} {
$p ${op}attach $file		
}
return $p
}

Simulator instproc namtrace-queue { n1 n2 {file ""} } {
$self instvar link_ namtraceAllFile_
if {$file == ""} {
if ![info exists namtraceAllFile_] return
set file $namtraceAllFile_
}
$link_([$n1 id]:[$n2 id]) nam-trace $self $file

set queue [$link_([$n1 id]:[$n2 id]) queue]
$queue attach-nam-traces $n1 $n2 $file
}

Simulator instproc trace-queue { n1 n2 {file ""} } {
$self instvar link_ traceAllFile_
if {$file == ""} {
if ![info exists traceAllFile_] return
set file $traceAllFile_
}
$link_([$n1 id]:[$n2 id]) trace $self $file

set queue [$link_([$n1 id]:[$n2 id]) queue]
$queue attach-traces $n1 $n2 $file
}

Simulator instproc monitor-queue { n1 n2 qtrace { sampleInterval 0.1 } } {
$self instvar link_
return [$link_([$n1 id]:[$n2 id]) init-monitor $self $qtrace $sampleInterval]
}

Simulator instproc queue-limit { n1 n2 limit } {
$self instvar link_
[$link_([$n1 id]:[$n2 id]) queue] set limit_ $limit
}

Simulator instproc drop-trace { n1 n2 trace } {
$self instvar link_
[$link_([$n1 id]:[$n2 id]) queue] drop-target $trace
}

Simulator instproc cost {n1 n2 c} {
$self instvar link_
$link_([$n1 id]:[$n2 id]) cost $c
}

Simulator instproc attach-agent { node agent } {
$node attach $agent
}

Simulator instproc attach-tbf-agent { node agent tbf } {
$node attach $agent
$agent attach-tbf $tbf
}


Simulator instproc detach-agent { node agent } {
$self instvar nullAgent_
$node detach $agent $nullAgent_
}

Simulator instproc delay { n1 n2 delay {type simplex} } {
$self instvar link_
set sid [$n1 id]
set did [$n2 id]
if [info exists link_($sid:$did)] {
set d [$link_($sid:$did) link]
$d set delay_ $delay
}
if {$type == "duplex"} {
if [info exists link_($did:$sid)] {
set d [$link_($did:$sid) link]
$d set delay_ $delay
}
}
}

Simulator instproc bandwidth { n1 n2 bandwidth {type simplex} } {
$self instvar link_
set sid [$n1 id]
set did [$n2 id]
if [info exists link_($sid:$did)] {
set d [$link_($sid:$did) link]
$d set bandwidth_ $bandwidth
} 
if {$type == "duplex"} {
if [info exists link_($did:$sid)] {
set d [$link_($did:$sid) link]
$d set bandwidth_ $bandwidth
}
}
}


Simulator instproc connect {src dst} {
$self simplex-connect $src $dst
$self simplex-connect $dst $src
return $src
}

Simulator instproc simplex-connect { src dst } {
$src set dst_addr_ [$dst set agent_addr_] 
$src set dst_port_ [$dst set agent_port_]

if {[lindex [split [$src info class] "/"] 1] == "AbsTCP"} {
$self at [$self now] "$self rtt $src $dst"
$dst set class_ [$src set class_]
}

return $src
}


Simulator proc instance {} {
set ns [Simulator info instances]
if { $ns != "" } {
return $ns
}
foreach sim [Simulator info subclass] {
set ns [$sim info instances]
if { $ns != "" } {
return $ns
}
}
error "Cannot find instance of simulator"
}

Simulator instproc get-number-of-nodes {} {
return  [$self array size Node_]
}

Simulator instproc get-node-by-id id {
$self instvar Node_
return $Node_($id)
}

Simulator instproc get-node-id-by-addr address {
$self instvar Node_
set n [Node set nn_]
for {set q 0} {$q < $n} {incr q} {
set nq $Node_($q)
if {[string compare [$nq node-addr] $address] == 0} {
return $q
}
}
error "get-node-id-by-addr:Cannot find node with given address"
}

Simulator instproc get-node-by-addr address {
return [$self get-node-by-id [$self get-node-id-by-addr $address]]
}

Simulator instproc all-nodes-list {} {
$self instvar Node_
set nodes ""
foreach n [lsort -dictionary [array names Node_]] {
lappend nodes $Node_($n)
}
return $nodes
}

Simulator instproc link { n1 n2 } {
$self instvar Node_ link_
if { ![catch "$n1 info class Node"] } {
set n1 [$n1 id]
}
if { ![catch "$n2 info class Node"] } {
set n2 [$n2 id]
}
if [info exists link_($n1:$n2)] {
return $link_($n1:$n2)
}
return ""
}

Simulator instproc create-connection {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
$self connect $s_agent $d_agent

return $s_agent
}

Simulator instproc create-connection-list {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
$self connect $s_agent $d_agent

return [list $s_agent $d_agent]
}   

Simulator instproc create-tcp-connection {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
return "$s_agent $d_agent"
}

Classifier instproc install {slot val} {
$self set slots_($slot) $val
$self cmd install $slot $val
}

Classifier instproc installNext val {
set slot [$self cmd installNext $val]
$self set slots_($slot) $val
set slot
}

Classifier instproc adjacents {} {
$self array get slots_
}

Classifier instproc in-slot? slot {
$self instvar slots_
set ret ""
if {[array size slots_] < $slot} {
set ret slots_($slot)
}
set ret
}

Classifier instproc dump {} {
$self instvar slots_ offset_ shift_ mask_
puts "classifier $self"
puts "\t$offset_ offset"
puts "\t$shift_ shift"
puts "\t$mask_ mask"
puts "\t[array size slots_] slots"
foreach i [lsort -integer [array names slots_]] {
set iv $slots_($i)
puts "\t\tslot $i: $iv"
}
}

Classifier instproc no-slot slot {
puts stderr "--- Classfier::no-slot{} default handler (tcl/lib/ns-lib.tcl) ---"
puts stderr "\t$self: no target for slot $slot"
puts stderr "\t$self type: [$self info class]"
puts stderr "content dump:"
$self dump
puts stderr "---------- Finished standard no-slot{} default handler ----------"
[Simulator instance] flush-trace
exit 1
}

Classifier/Hash instproc dump args {
eval $self next $args
$self instvar default_
puts "\t$default_ default"
}

Classifier/Hash instproc init nbuck {
$self next $nbuck
$self instvar shift_ mask_
set shift_ [AddrParams NodeShift 1]
set mask_ [AddrParams NodeMask 1]
}

Classifier/Port/Reserve instproc init args {
eval $self next
$self reserve-port 2
}

Simulator instproc makeflowmon { cltype { clslots 29 } } {
set flowmon [new QueueMonitor/ED/Flowmon]
set cl [new Classifier/Hash/$cltype $clslots]

$cl proc unknown-flow { src dst fid }  {
set fdesc [new QueueMonitor/ED/Flow]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc] 
$self set-hash auto $src $dst $fid $slot
}

$cl proc no-slot slotnum {
}
$flowmon classifier $cl
return $flowmon
}


Simulator instproc attach-fmon {lnk fm { edrop 0 } } {
set isnoop [new SnoopQueue/In]
set osnoop [new SnoopQueue/Out]
set dsnoop [new SnoopQueue/Drop]
$lnk attach-monitors $isnoop $osnoop $dsnoop $fm
if { $edrop != 0 } {
set edsnoop [new SnoopQueue/EDrop]
$edsnoop set-monitor $fm
[$lnk queue] early-drop-target $edsnoop
$edsnoop target [$self set nullAgent_]
}
[$lnk queue] drop-target $dsnoop
}


Simulator instproc maketbtagger { cltype { clslots 29 } } {

set tagger [new QueueMonitor/ED/Tagger]
set cl [new Classifier/Hash/$cltype $clslots]

$cl proc unknown-flow { src dst fid }  {
set fdesc [new QueueMonitor/ED/Flow/TB]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc]
$self set-hash auto $src $dst $fid $slot
}

$cl proc set-rate { src dst fid hashbucket rate depth init} {
set fdesc [new QueueMonitor/ED/Flow/TB]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
$fdesc set target_rate_ $rate
$fdesc set bucket_depth_ $depth
$fdesc set tbucket_ $init  
set slot [$self installNext $fdesc]
$self set-hash $hashbucket $src $dst $fid $slot
}

$cl proc no-slot slotnum {
}
$tagger classifier $cl
return $tagger
}


Simulator instproc maketswtagger { cltype { clslots 29 } } {

set tagger [new QueueMonitor/ED/Tagger]
set cl [new Classifier/Hash/$cltype $clslots]

$cl proc unknown-flow { src dst fid hashbucket }  {
set fdesc [new QueueMonitor/ED/Flow/TSW]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc]
$self set-hash $hashbucket $src $dst $fid $slot
}

$cl proc no-slot slotnum {
}
$tagger classifier $cl
return $tagger
}


Simulator instproc attach-tagger {lnk fm} {
set isnoop [new SnoopQueue/Tagger]
$lnk attach-taggers $isnoop $fm
}

Simulator instproc lossmodel {lossobj from to} {
set link [$self link $from $to]
$link errormodule $lossobj
}

Simulator instproc link-lossmodel {lossobj from to} {
set link [$self link $from $to]
$link insert-linkloss $lossobj
}



Simulator instproc rtt { src dst } {
$self instvar routingTable_ delay_
set srcid [[$src set node_] id]
set dstid [[$dst set node_] id]
set delay 0
set tmpid $srcid
while {$tmpid != $dstid} {
set nextid [$routingTable_ lookup $tmpid $dstid]
set tmpnode [$self get-node-by-id $tmpid]
set nextnode [$self get-node-by-id $nextid]
set tmplink [[$self link $tmpnode $nextnode] link]
set delay [expr $delay + [expr 2 * [$tmplink set delay_]]]
set delay [expr $delay + [expr 8320 / [$tmplink set bandwidth_]]]
set tmpid $nextid
}
$src rtt $delay
return $delay
}

Simulator instproc abstract-tcp {} {
$self instvar TahoeAckfsm_ RenoAckfsm_ TahoeDelAckfsm_ RenoDelAckfsm_ dropper_ 
$self set TahoeAckfsm_ [new FSM/TahoeAck]
$self set RenoAckfsm_ [new FSM/RenoAck]
$self set TahoeDelAckfsm_ [new FSM/TahoeDelAck]
$self set RenoDelAckfsm_ [new FSM/RenoDelAck]
$self set nullAgent_ [new DropTargetAgent]
}


Simulator instproc create-diffusion-rate-agent {node} {
set diff [new Agent/Diffusion/RateGradient]

$node set diffagent_ $diff
$node set ragent_ $diff

$diff on-node $node

if [info exist opt(enablePos)] {
if {$opt(enablePos) == "true"} {
$diff enable-pos
} else {
$diff disable-pos
}
} 

if [info exist opt(enableNeg)] {
if {$opt(enableNeg) == "true"} {
$diff enable-neg
} else {
$diff disable-neg
}
} 

if [info exist opt(suppression)] {
if {$opt(suppression) == "true"} {
$diff enable-suppression
} else {
$diff disable-suppression
}
} 

if [info exist opt(subTxType)] {
$diff set-sub-tx-type $opt(subTxType)
} 

if [info exist opt(orgTxType)] {
$diff set-org-tx-type $opt(orgTxType)
} 

if [info exist opt(posType)] {
$diff set-pos-type $opt(posType)
} 

if [info exist opt(posNodeType)] {
$diff set-pos-node-type $opt(posNodeType)
} 

if [info exist opt(negWinType)] {
$diff set-neg-win-type $opt(negWinType)
} 

if [info exist opt(negThrType)] {
$diff set-neg-thr-type $opt(negThrType)
} 

if [info exist opt(negMaxType)] {
$diff set-neg-max-type $opt(negMaxType)
} 

$self put-in-list $diff
$self at 0.0 "$diff start"

return $diff
}

Simulator instproc create-diffusion-probability-agent {node} {
set diff [new Agent/Diffusion/ProbGradient]

$node set diffagent_ $diff
$node set ragent_ $diff

$diff on-node $node

if [info exist opt(enablePos)] {
if {$opt(enablePos) == "true"} {
$diff enable-pos
} else {
$diff disable-pos
}
} 
if [info exist opt(enableNeg)] {
if {$opt(enableNeg) == "true"} {
$diff enable-neg
} else {
$diff disable-neg
}
} 

$self put-in-list $diff
$self at 0.0 "$diff start"

return $diff
}

Simulator instproc create-flooding-agent {node} {
set flood [new Agent/Flooding]

$node set ragent_ $flood

$flood on-node $node

$self put-in-list $flood
$self at 0.0 "$flood start"

return $flood
}

Simulator instproc create-omnimcast-agent {node} {
set omni [new Agent/OmniMcast]

$node set ragent_ $omni

$omni on-node $node

$self put-in-list $omni
$self at 0.0 "$omni start"

return $omni
}

Simulator instproc put-in-list {agent} {
$self instvar lagent
lappend lagent $agent
}

Simulator instproc terminate-all-agents {} {
$self instvar lagent
foreach i $lagent {
$i terminate
}
}

Simulator instproc prepare-to-stop {} {
$self instvar lagent
foreach i $lagent {
$i stop
}
}





Agent/rtProto/LS set UNREACHABLE  [rtObject set unreach_]
Agent/rtProto/LS set preference_        120
Agent/rtProto/LS set INFINITY           [Agent set ttl_]
Agent/rtProto/LS set advertInterval     1800

Simulator instproc get-number-of-nodes {} {
$self instvar Node_
return  [array size Node_] 
}

Agent/rtProto/LS proc init-all args {
if { [llength $args] == 0 } {
set nodeslist [[Simulator instance] all-nodes-list]
} else { 
eval "set nodeslist $args"
}
Agent set-maxttl Agent/rtProto/LS INFINITY
eval rtObject init-all $nodeslist
foreach node $nodeslist {
set proto($node) [[$node rtObject?] add-proto LS $node]
}
foreach node $nodeslist {
foreach nbr [$node neighbors] {
set rtobj [$nbr rtObject?]
if { $rtobj == "" } {
continue
}
set rtproto [$rtobj rtProto? LS]
if { $rtproto == "" } {
continue
}
$proto($node) add-peer $nbr  [$rtproto set agent_addr_]  [$rtproto set agent_port_]
}
}

set first_node [lindex $nodeslist 0 ]
foreach node $nodeslist {
set rtobj [$node rtObject?]
if { $rtobj == "" } {
continue
}
set rtproto [$rtobj rtProto? LS]
if { $rtproto == "" } {
continue
}
$rtproto cmd initialize
if { $node == $first_node } {
$rtproto cmd setNodeNumber  [[Simulator instance] get-number-of-nodes]
}
}
}

Agent/rtProto/LS instproc init node {
global rtglibRNG

$self next $node
$self instvar ns_ rtObject_ ifsUp_ rtsChanged_ rtpref_ nextHop_  nextHopPeer_ metric_ multiPath_
Agent/rtProto/LS instvar preference_ 

;# -- LS stuffs -- 
$self instvar LS_ready
set LS_ready 0
set rtsChanged_ 1

set UNREACHABLE [$class set UNREACHABLE]
foreach dest [$ns_ all-nodes-list] {
set rtpref_($dest) $preference_
set nextHop_($dest) ""
set nextHopPeer_($dest) ""
set metric_($dest)  $UNREACHABLE
}
set ifsUp_ ""
set multiPath_ [[$rtObject_ set node_] set multiPath_]
set updateTime [$rtglibRNG uniform 0.0 0.5]
$ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/LS instproc add-peer {nbr agentAddr agentPort} {
$self instvar peers_
$self set peers_($nbr) [new rtPeer $agentAddr $agentPort $class]
}

Agent/rtProto/LS instproc send-periodic-update {} {
global rtglibRNG

$self instvar ns_

$self cmd sendUpdates

set updateTime [expr [$ns_ now] + ([$class set advertInterval] *  [$rtglibRNG uniform 0.5 1.5])]
$ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/LS instproc compute-routes {} {
$self instvar node_
$self cmd computeRoutes
$self install-routes
}

Agent/rtProto/LS instproc intf-changed {} {
$self instvar ns_ peers_ ifs_ ifstat_ ifsUp_ nextHop_  nextHopPeer_ metric_
set INFINITY [$class set INFINITY]
set ifsUp_ ""
foreach nbr [array names peers_] {
set state [$ifs_($nbr) up?]
if {$state != $ifstat_($nbr)} {
set ifstat_($nbr) $state
}
}
$self cmd intfChanged
$self route-changed
}

;# called by C++ whenever a LSA or Topo causes a change in the routing table
Agent/rtProto/LS instproc route-changed {} {
$self instvar node_ 

$self instvar rtObject_  rtsChanged_
$self install-routes
set rtsChanged_ 1
$rtObject_ compute-routes
}

Agent/rtProto/LS instproc install-routes {} {
$self instvar ns_ ifs_ rtpref_ metric_ nextHop_ nextHopPeer_
$self instvar peers_ rtsChanged_ multiPath_
$self instvar node_  preference_ 

set INFINITY [$class set INFINITY]
set MAXPREF  [rtObject set maxpref_]
set UNREACH  [rtObject set unreach_]
set rtsChanged_ 1 

foreach dst [$ns_ all-nodes-list] {
if { $dst == $node_ } {
set metric_($dst) 32  ;# the magic number
continue
}
set path [$self cmd lookup [$dst id]]
if { [llength $path ] == 0 } {
set rtpref_($dst) $MAXPREF
set metric_($dst) $UNREACH
set nextHop_($dst) ""
continue
}
set cost [lindex $path 0]
set rtpref_($dst) $preference_
set metric_($dst) $cost

if { ! $multiPath_ } {
set nhNode [$ns_ get-node-by-id [lindex $path 1]]
set nextHop_($dst) $ifs_($nhNode)
continue
}
set nextHop_($dst) ""
set nh ""
set count [llength $path]
foreach nbr [array names peers_] {
foreach nhId [lrange $path 1 $count ] {
if { [$nbr id] == $nhId } {
lappend nextHop_($dst) $ifs_($nbr)
break
}
}
}
}
}

Agent/rtProto/LS instproc send-updates changes {
$self cmd send-buffered-messages
}

Agent/rtProto/LS proc compute-all {} {
}

Agent/rtProto/LS instproc get-node-id {} {
$self instvar node_
return [$node_ id]
}

Agent/rtProto/LS instproc get-links-status {} {
$self instvar ifs_ ifstat_ 
set linksStatus ""
foreach nbr [array names ifs_] {
lappend linksStatus [$nbr id]
if {[$ifs_($nbr) up?] == "up"} {
lappend linksStatus 1
} else {
lappend linksStatus 0
}
lappend linksStatus [$ifs_($nbr) cost?]
}
set linksStatus
}

Agent/rtProto/LS instproc get-peers {} {
$self instvar peers_
set peers ""
foreach nbr [array names peers_] {
lappend peers [$nbr id]
lappend peers [$peers_($nbr) addr?]
lappend peers [$peers_($nbr) port?]
}
set peers
}

Agent/rtProto/LS instproc get-delay-estimates {} {
$self instvar ifs_ ifstat_ 
set total_delays ""
set packet_size 8000.0 ;# bits
foreach nbr [array names ifs_] {
set intf $ifs_($nbr)
set q_limit [ [$intf queue ] set limit_]
set bw [bw_parse [ [$intf link ] set bandwidth_ ] ]
set p_delay [time_parse [ [$intf link ] set delay_] ]
set total_delay [expr $q_limit * $packet_size / $bw + $p_delay]
$self cmd setDelay [$nbr id] $total_delay
}
}
: uneven number of args
    (Object init line 1)
    invoked from within
"PortShift init 0"
    (Class create line 1)
    invoked from within
"AddrParams create PortShift 0"
    ("eval" body line 1)
    invoked from within
"eval [list $self] create [list $m] $args         "
    (procedure "AddrParams" line 5)
    (Class unknown line 5)
    invoked from within
"AddrParams PortShift 0"

Follow-Ups:
- Re: [ns] problem with tcl?
  - From: Haobo Yu <[email protected]>

Prev by Date: Re: [ns] Problem found with input data
Next by Date: Re: [ns] problem with tcl?
Prev by thread: [ns] control de flux
Next by thread: Re: [ns] problem with tcl?
Index(es):
- Date
- Thread