rtm_reclass.tcl

CBRP协议（移动adhoc中基于分簇的路由协议）ns2下的源码

    $self new_tcp 34.2 $node_(s3) $node_(s1) 50 5 0 1500 sack 0
    $self new_tcp 35.6 $node_(s5) $node_(s4) 50 6 0 1500 sack 0
    $self new_tcp 56.0 $node_(s4) $node_(s2) 50 7 0 1500 sack 0
    $self new_tcp 37.3 $node_(s2) $node_(s6) 50 8 0 1500 sack 0
    $self new_tcp 78.0 $node_(s1) $node_(s3) 50 9 0 1500 sack 0
    $self new_tcp 39.5 $node_(s3) $node_(s2) 50 10 0 1500 sack 0
    $self new_tcp 85.6 $node_(s2) $node_(s6) 50 11 0 1500 sack 0
    $self new_tcp 30.2 $node_(s1) $node_(s4) 50 12 0 1500 sack 0
    $self new_tcp 21.3 $node_(s5) $node_(s6) 50 13 0 1500 sack 0
    $self new_tcp 32.9 $node_(s3) $node_(s2) 50 14 0 1500 sack 0
    $self new_tcp 23.8 $node_(s2) $node_(s3) 50 15 0 1500 sack 0
    $self new_tcp 34.0 $node_(s5) $node_(s6) 50 16 0 1500 sack 0
    $self new_tcp 55.5 $node_(s2) $node_(s4) 50 17 0 1500  sack 0
    $self new_tcp 36.1 $node_(s1) $node_(s4) 50 18 0 1500 sack 0
    $self new_tcp 45.6 $node_(s5) $node_(s4) 50 19 0 1500 sack 0
    $self new_tcp 47.3 $node_(s2) $node_(s6) 50 20 0 1500 sack 0
    $self new_tcp 68.0 $node_(s1) $node_(s4) 50 21 0 1500 sack 0
    $self new_tcp 42.6 $node_(s5) $node_(s4) 50 22 0 1500 sack 0
    $self new_tcp 43.3 $node_(s2) $node_(s6) 50 23 0 1500 sack 0
    $self new_tcp 46.0 $node_(s1) $node_(s4) 50 24 0 1500 sack 0
    $self new_tcp 42.6 $node_(s5) $node_(s4) 50 25 0 1500 sack 0
    $self new_tcp 43.3 $node_(s2) $node_(s6) 50 26 0 1500 sack 0
    $self new_tcp 41.0 $node_(s1) $node_(s4) 50 27 0 1500 sack 0
    $self new_tcp 46.6 $node_(s5) $node_(s4) 50 28 0 1500 sack 0
    $self new_tcp 48.3 $node_(s2) $node_(s6) 50 29 0 1500 sack 0
    $self new_tcp 45.0 $node_(s1) $node_(s4) 50 30 0 1500 sack 0
}



#
# Create traffic.
#
TestSuite instproc more_cbrs {} {
    $self instvar node_ 
    $self new_cbr 105.0 $node_(s2) $node_(s4) 200 0.006 22 50000
    $self new_cbr 234.0 $node_(s1) $node_(s3) 220 0.01 23 10000
    $self new_cbr 277.0 $node_(s1) $node_(s3) 180 0.01 24 10000
    $self new_cbr 283.0 $node_(s1) $node_(s3) 220 0.02 26 5000
    $self new_cbr 289.0 $node_(s1) $node_(s3) 180 0.02 27 5000
}

#-----------------------

Class Test/one -superclass TestSuite
Test/one instproc init { topo name enable } {
        $self instvar net_ defNet_ test_ enable_
        set net_ $topo   
        set defNet_ net2
        set test_ $name
	set enable_ $enable
        $self next
	$self config $name
}

#
# For test in Figure 11 of the paper.
#
Test/one instproc run {} {
    $self instvar ns_ net_ topo_ enable_
    $topo_ instvar cbqlink_ node_ rtt_
    set cbqlink $cbqlink_

    set stoptime 600.0
#    set stoptime 100.0

	set mtu 1500

	set rtm [new RTMechanisms $ns_ $cbqlink $rtt_ $mtu $enable_]

	$self instvar goodflowfile_
	set gfm [$rtm makeflowmon]
	set gflowf [open $goodflowfile_ w]
	$gfm set enable_in_ false	; # no per-flow arrival state
	$gfm set enable_out_ false	; # no per-flow departure state
	$gfm attach $gflowf

	$self instvar badflowfile_
	set bfm [$rtm makeflowmon]
	set bflowf [open $badflowfile_ w]
	$bfm attach $bflowf

	$rtm makeboxes $gfm $bfm 100 1000
	$rtm bindboxes
	set L1 [$rtm monitor-link]
	$self linkDumpFlows $L1 20.0 $stoptime

	$self traffic2
	$ns_ at $stoptime "$self finish"

	ns-random 0
	$ns_ run
}

#--------

Class Test/two -superclass TestSuite
Test/two instproc init { topo name enable } {
        $self instvar net_ defNet_ test_ enable_
        set net_ $topo   
        set defNet_ net2
        set test_ $name
	set enable_ $enable
        $self next
	$self config $name
}

#
# UNFRIENDLY test.
#
Test/two instproc run {} {
    $self instvar ns_ net_ topo_ enable_
    $topo_ instvar cbqlink_ node_ rtt_
    set cbqlink $cbqlink_

#    set stoptime 600.0
    set stoptime 100.0

	set mtu 1500

	set rtm [new RTMechanisms $ns_ $cbqlink $rtt_ $mtu $enable_]

	$self instvar goodflowfile_
	set gfm [$rtm makeflowmon]
	set gflowf [open $goodflowfile_ w]
	$gfm set enable_in_ false	; # no per-flow arrival state
	$gfm set enable_out_ false	; # no per-flow departure state
	$gfm attach $gflowf

	$self instvar badflowfile_
	set bfm [$rtm makeflowmon]
	set bflowf [open $badflowfile_ w]
	$bfm attach $bflowf

	$rtm makeboxes $gfm $bfm 100 1000
	$rtm bindboxes
	set L1 [$rtm monitor-link]
	$self linkDumpFlows $L1 1.0 $stoptime

	$self traffic2
#	$self traffic3
#        $self more_cbrs
	$ns_ at $stoptime "$self finish"

	ns-random 0
	$ns_ run
}

#--------

Class Test/three -superclass TestSuite
Test/three instproc init { topo name enable } {
        $self instvar net_ defNet_ test_ enable_
        set net_ $topo   
        set defNet_ net2
        set test_ $name
	set enable_ $enable
        $self next
	$self config $name
}

#
# UNFRIENDLY test.
#
Test/three instproc run {} {
    $self instvar ns_ net_ topo_ enable_
    $topo_ instvar cbqlink_ node_ rtt_
    set cbqlink $cbqlink_

#    set stoptime 600.0
    set stoptime 100.0

	set mtu 1500

	set rtm [new RTMechanisms $ns_ $cbqlink $rtt_ $mtu $enable_ ]

	$self instvar goodflowfile_
	set gfm [$rtm makeflowmon]
	set gflowf [open $goodflowfile_ w]
	$gfm set enable_in_ false	; # no per-flow arrival state
	$gfm set enable_out_ false	; # no per-flow departure state
	$gfm attach $gflowf

	$self instvar badflowfile_
	set bfm [$rtm makeflowmon]
	set bflowf [open $badflowfile_ w]
	$bfm attach $bflowf

	$rtm makeboxes $gfm $bfm 100 1000
	$rtm bindboxes
	set L1 [$rtm monitor-link]
	$self linkDumpFlows $L1 1.0 $stoptime

	$self traffic4
	$ns_ at $stoptime "$self finish"

	ns-random 0
	$ns_ run
}

#---------


TestSuite proc usage {} {
        global argv0
        puts stderr "usage: ns $argv0 <tests> \[<topologies>\] \[enable|disable\]"
        puts stderr "Valid tests are:\t[$self get-subclasses TestSuite Test/]"
        puts stderr "Valid Topologies are:\t[$self get-subclasses SkelTopology Topology/]"
        exit 1
}

TestSuite proc isProc? {cls prc} {
        if [catch "Object info subclass $cls/$prc" r] {
                global argv0
                puts stderr "$argv0: no such $cls: $prc"
                $self usage
        }
}

TestSuite proc get-subclasses {cls pfx} {
        set ret ""
        set l [string length $pfx]

        set c $cls
        while {[llength $c] > 0} {
                set t [lindex $c 0]
                set c [lrange $c 1 end]
                if [string match ${pfx}* $t] {
                        lappend ret [string range $t $l end]
                }
                eval lappend c [$t info subclass]
        }
        set ret
}

TestSuite proc runTest {} {
	global argc argv
	set enable true
        switch $argc {
                1 {
                        set test $argv
                        $self isProc? Test $test

                        set topo ""
                }
                2 {
                        set test [lindex $argv 0]
                        $self isProc? Test $test

                        set topo [lindex $argv 1]
                        $self isProc? Topology $topo
                }
                3 {
                        set test [lindex $argv 0]
                        $self isProc? Test $test

                        set topo [lindex $argv 1]
                        $self isProc? Topology $topo

                        set enable [lindex $argv 2]
			if { $enable == "disable" } {
				set enable false
			} else {
				set enable true
			}

                }
                default {
                        $self usage
                }
        }
        set t [new Test/$test $topo $test $enable]
        $t run
}

TestSuite runTest