#		if { [string last _ $var] != ( [string length $var] - 1) } {			set var ${var}_		}		if { $var == "queue-limit_" } {			set var "limit_"		}		if { [lsearch $qvars $var] >= 0 } {			# set a queue var			return [$queue_ set $var]		} elseif { [lsearch $linkvars $var] >= 0 } {			# set a link OTcl var			return [$linkref_ set $var]		} elseif { [lsearch $linkdelayvars $var] >= 0 } {			# set a linkdelay object var			return [[$linkref_ link] set $var]		} else {			puts stderr "linkHelper warning: couldn't set unknown variable $var"			return ""		}		return ""	}	#	# gross, but works:	#	# In ns-1 queues were a sublass of link, and this compat	# code carries around a 'linkHelper' as the returned object	# when you do a [ns link $r1 $r2] or a [ns link $r1 $r2 $qtype]	# command.  So, operations on this object could have been	# either link ops or queue ops in ns-1.  It is possible to see	# whether an Otcl class or object supports certain commands	# but it isn't possible to look inside a C++ implemented object	# (i.e. into it's cmd function) to see what it supports.  Instead,	# arrange to catch the exception generated while trying into a	# not-implemented method in a C++ object.	#	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 it's a OTcl-implemented method we see it in info		# and thus don't need to catch it		if { $operation != "cmd" } {			if { [lsearch $iprocs $operation] >= 0 } {				return [eval $op]			}			if { [lsearch $oprocs $operation] >= 0 } {				return [eval $op]			}		}		#catch the c++-implemented method in case it's not there		#ret will contain error string or return string		# value of catch operation will be 1 on error		if [catch $op ret] {			return -1		}		return $ret	}	# so, try to invoke the op on a queue and if that causes	# an exception (a missing function hopefully) try it on	# the link instead	#	# we need to override 'TclObject instproc unknown args'	# (well, at least we did), because it was coded such that	# if a command() function didn't exist, an exit 1 happened	#	linkHelper instproc unknown { m args } {		# method could be in: queue, link, linkdelay		# or any of its command procedures		# note that if any of those have errors in them		# we can get a general error by ending up at the end here		$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		}		# try an OTcl queue then the underlying queue object		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_]		# note: in ns-1 the packets/bytes stats are counts		# of the number of *departures* at a link/queue		#		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_]	}	#	# end linkHelper	#	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	#	# this is a hack to deal with the unfortunate name	# of a CBQ class chosen in ns-1 (i.e. "class").	#	# the "new" procedure in Tcl/tcl-object.tcl will end	# up calling:	#	eval class create id ""	# so, catch this here... yuck        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		}                #                # we need to prevent a "phantom" argument from                # showing up in the argument list to [CBQClass create],                # so, don't pass an empty string if we weren't                # called with one!                #                # by calling through [eval], we suppress any {} that                # might result from the [lrange ...] below                #                eval CBQClass create $id [lrange $args 2 [expr $arglen - 1]]	}}## links in ns-1 had support for statistics collection...# $link stat packets/bytes/drops#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)]	# new mapping old class -> flowid	$agent set fid_ $pktClass	$self attach-agent $node $agent# This has been replaced by TclObject instproc get.  -johnh, 10-Sep-97##	$agent proc get var {#		return [$self set $var]#	}	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]}## return helper object for backward compat of "ns link" command#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 } {	# new link with 0 bandwidth and 0 delay	$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 } {        # this was never used in ns-1        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]}## Create a source/sink connection pair and return the source agent.# proc ns_create_connection { srcType srcNode sinkType sinkNode pktClass } {	ns create-connection $srcType $srcNode $sinkType \		$sinkNode $pktClass}## Create a source/sink CBR pair and return the source agent.# 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}## compat code for CBQ#proc ns_create_class { parent borrow allot maxidle notused prio depth xdelay } {	set cl [new CBQClass]	#	# major hack: if the prio is 8 (the highest in ns-1) it's	# an internal node, hence no queue disc	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}## If $maxIdle is "auto", set maxIdle to Max[t(1/p-1)(1-g^n)/g^n, t(1-g)].# For p = allotment, t = packet transmission time, g = weight for EWMA.# The parameter t is calculated for a medium-sized 1000-byte packet.#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}## backward compat for agent methods that were replaced# by OTcl instance variables#Agent instproc connect d {	$self set dst_ $d}# XXX changed call from "handle" to "recv"Agent/Message instproc recv msg {	$self handle $msg}#Renamed variables in Queue/RED and Queue/DropTailQueue/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}