## Copyright (c) 1996-1997 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 MASH Research# 	Group at the University of California Berkeley.# 4. Neither the name of the University nor of the Research Group 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/lib/ns-compat.tcl,v 1.46 2000/06/27 00:05:01 sfloyd Exp $#Class OldSim -superclass Simulator## If the "ns" command is called, set up the simulator# class to assume backward compat.  This creates an instance# of a backward-compat simulator API with the name "ns"# (which in turn overrides this proc)#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_]	#	# special case the link array	#	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	}	#	# now everyone else	#	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}## see if this array has any elements already set# if so, arrange for the value to be set in ns-2# also, add a trace hook so that future changes get# reflected into ns-2#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	}	# arrange to trace any read/write/unset op	trace variable $old_arr rwu "$self default_catch"}OldSim instproc trace_old_defaults {} {	# all ns-v1 defaults as of 1.4	$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	#	# Always use the list scheduler.	$self instvar scheduler_	set scheduler_ [new Scheduler/List]	#	# in CBQ, setting the algorithm_ variable becomes invoking	# the algorithm method	#	# also, there really isn't a limit_ for CBQ, as each queue	# has its own.	#	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]			# note: no return here		}		eval $self next $args	}        #        # Catch queue-limit variable which is now "$q limit"        #        Queue/DropTail instproc set args {                if { [llength $args] == 2 &&                        [lindex $args 0] == "queue-limit" } {                        # this will recursively call ourself                        $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" } {                        # this will recursively call ourself                        $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	}	#	# Catch set maxpkts for FTP sources, (needed because Source objects are	# not derived from TclObject, and hence can't use varMap method below)	#	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	}	#	# Support for things like "set ftp [$tcp source ftp]"	#	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	#	# support for new variable names	# it'd be nice to set up mappings on a per-class	# basis, but this is too painful.  Just do the	# mapping across all objects and hope this	# doesn't cause any collisions...	#	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]"		}		# xxx: re-implement the code from tcl-object.tcl		$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)] {			# puts stderr "TclObject::get $var -> $varMap_($var)."			return [$self set $varMap_($var)]		} else {			return [$self next $var]		}	}	# Agent	TclObject set varMap_(addr) addr_	TclObject set varMap_(dst) dst_## now gone###TclObject set varMap_(seqno) seqno_###TclObject set varMap_(cls) class_## class -> flow id	TclObject set varMap_(cls) fid_	# Trace	TclObject set varMap_(src) src_	TclObject set varMap_(show_tcphdr) show_tcphdr_	# TCP	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_	# Agent/TCP/NewReno	TclObject set varMap_(changes) newreno_changes_	# Agent/TCP/Fack	TclObject set varMap_(rampdown) rampdown_ 	TclObject set varMap_(ss-div4) ss-div4_	# Queue	TclObject set varMap_(limit) limit_	# Queue/SFQ	TclObject set varMap_(limit) maxqueue_	TclObject set varMap_(buckets) buckets_	# Queue/RED	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_	# CBQClass	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_	# Agent/TCPSinnk, Agent/CBR	TclObject set varMap_(packet-size) packetSize_	TclObject set varMap_(interval) interval_	# Agent/CBR	TclObject set varMap_(random) random_	# IVS	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	}	#	# linkHelper	# backward compat for "[ns link $n1 $n2] set linkVar $value"	#	# unfortunately, 'linkVar' in ns-1 can be associated	# with a link (delay, bandwidth, generic queue requests) or	# can be specific to a particular queue (e.g. RED) which	# has a bunch of variables (see above).	#	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]		# these will be used in support of link stats		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		# XXX: special-case RED queue for var tracing		if { [string first Queue/RED [$queue_ info class]] == 0 } {			$queue_ enable-vartrace $tfile		}	} 	linkHelper instproc callback {fn} {		# Reach deep into the guts of the link and twist...		# (This code makes assumptions about how		# SimpleLink instproc trace works.)		# NEEDSWORK: should this be done with attach-monitors? 		$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]		#		# adjust the string to have a trailing '_'		# because all instvars are constructed that way		#		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			$queue_ set $var $val		} elseif { [lsearch $linkvars $var] >= 0 } {			# set a link OTcl var			$linkref_ set $var $val		} elseif { [lsearch $linkdelayvars $var] >= 0 } {			# set a linkdelay object var			[$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]		#		# adjust the string to have a trailing '_'		# because all instvars are constructed that way