test-suite-cbq.tcl

柯老师网站上找到的

#
# Copyright (c) 1995-1997 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the Computer Systems
#	Engineering Group at Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /nfs/jade/vint/CVSROOT/ns-2/tcl/test/test-suite-cbq.tcl,v 1.27 1999/09/15 03:05:07 sfloyd Exp $
#
#
# This test suite reproduces the tests from the following note:
# Floyd, S., Ns Simulator Tests for Class-Based Queueing, February 1996.
# URL ftp://ftp.ee.lbl.gov/papers/cbqsims.ps.Z.
#
# To run individual tests:
# 	./ns test-suite-cbq.tcl cbqPRR 
# 	./ns test-suite-cbq.tcl cbqWRR
# 	...
#

set dir [pwd]
catch "cd tcl/test"
source misc.tcl
source topologies.tcl
catch "cd $dir"

TestSuite instproc make_queue { cl qlim } {
	$self instvar cbq_qtype_
	set q [new Queue/$cbq_qtype_]
	$q set limit_ $qlim
	$cl install-queue $q
}

TestSuite instproc make_fmon cbqlink {
	$self instvar ns_ fmon_
	set fmon_ [$ns_ makeflowmon Fid]
	$ns_ attach-fmon $cbqlink $fmon_
}

# ~/newr/rm/testB
# Create a flat link-sharing structure.
#
#	3 leaf classes:
#		vidClass	(32%), pri 1
#		audioClass	(03%), pri 1
#		dataClass	(65%), pri 2
#

TestSuite instproc create_flat { audborrowok audxdelay} {
	$self instvar topclass_ vidclass_ audioclass_ dataclass_
	$self instvar cbq_qtype_

	set qlim 20
	set cbq_qtype_ DropTail

	set topclass_ [new CBQClass]
	# (topclass_ doesn't have a queue)
	$topclass_ setparams none 0 0.98 auto 8 2 0

 	set vidclass_ [new CBQClass]
	$self make_queue $vidclass_ $qlim
	$vidclass_ setparams $topclass_ true 0.32 auto 1 1 0

	set audioclass_ [new CBQClass]
	$self make_queue $audioclass_ $qlim
	$audioclass_ setparams $topclass_ $audborrowok 0.03 auto 1 1 $audxdelay

	set dataclass_ [new CBQClass]
	$self make_queue $dataclass_ $qlim
	$dataclass_ setparams $topclass_ true 0.65 auto 2 1 0
}

TestSuite instproc insert_flat cbqlink {
	$self instvar topclass_ vidclass_ audioclass_ dataclass_

	#
	# note: auto settings for maxidle are resolved in insert
	# (see tcl/lib/ns-queue.tcl)
	#

 	$cbqlink insert $topclass_
	$cbqlink insert $vidclass_
 	$cbqlink insert $audioclass_
        $cbqlink insert $dataclass_

	$cbqlink bind $vidclass_ 2;# fid 2
 	$cbqlink bind $audioclass_ 1;# fid 1
	$cbqlink bind $dataclass_ 3; # fid 3
}

TestSuite instproc create_flat2 { audmaxidle audxdelay } {
	$self instvar topclass_ audioclass_ dataclass_
	$self instvar cbq_qtype_

	set qlim 1000
	set cbq_qtype_ DropTail

	set topclass_ [new CBQClass]
	# (topclass_ doesn't have a queue)
	$topclass_ setparams none false 0.97 1.0 8 2 0

	set audioclass_ [new CBQClass]
	$self make_queue $audioclass_ $qlim
	$audioclass_ setparams $topclass_ false 0.30 $audmaxidle 1 1 $audxdelay

	set dataclass_ [new CBQClass]
	$self make_queue $dataclass_ $qlim
	$dataclass_ setparams $topclass_ true 0.30 auto 2 1 0
}

TestSuite instproc create_flat3 { rootbw rootmaxidle } {
	$self instvar topclass_ audioclass_ dataclass_
	$self instvar cbq_qtype_

	set qlim 20
	set cbq_qtype_ DropTail

	set topclass_ [new CBQClass]
	# (topclass_ doesn't have a queue)
	$topclass_ setparams none false $rootbw $rootmaxidle 8 2 0

	set audioclass_ [new CBQClass]
	$self make_queue $audioclass_ $qlim
	$audioclass_ setparams $topclass_ true 0.01 auto 1 1 0

	set dataclass_ [new CBQClass]
	$self make_queue $dataclass_ $qlim
	$dataclass_ setparams $topclass_ true 0.99 auto 2 1 0
}

TestSuite instproc create_flat4 { rootbw rootmaxidle {audiobw 0.01} 
   {databw 0.99} {qlim 20} } {
	$self instvar topclass_ audioclass_ dataclass_
	$self instvar cbq_qtype_

	set cbq_qtype_ DropTail

	set topclass_ [new CBQClass]
	# (topclass_ doesn't have a queue)
	$topclass_ setparams none false $rootbw $rootmaxidle 8 2 0

	set audioclass_ [new CBQClass]
	$self make_queue $audioclass_ $qlim
	$audioclass_ setparams $topclass_ true $audiobw auto 1 1 0

	set dataclass_ [new CBQClass]
	$self make_queue $dataclass_ $qlim
	$dataclass_ setparams $topclass_ true $databw auto 1 1 0
}

TestSuite instproc insert_flat2 cbqlink {
	$self instvar topclass_ audioclass_ dataclass_

	#
	# note: auto settings for maxidle are resolved in insert
	# (see tcl/lib/ns-queue.tcl)
	#

 	$cbqlink insert $topclass_
 	$cbqlink insert $audioclass_
        $cbqlink insert $dataclass_

 	$cbqlink bind $audioclass_ 1;# fid 1
	$cbqlink bind $dataclass_ 2; # fid 2
}

# Create a two-agency link-sharing structure.
#
#	4 leaf classes for 2 "agencies":
#		vidAClass	(30%), pri 1
#		dataAClass	(40%), pri 2
#		vidBClass	(10%), pri 1
#		dataBClass	(20%), pri 2
#
TestSuite instproc create_twoagency { } {

	$self instvar cbqalgorithm_
	$self instvar topClass_ topAClass_ topBClass_

	set qlim 20

	set topClass_ [new CBQClass]
	set topAClass_ [new CBQClass]
	set topBClass_ [new CBQClass]

	if { $cbqalgorithm_ == "ancestor-only" } { 
		# For Ancestor-Only link-sharing. 
		# Maxidle should be smaller for AO link-sharing.
		$topClass_ setparams none 0 0.97 auto 8 3 0
		$topAClass_ setparams $topClass_ 1 0.69 auto 8 2 0
		$topBClass_ setparams $topClass_ 1 0.29 auto 8 2 0
	} elseif { $cbqalgorithm_ == "top-level" } {
		# For Top-Level link-sharing?
		# borrowing from $topAClass_ is occuring before from $topClass
		# yellow borrows from $topBClass_
		# Goes green borrow from $topClass_ or from $topAClass?
		# When $topBClass_ is unsatisfied, there is no borrowing from
		#  $topClass_ until a packet is sent from the yellow class.
		$topClass_ setparams none 0 0.97 0.001 8 3 0
		$topAClass_ setparams $topClass_ 1 0.69 auto 8 2 0
		$topBClass_ setparams $topClass_ 1 0.29 auto 8 2 0
	} elseif { $cbqalgorithm_ == "formal" } {
		# For Formal link-sharing
		# The allocated bandwidth can be exact for parent classes.
		$topClass_ setparams none 0 1.0 1.0 8 3 0
		$topAClass_ setparams $topClass_ 1 0.7 1.0 8 2 0
		$topBClass_ setparams $topClass_ 1 0.3 1.0 8 2 0
	}

	$self instvar vidAClass_ vidBClass_ dataAClass_ dataBClass_

	set vidAClass_ [new CBQClass]
	$vidAClass_ setparams $topAClass_ 1 0.3 auto 1 1 0
	set dataAClass_ [new CBQClass]
 	$dataAClass_ setparams $topAClass_ 1 0.4 auto 2 1 0
 	set vidBClass_ [new CBQClass]
 	$vidBClass_ setparams $topBClass_ 1 0.1 auto 1 1 0
 	set dataBClass_ [new CBQClass]
 	$dataBClass_ setparams $topBClass_ 1 0.2 auto 2 1 0

	# (topclass_ doesn't have a queue)
	$self instvar cbq_qtype_
	set cbq_qtype_ DropTail
	$self make_queue $vidAClass_ $qlim
	$self make_queue $dataAClass_ $qlim
	$self make_queue $vidBClass_ $qlim
	$self make_queue $dataBClass_ $qlim
}

TestSuite instproc insert_twoagency cbqlink {

	$self instvar topClass_ topAClass_ topBClass_
	$self instvar vidAClass_ vidBClass_
	$self instvar dataAClass_ dataBClass_

	$cbqlink insert $topClass_
 	$cbqlink insert $topAClass_
 	$cbqlink insert $topBClass_
	$cbqlink insert $vidAClass_
	$cbqlink insert $vidBClass_
        $cbqlink insert $dataAClass_
        $cbqlink insert $dataBClass_

	$cbqlink bind $vidAClass_ 1
	$cbqlink bind $dataAClass_ 2
	$cbqlink bind $vidBClass_ 3
	$cbqlink bind $dataBClass_ 4
}

# display graph of results
TestSuite instproc finish testname {
	global quiet 
	$self instvar tmpschan_ tmpqchan_ topo_
	$topo_ instvar cbqlink_

	set graphfile temp.rands
	set bw [[$cbqlink_ set link_] set bandwidth_]
	set maxbytes [expr $bw / 8.0]

	set awkCode  {
		$2 == fid { print $1, $3/maxbytes }
	}
	set awkCodeAll {
		$2 == fid { print time, sum; sum = 0 }
		{
			sum += $3/maxbytes;
			if (NF==3)
				time = $1;
			else
				time = 0;
		}
	}

	if { [info exists tmpschan_] } {
		close $tmpschan_
	}
	if { [info exists tmpqchan_] } {
		close $tmpqchan_
	}

	set f [open $graphfile w]
	puts $f "TitleText: $testname"
	puts $f "Device: Postscript"
	
	exec rm -f temp.p
	exec touch temp.p
	foreach i { 1 2 3 4 } {
		exec echo "\n\"flow $i" >> temp.p
		exec awk $awkCode fid=$i maxbytes=$maxbytes temp.s > temp.$i
		exec cat temp.$i >> temp.p
		exec echo " " >> temp.p
	}

	exec awk $awkCodeAll fid=1 maxbytes=$maxbytes temp.s > temp.all
	exec echo "\n\"all " >> temp.p  
	exec cat temp.all >> temp.p 

	exec cat temp.p >@ $f
	close $f
	if {$quiet == "false"} {
		exec xgraph -bb -tk -x time -y bandwidth $graphfile &
	}
#	exec csh figure2.com $file
	
	exit 0
}

#
# Save the number of bytes sent by each class in each time interval.
# File: temp.s
#
TestSuite instproc cbrDump4 { linkno interval stopTime maxBytes } {
	set dumpfile temp.s
	$self instvar oldbytes_
	$self instvar ns_

	TestSuite instproc cdump { lnk interval file }  {
	  global quiet
	  $self instvar oldbytes_
	  $self instvar ns_ fmon_
	  set now [$ns_ now]
	  set fcl [$fmon_ classifier]
	  set fids { 1 2 3 4 }

	  if {$quiet == "false"} {
	  	puts "$now"
	  }
	  foreach i $fids {
		  set flow($i) [$fcl lookup auto 0 0 $i]
		  if { $flow($i) != "" } {
			  set bytes($i) [$flow($i) set bdepartures_]
			  puts $file "$now $i [expr $bytes($i) - $oldbytes_($i)]"
			  set oldbytes_($i) $bytes($i)
		  }
	  }
	  $ns_ at [expr $now + $interval] "$self cdump $lnk $interval $file"
	}

	set fids { 1 2 3 4 }
	foreach i $fids {
		set oldbytes_($i) 0
	}

	$self instvar tmpschan_
	set f [open $dumpfile w]
	set tmpschan_ $f
	puts $f "maxbytes $maxBytes"
	$ns_ at 0.0 "$self cdump $linkno $interval $f"

	TestSuite instproc cdumpdel file {
	  $self instvar ns_ fmon_
	  set now [$ns_ now]
	  set fcl [$fmon_ classifier]

	  set fids { 1 2 3 4 }
	  foreach i $fids {
		  set flow [$fcl lookup auto 0 0 $i]
		  if { $flow != "" } {
			  set dsamp [$flow get-delay-samples]
			  puts $file "$now $i [$dsamp mean]"
		  }
	  }
	}
	$self instvar tmpqchan_
	set f1 [open temp.q w]
	set tmpqchan_ $f1
	puts $f1 "delay"
	$ns_ at $stopTime "$self cdumpdel $f1"
}

#
# Save the queueing delay seen by each class.
# File: temp.q
# Format: time, class, delay
#
# proc cbrDumpDel { linkno stopTime } {
# 	proc cdump { lnk file }  {
# 	  set timenow [ns now]
# 	  # format: time, class, delay
# 	  puts $file "$timenow 1 [$lnk stat 1 mean-qsize]"
# 	  puts $file "$timenow 2 [$lnk stat 2 mean-qsize]"
# 	  puts $file "$timenow 3 [$lnk stat 3 mean-qsize]"
# 	  puts $file "$timenow 4 [$lnk stat 4 mean-qsize]"
# 	}
# 	set f1 [open temp.q w]
# 	puts $f1 "delay"
# 	ns at $stopTime "cdump $linkno $f1"
# 	ns at $stopTime "close $f1"
# }

#
# Create three CBR connections.
#
TestSuite instproc three_cbrs {} {
	$self instvar ns_ node_
	set udp1 [$ns_ create-connection UDP $node_(s1) LossMonitor $node_(r2) 1]
	set cbr1 [new Application/Traffic/CBR]
	$cbr1 attach-agent $udp1
	$cbr1 set packetSize_ 190
	$cbr1 set rate_ 1.52Mb; # interval of 0.001

	set udp2 [$ns_ create-connection UDP $node_(s2) LossMonitor $node_(r2) 2]
	set cbr2 [new Application/Traffic/CBR]
	$cbr2 attach-agent $udp2
	$cbr2 set packetSize_ 500
	$cbr2 set rate_ 2Mb; # interval of 0.002

	set udp3 [$ns_ create-connection UDP $node_(s3) LossMonitor $node_(r2) 3]
	set cbr3 [new Application/Traffic/CBR]
	$cbr3 attach-agent $udp3
	$cbr3 set packetSize_ 1000 
	$cbr3 set rate_ 1.6Mb; # interval of 0.005

	$ns_ at 0.0 "$cbr1 start; $cbr2 start; $cbr3 start"
        $ns_ at 4.0 "$cbr3 stop"
        $ns_ at 8.0 "$cbr3 start"
        $ns_ at 12.0 "$cbr2 stop"
        $ns_ at 18.0 "$cbr2 start"
	$ns_ at 20.0 "$cbr1 stop"