## RTMechanisms: routines for the router mechanisms paper## this file contains primarily the support routines# to manage the flows.  The policies defined by the# tests are found in rtm_tests.tcl## conventions:# 	procs of the form "do_..."  are run periodically#	instvars starting with Capitals are constants#Class RTMechanismssource rtm_tests.tclsource rtm_link.tclRTMechanisms instproc tcp_ref_bw { mtu rtt droprate } {	if { $rtt == 0 || $droprate == 0 } {		return "none"	}	$self vprint 9 "mtu: $mtu rtt: $rtt droprate: $droprate"	set result [expr 1.22 * $mtu / ($rtt*sqrt($droprate))]	set sqrt [expr sqrt($droprate) ]	$self vprint 9 "sqrt: $sqrt result $result"	return [expr 1.22 * $mtu / ($rtt*sqrt($droprate))]}RTMechanisms instproc frac { num denom } {	if { $denom == 0 } {		return 0.0	}	return [expr double($num) / $denom]}RTMechanisms instproc vprint args {	$self instvar verbose_	set level [lindex $args 0]	set a [lrange $args 1 end]	if { $level <= $verbose_ } {		$self instvar ns_		puts "[$ns_ now] $a"		flush stdout	}}## mmetric: maxmetric or minmetric in the ok box#	op: one of "max" or "min"#	flows: list of flows#RTMechanisms instproc mmetric { op flows } {	$self instvar okboxfm_	set tot_bdrops [$okboxfm_ set bdrops_] ; # total bytes dropped	set tot_pdrops [$okboxfm_ set pdrops_] ; # total pkts dropped	set tot_ebdrops [$okboxfm_ set ebdrops_] ; # bytes dropped early (unforced)	set tot_epdrops [$okboxfm_ set epdrops_] ; # pkts drooped early (unforced)	set tot_fpdrops [expr $tot_pdrops - $tot_epdrops] ; 						# pkts dropped (forced)	set tot_fbdrops [expr $tot_bdrops - $tot_ebdrops] ; 						# bytes dropped (forced)	if { $op == "max" } {		set op ">"		set metric -1.0	} elseif { $op == "min" } {		set op "<"		set metric 1000000	}	set flow "none"	set unforced_frac [$self frac $tot_epdrops $tot_pdrops]	set forced_frac [expr 1 - $unforced_frac ]	foreach f $flows {		set fepdrops [$f set epdrops_]		set fpdrops [$f set pdrops_]		set fbdrops [$f set bdrops_]		set febdrops [$f set ebdrops_]					set forced_metric [$self frac [expr $fbdrops - $febdrops] $tot_fbdrops]		set unforced_metric [$self frac $fepdrops $tot_epdrops]		set fmetric [expr $forced_frac * $forced_metric + \			$unforced_frac * $unforced_metric]		if { [expr $fmetric $op $metric] } {			set metric $fmetric			set flow $f		}	}	return "$flow $metric"}RTMechanisms instproc setstate { flow reason bandwidth droprate } { 	$self instvar state_ ns_	$self vprint 1 "SETSTATE: flow: $flow NEWSTATE (reason:$reason, bw: $bandwidth, droprate: $droprate)"	set state_($flow,reason) $reason	set state_($flow,bandwidth) $bandwidth	set state_($flow,droprate) $droprate	set state_($flow,ctime) [$ns_ now]}# set new allotment in pboxRTMechanisms instproc pallot allotment {	$self instvar badclass_ goodclass_	$self instvar Maxallot_	$self vprint 0 "PALLOT: Allots: pbox: $allotment, okbox: [expr $Maxallot_ - $allotment]"	$badclass_ newallot $allotment	$goodclass_ newallot [expr $Maxallot_ - $allotment]}# add a flow to the flow history array (for unresponsive test)RTMechanisms instproc fhist-add { flow droprate bandwidth } {	$self instvar hist_next_ Hist_max_	$self instvar flowhist_	# circular history buffer	incr hist_next_	if { $hist_next_ >= $Hist_max_ } {		set hist_next_ 0	}	set flowhist_($hist_next_,name) $flow	set flowhist_($hist_next_,droprate) $droprate	set flowhist_($hist_next_,bandwidth) $bandwidth	$self vprint 1 "HISTORY ADDITION: flow: $flow, droprate: $droprate, bw: $bandwidth"	return $hist_next_}# find entry in hist buffer with lowest droprate, return its index# used for unresponsive testRTMechanisms instproc fhist-mindroprate flow {	$self instvar Hist_max_	$self instvar flowhist_	set dr 100000000	set idx -1	for { set i 0 } { $i < $Hist_max_ } { incr i } {		if { [info exists flowhist_($i,name)] &&		     $flowhist_($i,name) == $flow &&		     $flowhist_($i,droprate) < $dr } {			set dr $flowhist_($i,droprate)			set idx $i		}	}	$self vprint 1 "HISTORY MINDR SEARCH (flow: $flow): hmax: $Hist_max_, index: $idx"	return $idx}RTMechanisms instproc print_good_and_bad { label } {	$self instvar ns_	$self instvar okboxfm_ pboxfm_	$self instvar badclass_	set now [$ns_ now]	set ballot [$badclass_ allot]	puts [format "time %5.1f $label goodflows: [$okboxfm_ flows], badflows: [$pboxfm_ flows] (allot %4.2f, droprate: ??)" $now $ballot]}RTMechanisms instproc print_allot_change { oallot nallot } {	puts [format "pbox allotment changed from %6.5f to %6.5f" $oallot $nallot]}## move a flow to the bad box# ie penalize a flow#RTMechanisms instproc penalize { badflow guideline_bw } {	$self instvar npenalty_ badslot_ cbqlink_	$self instvar badclass_	$self instvar okboxfm_ pboxfm_	$self instvar Max_cbw_	$self vprint 1 "penalizing flow $badflow, guideline bw: $guideline_bw"	incr npenalty_	set classifier [$cbqlink_ classifier]	#	# add the bad flow to the cbq/mechanisms classifier	# the underlying object (badcl_) is already in $badslot_	#	set src [$badflow set src_]	set dst [$badflow set dst_]	set fid [$badflow set flowid_]	$classifier set-hash auto $src $dst $fid $badslot_	#	# remove flow record from ok fmon	# add it to pbox f mon	#	set okcl [$okboxfm_ classifier]	set okslot [$okcl del-hash $src $dst $fid]	$okcl clear $okslot	set bcl [$pboxfm_ classifier]	set bslot [$bcl installNext $badflow]	$badflow reset	$bcl set-hash auto $src $dst $fid $bslot	#	# reallocate allotment	#	set new_pbw [expr 0.5 * $guideline_bw * $npenalty_ ]	$self vprint 1 "npenalty $npenalty_ guideline_bw $guideline_bw"	if { $new_pbw > $Max_cbw_ } {		set $new_pbw $Max_cbw_	}	$self instvar badclass_	# link bw is in bits/sec	set bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]	$self vprint 1 "new_pbw $new_pbw bw $bw" 	set nallot [expr $new_pbw / $bw]	$self pallot $nallot	$self vprint 2 "penalize done.."}## move a flow to the good box# ie stop penalizing a flow#RTMechanisms instproc unpenalize goodflow {	$self instvar npenalty_ badslot_ badhead_ cbqlink_	$self instvar okboxfm_ pboxfm_	$self instvar badclass_	incr npenalty_ -1	set classifier [$cbqlink_ classifier]	$self vprint 0 "UNPENALIZE flow $goodflow"	#	# delete the bad flow from the cbq/mechanisms classifier	# this flow will return to the "default" case in the classifier	# do not "clear" the entry, as that would lose the reference	# to $badclass_ in the CBQ classifier	#	set src [$goodflow set src_]	set dst [$goodflow set dst_]	set fid [$goodflow set flowid_]	$classifier del-hash $src $dst $fid	#	# remove flow record from pbox fmon	# add it to okbox box fmon	#	set pcl [$pboxfm_ classifier]	set pslot [$pcl del-hash $src $dst $fid]	$pcl clear $pslot	set gcl [$okboxfm_ classifier]	set gslot [$gcl installNext $goodflow]	$goodflow reset	$gcl set-hash auto $src $dst $fid $gslot	#	# reallocate allotment	#	set bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]	set oallot [$badclass_ allot]	set cbw [expr $oallot * $bw]	set new_cbw [expr $npenalty_ * $cbw / ($npenalty_ + 1)]	set nallot [expr $new_cbw / $bw]	$self pallot $nallot	$self vprint 2 "unpenalize done..."}# Check if bandwidth in penalty box should be adjusted.# basen on some change in npenalty_RTMechanisms instproc checkbw_fair guideline_bw {	$self instvar badclass_	$self instvar npenalty_ cbqlink_	if { $guideline_bw == "none" } {		return "ok"	}	set new_cbw [expr 0.5 * $guideline_bw * $npenalty_]	set link_bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]	set old_allot [$badclass_ allot]	set class_bw [expr $old_allot * $link_bw]	if { $new_cbw < $class_bw } {		set new_allot [expr $new_cbw / $link_bw]		return $new_allot	}	return "ok"}