ns-lib.tcl

CBRP协议（移动adhoc中基于分簇的路由协议）ns2下的源码

#
# 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: /usr/cvs/ns/ns-src/tcl/lib/ns-lib.tcl,v 1.6 1998/02/17 20:56:32 dmaltz 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.
#


if {[info commands debug] == ""} {
    set warnedFlag 0
    proc debug args {
	global warnedFlag
	if !$warnedFlag {
	    puts stderr "Script debugging disabled.  Reconfigure with --with-tcldebug, and recompile."
	    set warnedFlag 1
	}
    }
}

#
# Create the core OTcl class called "Simulator".
# This is the principal interface to the simulation engine.
#
Class Simulator

source ns-node.tcl
source ns-link.tcl
source ns-source.tcl
source ns-compat.tcl
source ns-nam.tcl
source ns-packet.tcl
source ns-queue.tcl
source ns-trace.tcl
source ns-agent.tcl
source ns-random.tcl
source ns-route.tcl
source ns-namsupp.tcl
source ../rtp/session-rtp.tcl
source ../interface/ns-iface.tcl
#source ../lan/ns-mlink.tcl
#source ../lan/ns-mac.tcl
#source ../lan/ns-lan.tcl
source ../mcast/timer.tcl
source ../mcast/ns-mcast.tcl
source ../mcast/McastProto.tcl
source ../mcast/DM.tcl
source ../mcast/dynamicDM.tcl
source ../mcast/pimDM.tcl
source ../mcast/detailedDM.tcl
source ../ctr-mcast/CtrMcast.tcl
source ../ctr-mcast/CtrMcastComp.tcl
source ../ctr-mcast/CtrRPComp.tcl
source ../pim/pim-init.tcl
source ../pim/pim-messagers.tcl
source ../pim/pim-mfc.tcl
source ../pim/pim-mrt.tcl
source ../pim/pim-recvr.tcl
source ../pim/pim-sender.tcl
source ../pim/pim-vifs.tcl
source ../mcast/srm.tcl
source ../mcast/srm-ssm.tcl
source ../mcast/McastMonitor.tcl
source ../session/session.tcl

source ns-default.tcl

Simulator instproc init args {
	$self create_packetformat
# the calendar scheduler doesn't work on big mobile network runs
# it dies around 240 secs...
#	$self use-scheduler Calendar
	$self use-scheduler List
	$self set nullAgent_ [new Agent/Null]
	eval $self next $args
}

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]
	if { $type == "RealTime" } {
		#
		# allocate room for packet bodies but only
		# if we use the real-time scheduler (otherwise,
		# we would waste a tremendous amount of memory)
		# XXX this implicitly creates a dependence between
		# Scheduler/RealTime and Agent/Tap
		#
		$self instvar packetManager_
		TclObject set off_tap_ [$packetManager_ allochdr Tap]
	}
}

#
# 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
}

# Default behavior is changed: consider nam as not initialized if 
# no shape OR color parameter is given
Simulator instproc node {} {
	$self instvar Node_
	set node [new Node]
	set Node_([$node id]) $node
        if [Simulator set EnableMcast_] {
	    $node enable-mcast $self
	}

	return $node
}

Simulator instproc now {} {
	$self instvar scheduler_
	return [$scheduler_ now]
}

Simulator instproc at args {
	$self instvar scheduler_
	return [eval $scheduler_ at $args]
}

Simulator instproc cancel args {
	$self instvar scheduler_
	return [eval $scheduler_ cancel $args]
}

Simulator instproc run {} {
	#$self compute-routes
	$self rtmodel-configure			;# in case there are any
	[$self get-routelogic] configure
	$self instvar scheduler_ Node_ link_ started_ 
	$self instvar color_ tracedAgents_ linkConfigList_

	set started_ 1

	# 
	# dump color configuration for nam
	#
	foreach id [array names color_] {
		$self puts-nam-traceall "c -t * -i $id -n $color_($id)"
	}
	#
	# Reset every node, which resets every agent.
	# And dump nam configuration of each node
	#
	foreach nn [array names Node_] {
		$Node_($nn) dump-namconfig
		$Node_($nn) reset
	}
	#
	# write link configurations
	#
	if [info exists linkConfigList_] {
		foreach lnk $linkConfigList_ {
			$lnk dump-namconfig
		}
		unset linkConfigList_
	}
        #
        # also reset every queue
        #
        foreach qn [array names link_] {
                set q [$link_($qn) queue]
                $q reset
		$link_($qn) dump-nam-queueconfig
        }
	#
	# traced agents
	#
	if [info exists tracedAgents_] {
		foreach id [array names tracedAgents_] {
			$tracedAgents_($id) add-agent-trace $id
		}
		unset tracedAgents_
	}
        return [$scheduler_ run]
}

Simulator instproc halt {} {
	$self instvar scheduler_
	$scheduler_ halt
}

Simulator instproc is-started {} {
	$self instvar started_
	return [info exists started_]
}

Simulator instproc clearMemTrace {} {
        $self instvar scheduler_
        $scheduler_ clearMemTrace
}

Simulator instproc simplex-link { n1 n2 bw delay arg } {
	$self instvar link_ queueMap_ nullAgent_
	set sid [$n1 id]
	set did [$n2 id]

	# XXX the following is an absolutely disgusting hack,
	# but difficult to avoid for the moment (kf)
	# idea: if arg (formerly type) is "QTYPE stuff", split
	# the string so type is QTYPE and "stuff" is passed along
	#
	set argsz [llength $arg]
	if { $argsz == 1 } {
		set type $arg
	} else {
		set type [lindex $arg 0]
		set larg [lindex $arg 1]
	}

	if [info exists queueMap_($type)] {
		set type $queueMap_($type)
	}
	if [$class set NumberInterfaces_] {
		$self instvar interfaces_
		if ![info exists interfaces_($n1:$n2)] {
			set interfaces_($n1:$n2) [new DuplexNetInterface]
			set interfaces_($n2:$n1) [new DuplexNetInterface]
			$n1 addInterface $interfaces_($n1:$n2)
			$n2 addInterface $interfaces_($n2:$n1)
		}
		set nd1 $interfaces_($n1:$n2)
		set nd2 $interfaces_($n2:$n1)
	} else {
		set nd1 $n1
		set nd2 $n2
	}

	set q [new Queue/$type]
	$q drop-target $nullAgent_

	# XXX more disgusting hack
	if { $argsz != 1 } {
		# assume we have a string of form "linktype linkarg"
		if { $type == "RTM" || $type == "CBQ" || $type == "CBQ/WRR" } {
			set link_($sid:$did) [new CBQLink $nd1 $nd2 $bw $delay $q $larg]
		}
	} else {
		if { $type == "CBQ" || $type == "CBQ/WRR" } {
			# default classifier for cbq is just Fid type
			set classifier [new Classifier/Hash/Fid 33]
			set link_($sid:$did) [new CBQLink $nd1 $nd2 $bw $delay $q $classifier]
		} else {
			set link_($sid:$did) [new SimpleLink $nd1 $nd2 $bw $delay $q]
		}
	}
	$n1 add-neighbor $n2

	#XXX yuck
	if { $type == "RED" } {
		$q link [$link_($sid:$did) set link_]
	}

	set trace [$self get-ns-traceall]
	if {$trace != ""} {
		$self trace-queue $n1 $n2 $trace
	}
	set trace [$self get-nam-traceall]
	if {$trace != ""} {
		$self namtrace-queue $n1 $n2 $trace
	}
}

#
# This is used by Link::orient to register/update the order in which links 
# should created in nam. This is important because different creation order
# may result in different layout.
#
# A poor hack. :( Any better ideas?
#
Simulator instproc register-nam-linkconfig link {
	$self instvar linkConfigList_ link_
	if [info exists linkConfigList_] {
		# Check whether the reverse simplex link is registered,
		# if so, don't register this link again.
		# We should have a separate object for duplex link.
		set i1 [[$link fromNode] id]
		set i2 [[$link toNode] id]
		if [info exists link_($i2:$i1)] {
			set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
			if {$pos >= 0} {
				set a1 [$link_($i2:$i1) get-attribute "ORIENTATION"]
				set a2 [$link get-attribute "ORIENTATION"]
				if {$a1 == "" && $a2 != ""} {
					# If this duplex link has not been 
					# assigned an orientation, do it.
					set linkConfigList_ \
					[lreplace $linkConfigList_ $pos $pos]
				} else {
					return
				}
			}
		}

		# Remove $link from list if it's already there
		set pos [lsearch $linkConfigList_ $link]
		if {$pos >= 0} {
			set linkConfigList_ \
				[lreplace $linkConfigList_ $pos $pos]
		}
	}
	lappend linkConfigList_ $link
}

Simulator instproc duplex-link { n1 n2 bw delay type } {
	$self simplex-link $n1 $n2 $bw $delay $type
	$self simplex-link $n2 $n1 $bw $delay $type

	# nam only has duplex link. We do a registration here because 
	# automatic layout doesn't require calling Link::orient.
	$self instvar link_
	$self register-nam-linkconfig $link_([$n1 id]:[$n2 id])
}

Simulator instproc duplex-link-op { n1 n2 op args } {
	$self instvar link_
	eval $link_([$n1 id]:[$n2 id]) $op $args
	eval $link_([$n2 id]:[$n1 id]) $op $args
}

Simulator instproc flush-trace {} {
	$self instvar alltrace_
	if [info exists alltrace_] {
		foreach trace $alltrace_ {
			$trace flush
		}
	}
}

Simulator instproc namtrace-all file {
	$self instvar namtraceAllFile_
	set namtraceAllFile_ $file
}

Simulator instproc trace-all file {
	$self instvar traceAllFile_
	set traceAllFile_ $file
}