ns-lib.tcl

ns2--网络仿真软件扩展！·

# -*-	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.212 2000/10/04 22:46:42 yewei 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.
#

proc 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.tcl
source ns-address.tcl
source ns-node.tcl
source ns-rtmodule.tcl
source ns-hiernode.tcl
source ns-mobilenode.tcl
source ns-bsnode.tcl
source ns-link.tcl
source ns-source.tcl
source ns-compat.tcl
source ns-packet.tcl
source ns-queue.tcl
source ns-trace.tcl
source ns-random.tcl
source ns-agent.tcl
source ns-route.tcl
source ns-errmodel.tcl
source ns-intserv.tcl
source ns-cmutrace.tcl
source ns-mip.tcl
source ns-sat.tcl
source ../rtp/session-rtp.tcl
source ../interface/ns-iface.tcl
source ../lan/ns-mac.tcl
source ../lan/ns-ll.tcl
source ../lan/vlan.tcl
source ../mcast/timer.tcl
source ../mcast/ns-mcast.tcl
source ../mcast/McastProto.tcl
source ../mcast/DM.tcl
source ../ctr-mcast/CtrMcast.tcl
source ../ctr-mcast/CtrMcastComp.tcl
source ../ctr-mcast/CtrRPComp.tcl
source ../mcast/BST.tcl
source ../mcast/srm.tcl
source ../mcast/srm-ssm.tcl
source ../mcast/mftp_snd.tcl
source ../mcast/mftp_rcv.tcl
source ../mcast/mftp_rcv_stat.tcl
source ../mcast/McastMonitor.tcl
source ../rlm/rlm.tcl
source ../rlm/rlm-ns.tcl
source ../session/session.tcl
source ../webcache/http-server.tcl
source ../webcache/http-cache.tcl
source ../webcache/http-agent.tcl
source ../webcache/http-mcache.tcl
source ../webcache/webtraf.tcl
source ns-namsupp.tcl
source ../mobility/dsdv.tcl
source ../mobility/noah.tcl
source ../mobility/dsr.tcl
source ../mobility/com.tcl

source ../plm/plm.tcl
source ../plm/plm-ns.tcl
source ../plm/plm-topo.tcl

# MPLS
source ../mpls/ns-mpls-simulator.tcl
source ../mpls/ns-mpls-node.tcl
source ../mpls/ns-mpls-ldpagent.tcl
source ../mpls/ns-mpls-classifier.tcl

source ns-default.tcl
source ../emulate/ns-emulate.tcl

# Obsolete modules
#source ns-wireless-mip.tcl
#source ns-nam.tcl

Simulator instproc init args {
	$self create_packetformat
	$self use-scheduler Calendar
	$self set nullAgent_ [new Agent/Null]
	$self set-address-format def
	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/NOAH
#                  -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 OFF

Simulator 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 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 given
Simulator 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
		# JCW
		#if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {
			set Node_([$node id]) $node
		#}
		return $node
	}

	# Enable-mcast is now done automatically inside Node::init{}
	# 
	# XXX node_factory_ is deprecated, HOWEVER, since it's still used by