# -*-	Mode:tcl; tcl-indent-level:8; tab-width:8; indent-tabs-mode:t -*-## Copyright (c) 1996 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-lib.tcl,v 1.226 2001/05/27 18:24:14 sfloyd Exp $## Word of warning to developers:# this code (and all it sources) is compiled into the# ns executable.  You need to rebuild ns or explicitly# source this code to see changes take effect.## Debojyoti added this#set edges_ [new IDs]#set connections_ [new IDs]set slinks_(0:0) 0set nconn_ 0 set conn_(0) 0:0proc warn {msg} {	global warned_	if {![info exists warned_($msg)]} {		puts stderr "warning: $msg"		set warned_($msg) 1	}}if {[info commands debug] == ""} {	proc debug args {		warn {Script debugging disabled.  Reconfigure with --with-tcldebug, and recompile.}	}}proc assert args {        if [catch "expr $args" ret] {                set ret [eval expr $args]        }        if {! $ret} {                error "assertion failed: $args"        }}proc find-max list {	set max 0	foreach val $list {		if {$val > $max} {			set max $val		}	}	return $max}proc bw_parse { bspec } {	if { [scan $bspec "%f%s" b unit] == 1 } {		set unit bps	}	regsub {[/p]s(ec)?$} $unit {} unit	if [string match {*B} $unit] {		set b [expr $b*8]		set unit "[string trimright B $unit]b"	}	switch $unit {		b { return $b }		kb { return [expr $b*1000] }		Mb { return [expr $b*1000000] }		Gb { return [expr $b*1000000000] }		default { 			puts "error: bw_parse: unknown unit `$unit'" 			exit 1		}	}}proc time_parse { spec } {	if { [scan $spec "%f%s" t unit] == 1 } {		set unit s	}	regsub {sec$} $unit {s} unit	switch $unit {		s { return $t }		ms { return [expr $t*1e-3] }		us { return [expr $t*1e-6] }		ns { return [expr $t*1e-9] }		ps { return [expr $t*1e-12] }		default { 			puts "error: time_parse: unknown unit `$unit'" 			exit 1		}	}}proc delay_parse { spec } {	return [time_parse $spec]}## Create the core OTcl class called "Simulator".# This is the principal interface to the simulation engine.##Class Simulator## XXX Whenever you modify the source list below, please also change the# OTcl script dependency list in Makefile.in#source ns-autoconf.tclsource ns-address.tclsource ns-node.tclsource ns-rtmodule.tclsource ns-hiernode.tclsource ns-mobilenode.tclsource ns-bsnode.tclsource ns-link.tclsource ns-source.tclsource ns-compat.tclsource ns-packet.tclsource ns-queue.tclsource ns-trace.tclsource ns-random.tclsource ns-agent.tclsource ns-route.tclsource ns-errmodel.tclsource ns-intserv.tclsource ns-cmutrace.tclsource ns-mip.tclsource ns-sat.tclsource ns-nix.tclsource ../rtp/session-rtp.tclsource ../interface/ns-iface.tclsource ../lan/ns-mac.tclsource ../lan/ns-ll.tclsource ../lan/vlan.tclsource ../lan/abslan.tclsource ../mcast/timer.tclsource ../mcast/ns-mcast.tclsource ns-srcrt.tclsource ../mcast/McastProto.tclsource ../mcast/DM.tclsource ../ctr-mcast/CtrMcast.tclsource ../ctr-mcast/CtrMcastComp.tclsource ../ctr-mcast/CtrRPComp.tclsource ../mcast/BST.tclsource ../mcast/srm.tclsource ../mcast/srm-ssm.tclsource ../mcast/mftp_snd.tclsource ../mcast/mftp_rcv.tclsource ../mcast/mftp_rcv_stat.tclsource ../mcast/McastMonitor.tclsource ../rlm/rlm.tclsource ../rlm/rlm-ns.tclsource ../session/session.tclsource ../webcache/http-server.tclsource ../webcache/http-cache.tclsource ../webcache/http-agent.tclsource ../webcache/http-mcache.tclsource ../webcache/webtraf.tclsource ns-namsupp.tclsource ../mobility/dsdv.tclsource ../mobility/dsr.tclsource ../mobility/com.tclsource ../plm/plm.tclsource ../plm/plm-ns.tclsource ../plm/plm-topo.tcl# MPLSsource ../mpls/ns-mpls-simulator.tclsource ../mpls/ns-mpls-node.tclsource ../mpls/ns-mpls-ldpagent.tclsource ../mpls/ns-mpls-classifier.tclsource ns-default.tclsource ../emulate/ns-emulate.tcl#pushbacksource ns-pushback.tcl# Obsolete modules#source ns-wireless-mip.tcl#source ns-nam.tclSimulator instproc init args {	# Debojyoti added this 	# global edges_ connections_;	$self create_packetformat	$self use-scheduler Calendar	$self set nullAgent_ [new Agent/Null]	$self set-address-format def	if {[lindex $args 0] == "-multicast"} {		$self multicast $args	}	eval $self next $args}Simulator instproc nullagent {} {	$self instvar nullAgent_	return $nullAgent_}Simulator instproc use-scheduler type {	$self instvar scheduler_	if [info exists scheduler_] {		if { [$scheduler_ info class] == "Scheduler/$type" } {			return		} else {			delete $scheduler_		}	}	set scheduler_ [new Scheduler/$type]	$scheduler_ now}Simulator instproc delay_parse { spec } {	return [time_parse $spec]}Simulator instproc bw_parse { spec } {	return [bw_parse $spec]}## A simple method to wrap any object around# a trace object that dumps to stdout#Simulator instproc dumper obj {	set t [$self alloc-trace hop stdout]	$t target $obj	return $t}# New node structure## Add APT to support multi-interface: user can specified multiple channels# when config nod. Still need modifications in routing agents to make# multi-interfaces really work.   -chen xuan  07/21/00## Define global node configuration# $ns_ node-config -addressType flat/hierarchical#                  -adhocRouting   DSDV/DSR/TORA#                  -llType#                  -macType#                  -propType#                  -ifqType#                  -ifqLen#                  -phyType#                  -antType#		   -channel#                  -channelType#                  -topologyInstance#                  -wiredRouting   ON/OFF#                  -mobileIP       ON/OFF#                  -energyModel    "EnergyModel"#                  -initialEnergy  (in Joules)#                  -rxPower        (in W)#                  -txPower        (in W)#                  -idlePower      (in W)#                  -agentTrace  ON#                  -routerTrace ON #                  -macTrace OFF #                  -toraDebug OFF                #                  -movementTrace OFFSimulator instproc addressType  {val} { $self set addressType_  $val }Simulator instproc adhocRouting  {val} { $self set routingAgent_  $val }Simulator instproc llType  {val} { $self set llType_  $val }Simulator instproc macType  {val} { $self set macType_  $val }Simulator instproc propType  {val} { $self set propType_  $val }Simulator instproc propInstance  {val} { $self set propInstance_  $val }Simulator instproc ifqType  {val} { $self set ifqType_  $val }Simulator instproc ifqLen  {val} { $self set ifqlen_  $val }Simulator instproc phyType  {val} { $self set phyType_  $val }Simulator instproc antType  {val} { $self set antType_  $val }Simulator instproc channel {val} {$self set channel_ $val}Simulator instproc channelType {val} {$self set channelType_ $val}Simulator instproc topoInstance {val} {$self set topoInstance_ $val}Simulator instproc wiredRouting {val} {$self set wiredRouting_ $val}Simulator instproc mobileIP {val} {$self set mobileIP_ $val}Simulator instproc energyModel  {val} { $self set energyModel_  $val }Simulator instproc initialEnergy  {val} { $self set initialEnergy_  $val }Simulator instproc txPower  {val} { $self set txPower_  $val }Simulator instproc rxPower  {val} { $self set rxPower_  $val }Simulator instproc idlePower  {val} { $self set idlePower_  $val }Simulator instproc errProc  {val} { $self set errProc_  $val }Simulator instproc FECProc  {val} { $self set FECProc_  $val }Simulator instproc agentTrace  {val} { $self set agentTrace_  $val }Simulator instproc routerTrace  {val} { $self set routerTrace_  $val }Simulator instproc macTrace  {val} { $self set macTrace_  $val }Simulator instproc movementTrace  {val} { $self set movementTrace_  $val }Simulator instproc toraDebug {val} {$self set toraDebug_ $val }Simulator instproc MPLS { val } { 	if { $val == "ON" } {		Node enable-module "MPLS"	} else {		Node disable-module "MPLS"	}}Simulator instproc get-nodetype {} {	$self instvar addressType_ routingAgent_ wiredRouting_ 	set val ""	if { [info exists addressType_] && $addressType_ == "hierarchical" } {		set val Hier	}	if { [info exists routingAgent_] && $routingAgent_ != "" } {		set val Mobile	}	if { [info exists wiredRouting_] && $wiredRouting_ == "ON" } {		set val Base	}	if { [info exists wiredRouting_] && $wiredRouting_ == "OFF"} {		set val Base	}	if { [Simulator set mobile_ip_] } {		if { $val == "Base" && $wiredRouting_ == "ON" } {			set val MIPBS		}		if { $val == "Base" && $wiredRouting_ == "OFF" } {			set val MIPMH		}	}	return $val}Simulator instproc node-config args {        # Object::init-vars{} is defined in ~tclcl/tcl-object.tcl.        # It initializes all default variables in the following way:        #  1.  Look for pairs of {-cmd val} in args        #  2.  If "$self $cmd $val" is not valid then put it in a list of         #      arguments to be returned to the caller.        #         # Since we do not handle undefined {-cmd val} pairs, we ignore         # return value from init-vars{}.        set args [eval $self init-vars $args]        $self instvar addressType_  routingAgent_ propType_  macTrace_ \		routerTrace_ agentTrace_ movementTrace_ channelType_ channel_ \		chan topoInstance_ propInstance_ mobileIP_ rxPower_ \		txPower_ idlePower_        if [info exists macTrace_] {		Simulator set MacTrace_ $macTrace_	}        if [info exists routerTrace_] {		Simulator set RouterTrace_ $routerTrace_	}        if [info exists agentTrace_] {		Simulator set AgentTrace_ $agentTrace_	}        if [info exists movementTrace_] {		Simulator set MovementTrace_ $movementTrace_	}        # hacking for matching old cmu add-interface        # not good style, for back-compability ONLY	#	# Only create 1 instance of prop	if {[info exists propInstance_]} {		if {[info exists propType_] && [Simulator set propInstCreated_] == 0} {			warn "Both propType and propInstance are set. propType is ignored."		}	} else {		if {[info exists propType_]} {			set propInstance_ [new $propType_]			Simulator set propInstCreated_ 1		}	}		# Add multi-interface support: 	# User can only specify either channelType_ (single_interface as 	# before) or channel_ (multi_interface) 	# If both variables are specified, error! 	if {[info exists channelType_] && [info exists channel_]} { 		error "Can't specify both channel and channelType, error!"	} elseif {[info exists channelType_]} {		# Single channel, single interface		warn "Please use -channel as shown in tcl/ex/wireless-mitf.tcl"		if {![info exists chan]} {			set chan [new $channelType_]		} 	} elseif {[info exists channel_]} {		# Multiple channel, multiple interfaces		set chan $channel_ 	}	if [info exists topoInstance_] {		$propInstance_  topography $topoInstance_	}	# set address type, hierarchical or expanded	if {[string compare $addressType_ ""] != 0} {		$self set-address-format $addressType_ 	}	# set mobileIP flag	if { [info exists mobileIP_] && $mobileIP_ == "ON"} {		Simulator set mobile_ip_  1	} else {		if { [info exists mobileIP_] } {			Simulator set mobile_ip_ 0		}	}}# Default behavior is changed: consider nam as not initialized if # no shape OR color parameter is givenSimulator instproc node args {	$self instvar Node_ routingAgent_ wiredRouting_        if { [Simulator info vars EnableMcast_] != "" } {                warn "Flag variable Simulator::EnableMcast_ discontinued.\n\t\                      Use multicast methods as:\n\t\t\                        % set ns \[new Simulator -multicast on]\n\t\t\                        % \$ns multicast"                $self multicast                Simulator unset EnableMcast_        }        if { [Simulator info vars NumberInterfaces_] != "" } {                warn "Flag variable Simulator::NumberInterfaces_ discontinued.\n\t\                      Setting this variable will not affect simulations."                Simulator unset NumberInterfaces_        }		# wireless-ready node	if { [info exists routingAgent_] && ($routingAgent_ != "") } {		set node [eval $self create-wireless-node $args]		# for base node		if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {			set Node_([$node id]) $node			#simulator's nodelist in C++ space			$self add-node $node [$node id] 		}		return $node	}	# Enable-mcast is now done automatically inside Node::init{}	# 	# XXX node_factory_ is deprecated, HOWEVER, since it's still used by	# mobile IP, algorithmic routing, manual routing, and backward 	# compability tests of hierarchical routing, we should keep it around	# before all related code are wiped out.	set node [eval new [Simulator set node_factory_] $args]