[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ns] Still some problem between TCL and C++
hello (again),
this is more clearly my problem:
I'm writing a new ad'hoc alhorithm (called DAVID no relation with any
religion ;) and i have a problem about calling the command function.
First Case:
----------
If i decide to call "start" in my command function like this (in
david.cc):
int DavidAgent::command(int argc, const char*const* argv)
{
if (argc == 2) {
if (strcmp (argv[1], "start") == 0) {
startup();
return (TCL_OK);
}
I can call "start" into ns-lib.tcl:
Simulator instproc create-david-agent { node } {
set ragent [new Agent/DAVID [$node id]]
$self at 0.0 "$ragent start" ;
$node set ragent_ $ragent
return $ragent
}
But ns don't call "start" when i call it from my main script (david.tcl):
$ns at 0.0 "$node_(0) start"
$ns at 0.0 "$node_(1) start"
Second case:
-----------
Now if i want the same thing with "david-start" instead of "start":
if (argc == 2) {
if (strcmp (argv[1], "david-start") == 0) {
startup();
return (TCL_OK);
}
I can still call "start" into ns-lib.tcl:
Simulator instproc create-david-agent { node } {
set ragent [new Agent/DAVID [$node id]]
$self at 0.0 "$ragent david-start" ;
$node set ragent_ $ragent
return $ragent
}
But for my own scipt (david.tcl):
$ns at 0.0 "$node_(0) david-start"
$ns at 0.0 "$node_(1) david-start"
my ns stops durint the execution and print:
num_nodes is set 2
ns: _o14 david-start:
(_o14 cmd line 1)
invoked from within
"_o14 cmd david-start"
invoked from within
"catch "$self cmd $args" ret"
(procedure "_o14" line 2)
(SplitObject unknown line 2)
invoked from within
"_o14 david-start"
Finally
-------
It seems it exists some register/default behavior for TCL scripts and
objects but i still can't understand how the system works (even with the
documentation).
Does anyone can help me ?
and what is the meaning of:
Agent/DAVID instproc init args {
$self next $args
}
(i found this command in ns-agent.tcl)
I add my files (david.h, david.cc and david.tcl) and the modifs
files from ns (ns-agent.tcl, ns-lib.tcl, ns-packet.tcl and packet.h).
P.S: You can keep this mail for exemple of very poor english language made
by a french guy ;)
#
# 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-agent.tcl,v 1.20 1999/10/05 20:01:47 yaxu Exp $
#
#
# OTcl methods for the Agent base class
#
#
# The following overload was added to inform users of the backward
# compatibility issues resulted from having a 32-bit addressing space.
#
Agent instproc set args {
if { [lindex $args 0] == "dst_" } {
puts "Warning dst_ is no longer being supported in NS. $args"
puts "Use dst_addr_ and dst_port_ instead"
$self instvar dst_addr_ dst_port_
set addr [lindex $args 1]
set baseAddr [Simulator set McastBaseAddr_]
if { $addr >= $baseAddr } {
$self set dst_addr_ $addr
$self set dst_port_ 0
} else {
$self set dst_addr_ [expr ($addr >> 8) ]
$self set dst_port_ [expr ($addr % 256) ]
exit
}
return
}
eval $self next $args
}
Agent instproc port {} {
$self instvar agent_port_
return $agent_port_
}
#
# Lower 8 bits of dst_ are portID_. this proc supports setting the interval
# for delayed acks
#
Agent instproc dst-port {} {
$self instvar dst_port_
return [expr $dst_port_]
}
#
# Add source of type s_type to agent and return the source
# Source objects are obsolete; use attach-app instead
#
Agent instproc attach-source {s_type} {
set source [new Source/$s_type]
$source attach $self
$self set type_ $s_type
return $source
}
#
# Add application of type s_type to agent and return the app
# Note that s_type must be defined as a packet type in packet.h
#
Agent instproc attach-app {s_type} {
set app_ [new Application/$s_type]
$app_ attach-agent $self
$self set type_ $s_type
return $app_
}
#
# Attach tbf to an agent
#
Agent instproc attach-tbf { tbf } {
$tbf target [$self target]
$self target $tbf
}
#
# OTcl support for classes derived from Agent
#
Class Agent/Null -superclass Agent
Agent/Null instproc init args {
eval $self next $args
}
Agent/LossMonitor instproc log-loss {} {
}
#Signalling agent attaches tbf differently as none of its signalling mesages
#go via the tbf
Agent/CBR/UDP/SA instproc attach-tbf { tbf } {
$tbf target [$self target]
$self target $tbf
$self ctrl-target [$tbf target]
}
#
# A lot of agents want to store the maxttl locally. However,
# setting a class variable based on the Agent::ttl_ variable
# does not help if the user redefines Agent::ttl_. Therefore,
# Agents interested in the maxttl_ should call this function
# with the name of their class variable, and it is set to the
# maximum of the current/previous value.
#
# The function itself returns the value of ttl_ set.
#
# I use this function from agent constructors to set appropriate vars:
# for instance to set Agent/rtProto/DV::INFINITY, or
# Agent/SRM/SSM::ttlGroupScope_
#
Agent proc set-maxttl {objectOrClass var} {
if { [catch "$objectOrClass set $var" value] || \
($value < [Agent set ttl_]) } {
$objectOrClass set $var [Agent set ttl_]
}
$objectOrClass set $var
}
#
# Full Tcp constructors for other than the baseline Reno
# implementation
#
Agent/TCP/FullTcp/Tahoe instproc init {} {
$self next
$self instvar reno_fastrecov_
set reno_fastrecov_ false
}
Agent/TCP/FullTcp/Sack instproc init {} {
$self next
$self instvar reno_fastrecov_ maxburst_ open_cwnd_on_pack_
set reno_fastrecov_ false
set maxburst_ 5
set open_cwnd_on_pack_ false
}
Agent/TCP/FullTcp/Newreno instproc init {} {
$self next
$self instvar open_cwnd_on_pack_
set open_cwnd_on_pack_ false
}
#Agent instproc init args {
# $self next $args
#}
#Agent/rtProto instproc init args {
# puts "DOWN HERE 2"
# $self next $args
#}
#Agent/rtProto/TORA -superclass Agent
Agent/TORA instproc init args {
$self next $args
}
Agent/TORA set sport_ 0
Agent/TORA set dport_ 0
Agent/AODV instproc init args {
$self next $args
}
Agent/AODV set sport_ 0
Agent/AODV set dport_ 0
#Agent/DAVID instproc init args {
#
# $self next $args
#}
#
#Agent/DAVID set sport_ 0
#Agent/DAVID set dport_ 0
# -*- 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/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
# -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
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
# 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]
set Node_([$node id]) $node
$node set ns_ $self
$self check-node-num
return $node
}
# XXX This is stupid hack. When old code (not using node-config) is used,
# create-wireless-node{} will not be called, and IMEPFlag_ will remain empty
# (as set in ns-default.tcl), then Node/MobileNode will use global proc
# cmu-trace to create trace objects; otherwise mobility-trace{} will be
# triggered.
Simulator instproc imep-support {} {
return [Simulator set IMEPFlag_]
}
# XXX This should be moved into the node initialization procedure instead
# of standing here in ns-lib.tcl.
Simulator instproc create-wireless-node args {
$self instvar routingAgent_ wiredRouting_ propInstance_ llType_ \
macType_ ifqType_ ifqlen_ phyType_ chan antType_ energyModel_ \
initialEnergy_ txPower_ rxPower_ idlePower_ \
topoInstance_ level1_ level2_
Simulator set IMEPFlag_ OFF
# create node instance
set node [eval $self create-node-instance $args]
# basestation address setting
if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
$node base-station [AddrParams addr2id [$node node-addr]]
}
switch -exact $routingAgent_ {
DSDV {
set ragent [$self create-dsdv-agent $node]
}
DSR {
$self at 0.0 "$node start-dsr"
}
AODV {
set ragent [$self create-aodv-agent $node]
}
# DAVID contributed by Kartoch <cartigny@lifl.fr>
DAVID {
set ragent [$self create-david-agent $node]
}
TORA {
Simulator set IMEPFlag_ ON
set ragent [$self create-tora-agent $node]
}
DIFFUSION/RATE {
eval $node addr $args
set ragent [$self create-diffusion-rate-agent $node]
}
DIFFUSION/PROB {
eval $node addr $args
set ragent [$self create-diffusion-probability-agent $node]
}
FLOODING {
eval $node addr $args
set ragent [$self create-flooding-agent $node]
}
OMNIMCAST {
eval $node addr $args
set ragent [$self create-omnimcast-agent $node]
}
default {
puts "Wrong node routing agent!"
exit
}
}
# Add main node interface
$node add-interface $chan $propInstance_ $llType_ $macType_ \
$ifqType_ $ifqlen_ $phyType_ $antType_
# Attach agent
if {$routingAgent_ != "DSR"} {
$node attach $ragent [Node set rtagent_port_]
}
if {$routingAgent_ == "DIFFUSION/RATE" ||
$routingAgent_ == "DIFFUSION/PROB" ||
$routingAgent_ == "FLOODING" ||
$routingAgent_ == "OMNIMCAST" } {
$ragent port-dmux [$node demux]
$node instvar ll_
$ragent add-ll $ll_(0)
}
# Bind routing agent and mip agent if existing basestation
# address setting
if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
if { $routingAgent_ != "DSR" } {
$node mip-call $ragent
}
}
#
# This Trace Target is used to log changes in direction
# and velocity for the mobile node.
#
set tracefd [$self get-ns-traceall]
if {$tracefd != "" } {
$node nodetrace $tracefd
$node agenttrace $tracefd
}
set namtracefd [$self get-nam-traceall]
if {$namtracefd != "" } {
$node namattach $namtracefd
}
if [info exists energyModel_] {
if [info exists level1_] {
set l1 $level1_
} else {
set l1 0.5
}
if [info exists level2_] {
set l2 $level2_
} else {
set l2 0.2
}
$node addenergymodel [new $energyModel_ $node \
$initialEnergy_ $l1 $l2]
}
if [info exists txPower_] {
$node setPt $txPower_
}
if [info exists rxPower_] {
$node setPr $rxPower_
}
if [info exists idlePower_] {
$node setPidle $idlePower_
}
$node topography $topoInstance_
return $node
}
Simulator instproc create-node-instance args {
$self instvar routingAgent_
# DSR is a special case
if {$routingAgent_ == "DSR"} {
set nodeclass [$self set-dsr-nodetype]
} else {
set nodeclass Node/MobileNode
}
return [eval new $nodeclass $args]
}
Simulator instproc set-dsr-nodetype {} {
$self instvar wiredRouting_
set nodetype SRNodeNew
# MIP mobilenode
if [Simulator set mobile_ip_] {
set nodetype SRNodeNew/MIPMH
}
# basestation dsr node
if { [info exists wiredRouting_] && $wiredRouting_ == "ON"} {
set nodetype Node/MobileNode/BaseStationNode
}
return $nodetype
}
Simulator instproc create-tora-agent { node } {
set ragent [new Agent/TORA [$node id]]
$node set ragent_ $ragent
return $ragent
}
Simulator instproc create-dsdv-agent { node } {
# Create a dsdv routing agent for this node
set ragent [new Agent/DSDV]
# Setup address (supports hier-addr) for dsdv agent
# and mobilenode
set addr [$node node-addr]
$ragent addr $addr
$ragent node $node
if [Simulator set mobile_ip_] {
$ragent port-dmux [$node demux]
}
$node addr $addr
$node set ragent_ $ragent
$self at 0.0 "$ragent start-dsdv" ;# start updates
return $ragent
}
Simulator instproc create-aodv-agent { node } {
# Create AODV routing agent
set ragent [new Agent/AODV [$node id]]
$self at 0.0 "$ragent start" ;# start BEACON/HELLO Messages
$node set ragent_ $ragent
return $ragent
}
# DAVID contributed by Kartoch <cartigny@lifl.fr>
Simulator instproc create-david-agent { node } {
set ragent [new Agent/DAVID [$node id]]
$self at 0.0 "$ragent start" ;
$node set ragent_ $ragent
return $ragent
}
Simulator instproc use-newtrace {} {
Simulator set WirelessNewTrace_ 1
}
Simulator instproc hier-node haddr {
error "hier-nodes should be created with [$ns_ node $haddr]"
}
Simulator instproc now {} {
$self instvar scheduler_
return [$scheduler_ now]
}
Simulator instproc at args {
$self instvar scheduler_
return [eval $scheduler_ at $args]
}
Simulator instproc at-now args {
$self instvar scheduler_
return [eval $scheduler_ at-now $args]
}
Simulator instproc cancel args {
$self instvar scheduler_
return [eval $scheduler_ cancel $args]
}
Simulator instproc after {ival args} {
eval $self at [expr [$self now] + $ival] $args
}
#
# check if total num of nodes exceed 2 to the power n
# where <n=node field size in address>
#
Simulator instproc check-node-num {} {
if {[Node set nn_] > [expr pow(2, [AddrParams nodebits])]} {
error "Number of nodes exceeds node-field-size of [AddrParams nodebits] bits"
}
}
#
# Check if number of items at each hier level (num of nodes, or clusters or
# domains) exceed size of that hier level field size (in bits). should be
# modified to support n-level of hierarchies
#
Simulator instproc chk-hier-field-lengths {} {
AddrParams instvar domain_num_ cluster_num_ nodes_num_
if [info exists domain_num_] {
if {[expr $domain_num_ - 1]> [AddrParams NodeMask 1]} {
error "\# of domains exceed dom-field-size "
}
}
if [info exists cluster_num_] {
set maxval [expr [find-max $cluster_num_] - 1]
if {$maxval > [expr pow(2, [AddrParams NodeMask 2])]} {
error "\# of clusters exceed clus-field-size "
}
}
if [info exists nodes_num_] {
set maxval [expr [find-max $nodes_num_] -1]
if {$maxval > [expr pow(2, [AddrParams NodeMask 3])]} {
error "\# of nodess exceed node-field-size"
}
}
}
Simulator instproc run {} {
$self check-node-num
$self rtmodel-configure ;# in case there are any
[$self get-routelogic] configure
$self instvar scheduler_ Node_ link_ started_
set started_ 1
#
# Reset every node, which resets every agent.
#
foreach nn [array names Node_] {
$Node_($nn) reset
}
#
# Also reset every queue
#
foreach qn [array names link_] {
set q [$link_($qn) queue]
$q reset
}
# Do all nam-related initialization here
$self init-nam
return [$scheduler_ run]
}
Simulator instproc halt {} {
$self instvar scheduler_
$scheduler_ halt
}
Simulator instproc dumpq {} {
$self instvar scheduler_
$scheduler_ dumpq
}
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 qtype args } {
$self instvar link_ queueMap_ nullAgent_
set sid [$n1 id]
set did [$n2 id]
if [info exists queueMap_($qtype)] {
set qtype $queueMap_($qtype)
}
# construct the queue
set qtypeOrig $qtype
switch -exact $qtype {
ErrorModule {
if { [llength $args] > 0 } {
set q [eval new $qtype $args]
} else {
set q [new $qtype Fid]
}
}
intserv {
set qtype [lindex $args 0]
set q [new Queue/$qtype]
}
default {
if { [llength $args] == 0} {
set q [new Queue/$qtype]
} else {
set q [new Queue/$qtype $args]
}
}
}
# Now create the link
switch -exact $qtypeOrig {
RTM {
set c [lindex $args 1]
set link_($sid:$did) [new CBQLink \
$n1 $n2 $bw $delay $q $c]
}
CBQ -
CBQ/WRR {
# assume we have a string of form "linktype linkarg"
if {[llength $args] == 0} {
# default classifier for cbq is just Fid type
set c [new Classifier/Hash/Fid 33]
} else {
set c [lindex $args 0]
}
set link_($sid:$did) [new CBQLink \
$n1 $n2 $bw $delay $q $c]
}
FQ {
set link_($sid:$did) [new FQLink $n1 $n2 $bw $delay $q]
}
intserv {
#XX need to clean this up
set link_($sid:$did) [new IntServLink \
$n1 $n2 $bw $delay $q \
[concat $qtypeOrig $args]]
}
default {
set link_($sid:$did) [new SimpleLink \
$n1 $n2 $bw $delay $q]
}
}
$n1 add-neighbor $n2
#XXX yuck
if {[string first "RED" $qtype] != -1} {
$q link [$link_($sid:$did) set link_]
}
#XXX Yun Wang
if {[string first "RIO" $qtype] != -1} {
$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
}
# Register this simplex link in nam link list. Treat it as
# a duplex link in nam
$self register-nam-linkconfig $link_($sid:$did)
}
#
# 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 src] id]
set i2 [[$link dst] 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
}
#
# GT-ITM may occasionally generate duplicate links, so we need this check
# to ensure duplicated links do not appear in nam trace files.
#
Simulator instproc remove-nam-linkconfig {i1 i2} {
$self instvar linkConfigList_ link_
if ![info exists linkConfigList_] {
return
}
set pos [lsearch $linkConfigList_ $link_($i1:$i2)]
if {$pos >= 0} {
set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
return
}
set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
if {$pos >= 0} {
set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
}
}
Simulator instproc duplex-link { n1 n2 bw delay type args } {
$self instvar link_
set i1 [$n1 id]
set i2 [$n2 id]
if [info exists link_($i1:$i2)] {
$self remove-nam-linkconfig $i1 $i2
}
eval $self simplex-link $n1 $n2 $bw $delay $type $args
eval $self simplex-link $n2 $n1 $bw $delay $type $args
}
Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
eval $self duplex-link $n1 $n2 $bw $pd intserv $sched $signal $adc $args
}
Simulator instproc simplex-link-op { n1 n2 op args } {
$self instvar link_
eval $link_([$n1 id]:[$n2 id]) $op $args
}
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_
if {$file != ""} {
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}
}
Simulator instproc energy-color-change {level1 level2} {
$self instvar level1_ level2_
set level1_ $level1
set level2_ $level2
}
Simulator instproc namtrace-all-wireless {file optx opty} {
$self instvar namtraceAllFile_
if {$file != ""} {
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}
if { $optx != "" && $opty != "" } {
$self puts-nam-config "W -t * -x $optx -y $opty"
}
}
Simulator instproc nam-end-wireless {stoptime} {
$self instvar namtraceAllFile_
if {$namtraceAllFile_ != ""} {
$self puts-nam-config "W -t $stoptime"
}
}
Simulator instproc namtrace-some file {
$self instvar namtraceSomeFile_
set namtraceSomeFile_ $file
}
Simulator instproc namtrace-all-wireless {file optx opty} {
$self instvar namtraceAllFile_
if {$file != ""} {
set namtraceAllFile_ $file
} else {
unset namtraceAllFile_
}
$self puts-nam-config "W -t * -x $optx -y $opty"
}
Simulator instproc initial_node_pos {nodep size} {
$self instvar addressType_
$self instvar energyModel_
if [info exists energyModel_] {
set nodeColor "green"
} else {
set nodeColor "black"
}
if { [info exists addressType_] && $addressType_ == "hierarchical" } {
# Hierarchical addressing
$self puts-nam-config "n -t * -a [$nodep set address_] \
-s [$nodep id] -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] \
-z $size -v circle -c $nodeColor"
} else {
# Flat addressing
$self puts-nam-config "n -t * -s [$nodep id] \
-x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size \
-v circle -c $nodeColor"
}
}
Simulator instproc trace-all file {
$self instvar traceAllFile_
set traceAllFile_ $file
}
Simulator instproc get-nam-traceall {} {
$self instvar namtraceAllFile_
if [info exists namtraceAllFile_] {
return $namtraceAllFile_
} else {
return ""
}
}
Simulator instproc get-ns-traceall {} {
$self instvar traceAllFile_
if [info exists traceAllFile_] {
return $traceAllFile_
} else {
return ""
}
}
# If exists a traceAllFile_, print $str to $traceAllFile_
Simulator instproc puts-ns-traceall { str } {
$self instvar traceAllFile_
if [info exists traceAllFile_] {
puts $traceAllFile_ $str
}
}
# If exists a traceAllFile_, print $str to $traceAllFile_
Simulator instproc puts-nam-traceall { str } {
$self instvar namtraceAllFile_
if [info exists namtraceAllFile_] {
puts $namtraceAllFile_ $str
} elseif [info exists namtraceSomeFile_] {
puts $namtraceSomeFile_ $str
}
}
# namConfigFile is used for writing color/link/node/queue/annotations.
# XXX It cannot co-exist with namtraceAll.
Simulator instproc namtrace-config { f } {
$self instvar namConfigFile_
set namConfigFile_ $f
}
Simulator instproc get-nam-config {} {
$self instvar namConfigFile_
if [info exists namConfigFile_] {
return $namConfigFile_
} else {
return ""
}
}
# Used only for writing nam configurations to trace file(s). This is different
# from puts-nam-traceall because we may want to separate configuration
# informations and actual tracing information
Simulator instproc puts-nam-config { str } {
$self instvar namtraceAllFile_ namConfigFile_
if [info exists namConfigFile_] {
puts $namConfigFile_ $str
} elseif [info exists namtraceAllFile_] {
puts $namtraceAllFile_ $str
} elseif [info exists namtraceSomeFile_] {
puts $namtraceSomeFile_ $str
}
}
Simulator instproc color { id name } {
$self instvar color_
set color_($id) $name
}
Simulator instproc get-color { id } {
$self instvar color_
return $color_($id)
}
# you can pass in {} as a null file
Simulator instproc create-trace { type file src dst {op ""} } {
$self instvar alltrace_
set p [new Trace/$type]
if [catch {$p set src_ [$src id]}] {
$p set src_ $src
}
if [catch {$p set dst_ [$dst id]}] {
$p set dst_ $dst
}
lappend alltrace_ $p
if {$file != ""} {
$p ${op}attach $file
}
return $p
}
Simulator instproc namtrace-queue { n1 n2 {file ""} } {
$self instvar link_ namtraceAllFile_
if {$file == ""} {
if ![info exists namtraceAllFile_] return
set file $namtraceAllFile_
}
$link_([$n1 id]:[$n2 id]) nam-trace $self $file
# Added later for queue specific tracing events other than enque,
# deque and drop as of now nam does not understand special events.
# Changes will have to be made to nam for it to understand events
# like early drops if they are prefixed differently than "d". - ratul
set queue [$link_([$n1 id]:[$n2 id]) queue]
$queue attach-nam-traces $n1 $n2 $file
}
Simulator instproc trace-queue { n1 n2 {file ""} } {
$self instvar link_ traceAllFile_
if {$file == ""} {
if ![info exists traceAllFile_] return
set file $traceAllFile_
}
$link_([$n1 id]:[$n2 id]) trace $self $file
# Added later for queue specific tracing events other than enque,
# deque and drop - ratul
set queue [$link_([$n1 id]:[$n2 id]) queue]
$queue attach-traces $n1 $n2 $file
}
#
# arrange for queue length of link between nodes n1 and n2
# to be tracked and return object that can be queried
# to learn average q size etc. XXX this API still rough
#
Simulator instproc monitor-queue { n1 n2 qtrace { sampleInterval 0.1 } } {
$self instvar link_
return [$link_([$n1 id]:[$n2 id]) init-monitor $self $qtrace $sampleInterval]
}
Simulator instproc queue-limit { n1 n2 limit } {
$self instvar link_
[$link_([$n1 id]:[$n2 id]) queue] set limit_ $limit
}
Simulator instproc drop-trace { n1 n2 trace } {
$self instvar link_
[$link_([$n1 id]:[$n2 id]) queue] drop-target $trace
}
Simulator instproc cost {n1 n2 c} {
$self instvar link_
$link_([$n1 id]:[$n2 id]) cost $c
}
Simulator instproc attach-agent { node agent } {
$node attach $agent
}
Simulator instproc attach-tbf-agent { node agent tbf } {
$node attach $agent
$agent attach-tbf $tbf
}
Simulator instproc detach-agent { node agent } {
$self instvar nullAgent_
$node detach $agent $nullAgent_
}
#
# Helper proc for setting delay on an existing link
#
Simulator instproc delay { n1 n2 delay {type simplex} } {
$self instvar link_
set sid [$n1 id]
set did [$n2 id]
if [info exists link_($sid:$did)] {
set d [$link_($sid:$did) link]
$d set delay_ $delay
}
if {$type == "duplex"} {
if [info exists link_($did:$sid)] {
set d [$link_($did:$sid) link]
$d set delay_ $delay
}
}
}
#
# Helper proc for setting bandwidth on an existing link
#
Simulator instproc bandwidth { n1 n2 bandwidth {type simplex} } {
$self instvar link_
set sid [$n1 id]
set did [$n2 id]
if [info exists link_($sid:$did)] {
set d [$link_($sid:$did) link]
$d set bandwidth_ $bandwidth
}
if {$type == "duplex"} {
if [info exists link_($did:$sid)] {
set d [$link_($did:$sid) link]
$d set bandwidth_ $bandwidth
}
}
}
#XXX need to check that agents are attached to nodes already
Simulator instproc connect {src dst} {
$self simplex-connect $src $dst
$self simplex-connect $dst $src
return $src
}
Simulator instproc simplex-connect { src dst } {
$src set dst_addr_ [$dst set agent_addr_]
$src set dst_port_ [$dst set agent_port_]
# Polly Huang: to support abstract TCP simulations
if {[lindex [split [$src info class] "/"] 1] == "AbsTCP"} {
$self at [$self now] "$self rtt $src $dst"
$dst set class_ [$src set class_]
}
return $src
}
#
# Here are a bunch of helper methods.
#
Simulator proc instance {} {
set ns [Simulator info instances]
if { $ns != "" } {
return $ns
}
foreach sim [Simulator info subclass] {
set ns [$sim info instances]
if { $ns != "" } {
return $ns
}
}
error "Cannot find instance of simulator"
}
Simulator instproc get-number-of-nodes {} {
return [$self array size Node_]
}
Simulator instproc get-node-by-id id {
$self instvar Node_
return $Node_($id)
}
# Given an node's address, Return the node-id
Simulator instproc get-node-id-by-addr address {
$self instvar Node_
set n [Node set nn_]
for {set q 0} {$q < $n} {incr q} {
set nq $Node_($q)
if {[string compare [$nq node-addr] $address] == 0} {
return $q
}
}
error "get-node-id-by-addr:Cannot find node with given address"
}
# Given an node's address, return the node
Simulator instproc get-node-by-addr address {
return [$self get-node-by-id [$self get-node-id-by-addr $address]]
}
Simulator instproc all-nodes-list {} {
$self instvar Node_
set nodes ""
foreach n [lsort -dictionary [array names Node_]] {
lappend nodes $Node_($n)
}
return $nodes
}
Simulator instproc link { n1 n2 } {
$self instvar Node_ link_
if { ![catch "$n1 info class Node"] } {
set n1 [$n1 id]
}
if { ![catch "$n2 info class Node"] } {
set n2 [$n2 id]
}
if [info exists link_($n1:$n2)] {
return $link_($n1:$n2)
}
return ""
}
# Creates connection. First creates a source agent of type s_type and binds
# it to source. Next creates a destination agent of type d_type and binds
# it to dest. Finally creates bindings for the source and destination agents,
# connects them, and returns the source agent.
Simulator instproc create-connection {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
$self connect $s_agent $d_agent
return $s_agent
}
# Creates connection. First creates a source agent of type s_type and binds
# it to source. Next creates a destination agent of type d_type and binds
# it to dest. Finally creates bindings for the source and destination agents,
# connects them, and returns a list of source agent and destination agent.
Simulator instproc create-connection-list {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
$self connect $s_agent $d_agent
return [list $s_agent $d_agent]
}
# This seems to be an obsolete procedure.
Simulator instproc create-tcp-connection {s_type source d_type dest pktClass} {
set s_agent [new Agent/$s_type]
set d_agent [new Agent/$d_type]
$s_agent set fid_ $pktClass
$d_agent set fid_ $pktClass
$self attach-agent $source $s_agent
$self attach-agent $dest $d_agent
return "$s_agent $d_agent"
}
#
# Other classifier methods overload the instproc-likes to track
# and return the installed objects.
#
Classifier instproc install {slot val} {
$self set slots_($slot) $val
$self cmd install $slot $val
}
Classifier instproc installNext val {
set slot [$self cmd installNext $val]
$self set slots_($slot) $val
set slot
}
Classifier instproc adjacents {} {
$self array get slots_
}
Classifier instproc in-slot? slot {
$self instvar slots_
set ret ""
if {[array size slots_] < $slot} {
set ret slots_($slot)
}
set ret
}
# For debugging
Classifier instproc dump {} {
$self instvar slots_ offset_ shift_ mask_
puts "classifier $self"
puts "\t$offset_ offset"
puts "\t$shift_ shift"
puts "\t$mask_ mask"
puts "\t[array size slots_] slots"
foreach i [lsort -integer [array names slots_]] {
set iv $slots_($i)
puts "\t\tslot $i: $iv"
}
}
Classifier instproc no-slot slot {
puts stderr "--- Classfier::no-slot{} default handler (tcl/lib/ns-lib.tcl) ---"
puts stderr "\t$self: no target for slot $slot"
puts stderr "\t$self type: [$self info class]"
puts stderr "content dump:"
$self dump
puts stderr "---------- Finished standard no-slot{} default handler ----------"
# Clear output before we bail out
[Simulator instance] flush-trace
exit 1
}
Classifier/Hash instproc dump args {
eval $self next $args
$self instvar default_
puts "\t$default_ default"
}
Classifier/Hash instproc init nbuck {
# We need to make sure that port shift/mask values are there
# so we set them after they get their default values
$self next $nbuck
$self instvar shift_ mask_
set shift_ [AddrParams NodeShift 1]
set mask_ [AddrParams NodeMask 1]
}
Classifier/Port/Reserve instproc init args {
eval $self next
$self reserve-port 2
}
Simulator instproc makeflowmon { cltype { clslots 29 } } {
set flowmon [new QueueMonitor/ED/Flowmon]
set cl [new Classifier/Hash/$cltype $clslots]
$cl proc unknown-flow { src dst fid } {
set fdesc [new QueueMonitor/ED/Flow]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc]
$self set-hash auto $src $dst $fid $slot
}
$cl proc no-slot slotnum {
#
# note: we can wind up here when a packet passes
# through either an Out or a Drop Snoop Queue for
# a queue that the flow doesn't belong to anymore.
# Since there is no longer hash state in the
# hash classifier, we get a -1 return value for the
# hash classifier's classify() function, and there
# is no node at slot_[-1]. What to do about this?
# Well, we are talking about flows that have already
# been moved and so should rightly have their stats
# zero'd anyhow, so for now just ignore this case..
# puts "classifier $self, no-slot for slotnum $slotnum"
}
$flowmon classifier $cl
return $flowmon
}
# attach a flow monitor to a link
# 3rd argument dictates whether early drop support is to be used
Simulator instproc attach-fmon {lnk fm { edrop 0 } } {
set isnoop [new SnoopQueue/In]
set osnoop [new SnoopQueue/Out]
set dsnoop [new SnoopQueue/Drop]
$lnk attach-monitors $isnoop $osnoop $dsnoop $fm
if { $edrop != 0 } {
set edsnoop [new SnoopQueue/EDrop]
$edsnoop set-monitor $fm
[$lnk queue] early-drop-target $edsnoop
$edsnoop target [$self set nullAgent_]
}
[$lnk queue] drop-target $dsnoop
}
# Added by Yun Wang
Simulator instproc maketbtagger { cltype { clslots 29 } } {
set tagger [new QueueMonitor/ED/Tagger]
set cl [new Classifier/Hash/$cltype $clslots]
$cl proc unknown-flow { src dst fid } {
set fdesc [new QueueMonitor/ED/Flow/TB]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc]
$self set-hash auto $src $dst $fid $slot
}
$cl proc set-rate { src dst fid hashbucket rate depth init} {
set fdesc [new QueueMonitor/ED/Flow/TB]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
$fdesc set target_rate_ $rate
$fdesc set bucket_depth_ $depth
# Initialize the bucket as full
$fdesc set tbucket_ $init
set slot [$self installNext $fdesc]
$self set-hash $hashbucket $src $dst $fid $slot
}
$cl proc no-slot slotnum {
#
# note: we can wind up here when a packet passes
# through either an Out or a Drop Snoop Queue for
# a queue that the flow doesn't belong to anymore.
# Since there is no longer hash state in the
# hash classifier, we get a -1 return value for the
# hash classifier's classify() function, and there
# is no node at slot_[-1]. What to do about this?
# Well, we are talking about flows that have already
# been moved and so should rightly have their stats
# zero'd anyhow, so for now just ignore this case..
# puts "classifier $self, no-slot for slotnum $slotnum"
}
$tagger classifier $cl
return $tagger
}
# Added by Yun Wang
Simulator instproc maketswtagger { cltype { clslots 29 } } {
set tagger [new QueueMonitor/ED/Tagger]
set cl [new Classifier/Hash/$cltype $clslots]
$cl proc unknown-flow { src dst fid hashbucket } {
set fdesc [new QueueMonitor/ED/Flow/TSW]
set dsamp [new Samples]
$fdesc set-delay-samples $dsamp
set slot [$self installNext $fdesc]
$self set-hash $hashbucket $src $dst $fid $slot
}
$cl proc no-slot slotnum {
#
# note: we can wind up here when a packet passes
# through either an Out or a Drop Snoop Queue for
# a queue that the flow doesn't belong to anymore.
# Since there is no longer hash state in the
# hash classifier, we get a -1 return value for the
# hash classifier's classify() function, and there
# is no node at slot_[-1]. What to do about this?
# Well, we are talking about flows that have already
# been moved and so should rightly have their stats
# zero'd anyhow, so for now just ignore this case..
# puts "classifier $self, no-slot for slotnum $slotnum"
}
$tagger classifier $cl
return $tagger
}
# attach a Tagger to a link
# Added by Yun Wang
Simulator instproc attach-tagger {lnk fm} {
set isnoop [new SnoopQueue/Tagger]
$lnk attach-taggers $isnoop $fm
}
# Imported from session.tcl. It is deleted there.
### to insert loss module to regular links in detailed Simulator
Simulator instproc lossmodel {lossobj from to} {
set link [$self link $from $to]
$link errormodule $lossobj
}
# This function generates losses that can be visualized by nam.
Simulator instproc link-lossmodel {lossobj from to} {
set link [$self link $from $to]
$link insert-linkloss $lossobj
}
#### Polly Huang: Simulator class instproc to support abstract tcp simulations
Simulator instproc rtt { src dst } {
$self instvar routingTable_ delay_
set srcid [[$src set node_] id]
set dstid [[$dst set node_] id]
set delay 0
set tmpid $srcid
while {$tmpid != $dstid} {
set nextid [$routingTable_ lookup $tmpid $dstid]
set tmpnode [$self get-node-by-id $tmpid]
set nextnode [$self get-node-by-id $nextid]
set tmplink [[$self link $tmpnode $nextnode] link]
set delay [expr $delay + [expr 2 * [$tmplink set delay_]]]
set delay [expr $delay + [expr 8320 / [$tmplink set bandwidth_]]]
set tmpid $nextid
}
$src rtt $delay
return $delay
}
Simulator instproc abstract-tcp {} {
$self instvar TahoeAckfsm_ RenoAckfsm_ TahoeDelAckfsm_ RenoDelAckfsm_ dropper_
$self set TahoeAckfsm_ [new FSM/TahoeAck]
$self set RenoAckfsm_ [new FSM/RenoAck]
$self set TahoeDelAckfsm_ [new FSM/TahoeDelAck]
$self set RenoDelAckfsm_ [new FSM/RenoDelAck]
$self set nullAgent_ [new DropTargetAgent]
}
# Chalermek: For Diffusion, Flooding, and Omnicient Multicast
Simulator instproc create-diffusion-rate-agent {node} {
set diff [new Agent/Diffusion/RateGradient]
$node set diffagent_ $diff
$node set ragent_ $diff
$diff on-node $node
if [info exist opt(enablePos)] {
if {$opt(enablePos) == "true"} {
$diff enable-pos
} else {
$diff disable-pos
}
}
if [info exist opt(enableNeg)] {
if {$opt(enableNeg) == "true"} {
$diff enable-neg
} else {
$diff disable-neg
}
}
if [info exist opt(suppression)] {
if {$opt(suppression) == "true"} {
$diff enable-suppression
} else {
$diff disable-suppression
}
}
if [info exist opt(subTxType)] {
$diff set-sub-tx-type $opt(subTxType)
}
if [info exist opt(orgTxType)] {
$diff set-org-tx-type $opt(orgTxType)
}
if [info exist opt(posType)] {
$diff set-pos-type $opt(posType)
}
if [info exist opt(posNodeType)] {
$diff set-pos-node-type $opt(posNodeType)
}
if [info exist opt(negWinType)] {
$diff set-neg-win-type $opt(negWinType)
}
if [info exist opt(negThrType)] {
$diff set-neg-thr-type $opt(negThrType)
}
if [info exist opt(negMaxType)] {
$diff set-neg-max-type $opt(negMaxType)
}
$self put-in-list $diff
$self at 0.0 "$diff start"
return $diff
}
Simulator instproc create-diffusion-probability-agent {node} {
set diff [new Agent/Diffusion/ProbGradient]
$node set diffagent_ $diff
$node set ragent_ $diff
$diff on-node $node
if [info exist opt(enablePos)] {
if {$opt(enablePos) == "true"} {
$diff enable-pos
} else {
$diff disable-pos
}
}
if [info exist opt(enableNeg)] {
if {$opt(enableNeg) == "true"} {
$diff enable-neg
} else {
$diff disable-neg
}
}
$self put-in-list $diff
$self at 0.0 "$diff start"
return $diff
}
Simulator instproc create-flooding-agent {node} {
set flood [new Agent/Flooding]
$node set ragent_ $flood
$flood on-node $node
$self put-in-list $flood
$self at 0.0 "$flood start"
return $flood
}
Simulator instproc create-omnimcast-agent {node} {
set omni [new Agent/OmniMcast]
$node set ragent_ $omni
$omni on-node $node
$self put-in-list $omni
$self at 0.0 "$omni start"
return $omni
}
# XXX These are very simulation-specific methods, why should they belong here?
Simulator instproc put-in-list {agent} {
$self instvar lagent
lappend lagent $agent
}
Simulator instproc terminate-all-agents {} {
$self instvar lagent
foreach i $lagent {
$i terminate
}
}
Simulator instproc prepare-to-stop {} {
$self instvar lagent
foreach i $lagent {
$i stop
}
}
# -*- Mode:tcl; tcl-indent-level:8; tab-width:8; indent-tabs-mode:t -*-
#
# Time-stamp: <2000-08-31 19:01:26 haoboy>
#
# Copyright (c) 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-packet.tcl,v 1.40 2000/09/01 03:04:11 haoboy Exp $
#
# set up the packet format for the simulation
# (initial version)
#
#
# XXX Packet Header Usage Guide
#
# By default, ns includes ALL packet headers of ALL protocols in ns in
# EVERY packet in your simulation. This is a LOT, and will increase as more
# protocols are added into ns. For "packet-intensive" simulations, this could
# be a huge overhead.
#
# To include only the packet headers that are of interest to you in your
# specific simulation, follow this pattern (e.g., you want to remove AODV,
# and ARP headers from your simulation):
#
# remove-packet-header AODV ARP
# ...
# set ns [new Simulator]
#
# NOTICE THAT ADD-PACKET-HEADER{} MUST GO BEFORE THE SIMULATOR IS CREATED.
#
# To include only a specific set of headers in your simulation, e.g., AODV
# and ARP, follow this pattern:
#
# remove-all-packet-headers
# add-packet-header AODV ARP
# ...
# set ns [new Simulator]
#
# IMPORTANT: You MUST never remove common header from your simulation.
# As you can see, this is also enforced by these header manipulation procs.
#
PacketHeaderManager set hdrlen_ 0
# XXX Common header should ALWAYS be present
PacketHeaderManager set tab_(Common) 1
proc add-packet-header args {
foreach cl $args {
PacketHeaderManager set tab_(PacketHeader/$cl) 1
}
}
proc add-all-packet-headers {} {
foreach cl [PacketHeader info subclass] {
PacketHeaderManager set tab_($cl) 1
}
}
proc remove-packet-header args {
foreach cl $args {
if { $cl == "Common" } {
warn "Cannot exclude common packet header."
continue
}
PacketHeaderManager unset tab_(PacketHeader/$cl)
}
}
proc remove-all-packet-headers {} {
foreach cl [PacketHeader info subclass] {
if { $cl != "PacketHeader/Common" } {
PacketHeaderManager unset tab_($cl)
}
}
}
# DAVID contributed by Kartoch <cartigny@lifl.fr>
foreach prot {
AODV
ARP
aSRM
Common
CtrMcast
DAVID
Diffusion
Encap
Flags
HttpInval
IMEP
IP
IPinIP
IVS
LDP
LL
mcastCtrl
MFTP
MPLS
Mac
Message
MIP
Ping
RAP
RTP
Resv
rtProtoDV
rtProtoLS
SR
SRM
SRMEXT
Snoop
TCP
TCPA
TFRC
TFRC_ACK
TORA
UMP
} {
add-packet-header $prot
}
proc PktHdr_offset { hdrName {field ""} } {
set offset [$hdrName offset]
if { $field != "" } {
# This requires that fields inside the packet header must
# be exported via PacketHeaderClass::export_offsets(), which
# should use PacketHeaderClass::field_offset() to export
# field offsets into otcl space.
incr offset [$hdrName set offset_($field)]
}
return $offset
}
Simulator instproc create_packetformat { } {
PacketHeaderManager instvar tab_
set pm [new PacketHeaderManager]
foreach cl [PacketHeader info subclass] {
if [info exists tab_($cl)] {
set off [$pm allochdr $cl]
$cl offset $off
}
}
$self set packetManager_ $pm
}
PacketHeaderManager instproc allochdr cl {
set size [$cl set hdrlen_]
$self instvar hdrlen_
set NS_ALIGN 8
# round up to nearest NS_ALIGN bytes
# (needed on sparc/solaris)
set incr [expr ($size + ($NS_ALIGN-1)) & ~($NS_ALIGN-1)]
set base $hdrlen_
incr hdrlen_ $incr
return $base
}
# XXX Old code. Do NOT delete for now. - Aug 30, 2000
# Initialization
# foreach cl [PacketHeader info subclass] {
# PacketHeaderManager set vartab_($cl) ""
# }
# So that not all packet headers should be initialized here.
# E.g., the link state routing header is initialized using this proc in
# ns-rtProtoLS.tcl; because link state may be turned off when STL is not
# available, this saves us a ns-packet.tcl.in
# proc create-packet-header { cl var } {
# PacketHeaderManager set vartab_(PacketHeader/$cl) $var
# }
# If you need to save some memory, you can disable unneeded packet headers
# by commenting them out from the list below
# foreach pair {
# { Common off_cmn_ }
# { Mac off_mac_ }
# { LL off_ll_ }
# { ARP off_arp_ }
# { Snoop off_snoop_ }
# { SR off_SR_ }
# { IP off_ip_ }
# { TCP off_tcp_ }
# { TCPA off_tcpasym_ }
# { Flags off_flags_ }
# { TORA off_TORA_ }
# { AODV off_AODV_ }
# { IMEP off_IMEP_ }
# { RTP off_rtp_ }
# { Message off_msg_ }
# { IVS off_ivs_ }
# { rtProtoDV off_DV_ }
# { CtrMcast off_CtrMcast_ }
# { mcastCtrl off_mcast_ctrl_ }
# { aSRM off_asrm_ }
# { SRM off_srm_ }
# { SRMEXT off_srm_ext_}
# { Resv off_resv_}
# { HttpInval off_inv_}
# { IPinIP off_ipinip_}
# { MIP off_mip_}
# { MFTP off_mftp_ }
# { Encap off_encap_ }
# { RAP off_rap_ }
# { UMP off_ump_ }
# { TFRC off_tfrm_ }
# { Ping off_ping_ }
# { rtProtoLS off_LS_ }
# { MPLS off_mpls_ }
# { LDP off_ldp_ }
# } {
# create-packet-header [lindex $pair 0] [lindex $pair 1]
# }
# proc PktHdr_offset {hdrName {field ""}} {
# set var [PacketHeaderManager set vartab_($hdrName)]
# set offset [TclObject set $var]
# if {$field != ""} {
# incr offset [$hdrName set offset_($field)]
# }
# return $offset
# }
# Simulator instproc create_packetformat { } {
# PacketHeaderManager instvar vartab_
# set pm [new PacketHeaderManager]
# foreach cl [PacketHeader info subclass] {
# if {[info exists vartab_($cl)] && $vartab_($cl) != ""} {
# set off [$pm allochdr [lindex [split $cl /] 1]]
# set var [PacketHeaderManager set vartab_($cl)]
# TclObject set $var $off
# $cl offset $off
# }
# }
# $self set packetManager_ $pm
# }
/* -*- Mode:C++; c-basic-offset:8; tab-width:8; indent-tabs-mode:t -*- */
/*
* Copyright (c) 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 Computer Systems
* Engineering Group at Lawrence Berkeley Laboratory.
* 4. Neither the name of the University nor of the Laboratory 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/packet.h,v 1.80 2000/09/28 20:19:06 haoboy Exp $ (LBL)
*/
#ifndef ns_packet_h
#define ns_packet_h
#include <string.h>
#include <assert.h>
#include "config.h"
#include "scheduler.h"
#include "object.h"
#include "lib/bsd-list.h"
#include "packet-stamp.h"
#include "ns-process.h"
// Used by wireless routing code to attach routing agent
#define RT_PORT 255 /* port that all route msgs are sent to */
#define HDR_CMN(p) (hdr_cmn::access(p))
#define HDR_ARP(p) (hdr_arp::access(p))
#define HDR_MAC(p) (hdr_mac::access(p))
#define HDR_MAC802_11(p) ((hdr_mac802_11 *)hdr_mac::access(p))
#define HDR_MAC_TDMA(p) ((hdr_mac_tdma *)hdr_mac::access(p))
#define HDR_LL(p) (hdr_ll::access(p))
#define HDR_IP(p) (hdr_ip::access(p))
#define HDR_RTP(p) (hdr_rtp::access(p))
#define HDR_TCP(p) (hdr_tcp::access(p))
#define HDR_SR(p) (hdr_sr::access(p))
#define HDR_TFRC(p) (hdr_tfrc::access(p))
#define HDR_TORA(p) (hdr_tora::access(p))
#define HDR_IMEP(p) (hdr_imep::access(p))
#define HDR_DIFF(p) (hdr_diff::access(p))
/* --------------------------------------------------------------------*/
enum packet_t {
PT_TCP,
PT_UDP,
PT_CBR,
PT_AUDIO,
PT_VIDEO,
PT_ACK,
PT_START,
PT_STOP,
PT_PRUNE,
PT_GRAFT,
PT_GRAFTACK,
PT_JOIN,
PT_ASSERT,
PT_MESSAGE,
PT_RTCP,
PT_RTP,
PT_RTPROTO_DV,
PT_CtrMcast_Encap,
PT_CtrMcast_Decap,
PT_SRM,
/* simple signalling messages */
PT_REQUEST,
PT_ACCEPT,
PT_CONFIRM,
PT_TEARDOWN,
PT_LIVE, // packet from live network
PT_REJECT,
PT_TELNET, // not needed: telnet use TCP
PT_FTP,
PT_PARETO,
PT_EXP,
PT_INVAL,
PT_HTTP,
/* new encapsulator */
PT_ENCAPSULATED,
PT_MFTP,
/* CMU/Monarch's extnsions */
PT_ARP,
PT_MAC,
PT_TORA,
PT_DSR,
PT_AODV,
PT_IMEP,
PT_DAVID, // Contributed by Kartoch <cartigny@lifl.fr>
// RAP packets
PT_RAP_DATA,
PT_RAP_ACK,
PT_TFRC,
PT_TFRC_ACK,
PT_PING,
// Diffusion packets - Chalermek
PT_DIFF,
// LinkState routing update packets
PT_RTPROTO_LS,
// MPLS LDP header
PT_LDP,
// ReadAudio traffic
PT_REALAUDIO,
// insert new packet types here
PT_NTYPE // This MUST be the LAST one
};
class p_info {
public:
p_info() {
name_[PT_TCP]= "tcp";
name_[PT_UDP]= "udp";
name_[PT_CBR]= "cbr";
name_[PT_AUDIO]= "audio";
name_[PT_VIDEO]= "video";
name_[PT_ACK]= "ack";
name_[PT_START]= "start";
name_[PT_STOP]= "stop";
name_[PT_PRUNE]= "prune";
name_[PT_GRAFT]= "graft";
name_[PT_GRAFTACK]= "graftAck";
name_[PT_JOIN]= "join";
name_[PT_ASSERT]= "assert";
name_[PT_MESSAGE]= "message";
name_[PT_RTCP]= "rtcp";
name_[PT_RTP]= "rtp";
name_[PT_RTPROTO_DV]= "rtProtoDV";
name_[PT_CtrMcast_Encap]= "CtrMcast_Encap";
name_[PT_CtrMcast_Decap]= "CtrMcast_Decap";
name_[PT_SRM]= "SRM";
name_[PT_REQUEST]= "sa_req";
name_[PT_ACCEPT]= "sa_accept";
name_[PT_CONFIRM]= "sa_conf";
name_[PT_TEARDOWN]= "sa_teardown";
name_[PT_LIVE]= "live";
name_[PT_REJECT]= "sa_reject";
name_[PT_TELNET]= "telnet";
name_[PT_FTP]= "ftp";
name_[PT_PARETO]= "pareto";
name_[PT_EXP]= "exp";
name_[PT_INVAL]= "httpInval";
name_[PT_HTTP]= "http";
name_[PT_ENCAPSULATED]= "encap";
name_[PT_MFTP]= "mftp";
name_[PT_ARP]= "ARP";
name_[PT_MAC]= "MAC";
name_[PT_TORA]= "TORA";
name_[PT_DSR]= "DSR";
name_[PT_AODV]= "AODV";
name_[PT_IMEP]= "IMEP";
name_[PT_DAVID] = "DAVID"; // Contributed by Kartoch <cartigny@lifl.fr>
name_[PT_RAP_DATA] = "rap_data";
name_[PT_RAP_ACK] = "rap_ack";
name_[PT_TFRC]= "tcpFriend";
name_[PT_TFRC_ACK]= "tcpFriendCtl";
name_[PT_PING]="ping";
/* For diffusion : Chalermek */
name_[PT_DIFF] = "diffusion";
// Link state routing updates
name_[PT_RTPROTO_LS] = "rtProtoLS";
// MPLS LDP packets
name_[PT_LDP] = "LDP";
// RealAudio packets
name_[PT_REALAUDIO] = "ra";
name_[PT_NTYPE]= "undefined";
}
const char* name(packet_t p) const {
if ( p <= PT_NTYPE ) return name_[p];
return 0;
}
static bool data_packet(packet_t type) {
return ( (type) == PT_TCP || \
(type) == PT_TELNET || \
(type) == PT_CBR || \
(type) == PT_AUDIO || \
(type) == PT_VIDEO || \
(type) == PT_ACK \
);
}
private:
static char* name_[PT_NTYPE+1];
};
extern p_info packet_info; /* map PT_* to string name */
//extern char* p_info::name_[];
#define DATA_PACKET(type) ( (type) == PT_TCP || \
(type) == PT_TELNET || \
(type) == PT_CBR || \
(type) == PT_AUDIO || \
(type) == PT_VIDEO || \
(type) == PT_ACK \
)
#define OFFSET(type, field) ((int) &((type *)0)->field)
class PacketData : public AppData {
public:
PacketData(int sz) : AppData(PACKET_DATA) {
datalen_ = sz;
if (datalen_ > 0)
data_ = new unsigned char[datalen_];
else
data_ = NULL;
}
PacketData(PacketData& d) : AppData(d) {
datalen_ = d.datalen_;
if (datalen_ > 0) {
data_ = new unsigned char[datalen_];
memcpy(data_, d.data_, datalen_);
} else
data_ = NULL;
}
virtual ~PacketData() {
if (data_ != NULL)
delete []data_;
}
unsigned char* data() { return data_; }
virtual int size() { return datalen_; }
virtual AppData* copy() { return new PacketData(*this); }
private:
unsigned char* data_;
int datalen_;
};
//Monarch ext
typedef void (*FailureCallback)(Packet *,void *);
class Packet : public Event {
private:
unsigned char* bits_; // header bits
// unsigned char* data_; // variable size buffer for 'data'
// unsigned int datalen_; // length of variable size buffer
AppData* data_; // variable size buffer for 'data'
static void init(Packet*); // initialize pkt hdr
bool fflag_;
protected:
static Packet* free_; // packet free list
public:
Packet* next_; // for queues and the free list
static int hdrlen_;
Packet() : bits_(0), data_(0), next_(0) { }
inline unsigned char* const bits() { return (bits_); }
inline Packet* copy() const;
static inline Packet* alloc();
static inline Packet* alloc(int);
inline void allocdata(int);
static inline void free(Packet*);
inline unsigned char* access(int off) const {
if (off < 0)
abort();
return (&bits_[off]);
}
// This is used for backward compatibility, i.e., assuming user data
// is PacketData and return its pointer.
inline unsigned char* accessdata() const {
if (data_ == 0)
return 0;
assert(data_->type() == PACKET_DATA);
return (((PacketData*)data_)->data());
}
// This is used to access application-specific data, not limited
// to PacketData.
inline AppData* userdata() const {
return data_;
}
inline void setdata(AppData* d) {
if (data_ != NULL)
delete data_;
data_ = d;
}
inline int datalen() const { return data_ ? data_->size() : 0; }
// Monarch extn
static void dump_header(Packet *p, int offset, int length);
// the pkt stamp carries all info about how/where the pkt
// was sent needed for a receiver to determine if it correctly
// receives the pkt
PacketStamp txinfo_;
/*
* According to cmu code:
* This flag is set by the MAC layer on an incoming packet
* and is cleared by the link layer. It is an ugly hack, but
* there's really no other way because NS always calls
* the recv() function of an object.
*
*/
u_int8_t incoming;
//monarch extns end;
};
/*
* static constant associations between interface special (negative)
* values and their c-string representations that are used from tcl
*/
class iface_literal {
public:
enum iface_constant {
UNKN_IFACE= -1, /*
* iface value for locally originated packets
*/
ANY_IFACE= -2 /*
* hashnode with iif == ANY_IFACE_
* matches any pkt iface (imported from TCL);
* this value should be different from
* hdr_cmn::UNKN_IFACE (packet.h)
*/
};
iface_literal(const iface_constant i, const char * const n) :
value_(i), name_(n) {}
inline int value() const { return value_; }
inline const char * const name() const { return name_; }
private:
const iface_constant value_;
/* strings used in TCL to access those special values */
const char * const name_;
};
static const iface_literal UNKN_IFACE(iface_literal::UNKN_IFACE, "?");
static const iface_literal ANY_IFACE(iface_literal::ANY_IFACE, "*");
/*
* Note that NS_AF_* doesn't necessarily correspond with
* the constants used in your system (because many
* systems don't have NONE or ILINK).
*/
enum ns_af_enum { NS_AF_NONE, NS_AF_ILINK, NS_AF_INET };
struct hdr_cmn {
enum dir_t { DOWN= -1, NONE= 0, UP= 1 };
packet_t ptype_; // packet type (see above)
int size_; // simulated packet size
int uid_; // unique id
int error_; // error flag
double ts_; // timestamp: for q-delay measurement
int iface_; // receiving interface (label)
dir_t direction_; // direction: 0=none, 1=up, -1=down
int ref_count_; // free the pkt until count to 0
//Monarch extn begins
nsaddr_t prev_hop_; // IP addr of forwarding hop
nsaddr_t next_hop_; // next hop for this packet
int addr_type_; // type of next_hop_ addr
nsaddr_t last_hop_; // for tracing on multi-user channels
// called if pkt can't obtain media or isn't ack'd. not called if
// droped by a queue
FailureCallback xmit_failure_;
void *xmit_failure_data_;
/*
* MONARCH wants to know if the MAC layer is passing this back because
* it could not get the RTS through or because it did not receive
* an ACK.
*/
int xmit_reason_;
#define XMIT_REASON_RTS 0x01
#define XMIT_REASON_ACK 0x02
// filled in by GOD on first transmission, used for trace analysis
int num_forwards_; // how many times this pkt was forwarded
int opt_num_forwards_; // optimal #forwards
// Monarch extn ends;
static int offset_; // offset for this header
inline static int& offset() { return offset_; }
inline static hdr_cmn* access(const Packet* p) {
return (hdr_cmn*) p->access(offset_);
}
/* per-field member functions */
inline packet_t& ptype() { return (ptype_); }
inline int& size() { return (size_); }
inline int& uid() { return (uid_); }
inline int& error() { return error_; }
inline double& timestamp() { return (ts_); }
inline int& iface() { return (iface_); }
inline dir_t& direction() { return (direction_); }
inline int& ref_count() { return (ref_count_); }
// monarch_begin
inline nsaddr_t& next_hop() { return (next_hop_); }
inline int& addr_type() { return (addr_type_); }
inline int& num_forwards() { return (num_forwards_); }
inline int& opt_num_forwards() { return (opt_num_forwards_); }
//monarch_end
};
class PacketHeaderClass : public TclClass {
protected:
PacketHeaderClass(const char* classname, int hdrsize);
virtual int method(int argc, const char*const* argv);
void field_offset(const char* fieldname, int offset);
inline void bind_offset(int* off) { offset_ = off; }
inline void offset(int* off) {offset_= off;}
int hdrlen_; // # of bytes for this header
int* offset_; // offset for this header
public:
virtual void bind();
virtual void export_offsets();
TclObject* create(int argc, const char*const* argv);
};
inline void Packet::init(Packet* p)
{
bzero(p->bits_, hdrlen_);
}
inline Packet* Packet::alloc()
{
Packet* p = free_;
if (p != 0) {
assert(p->fflag_ == FALSE);
free_ = p->next_;
assert(p->data_ == 0);
p->uid_ = 0;
p->time_ = 0;
} else {
p = new Packet;
p->bits_ = new unsigned char[hdrlen_];
if (p == 0 || p->bits_ == 0)
abort();
}
init(p); // Initialize bits_[]
(HDR_CMN(p))->next_hop_ = -2; // -1 reserved for IP_BROADCAST
(HDR_CMN(p))->last_hop_ = -2; // -1 reserved for IP_BROADCAST
p->fflag_ = TRUE;
(HDR_CMN(p))->direction() = hdr_cmn::DOWN;
/* setting all direction of pkts to be downward as default;
until channel changes it to +1 (upward) */
p->next_ = 0;
return (p);
}
/*
* Allocate an n byte data buffer to an existing packet
*
* To set application-specific AppData, use Packet::setdata()
*/
inline void Packet::allocdata(int n)
{
assert(data_ == 0);
data_ = new PacketData(n);
if (data_ == 0)
abort();
}
/* allocate a packet with an n byte data buffer */
inline Packet* Packet::alloc(int n)
{
Packet* p = alloc();
if (n > 0)
p->allocdata(n);
return (p);
}
inline void Packet::free(Packet* p)
{
hdr_cmn* ch = hdr_cmn::access(p);
if (p->fflag_) {
if (ch->ref_count() == 0) {
/*
* A packet's uid may be < 0 (out of a event queue), or
* == 0 (newed but never gets into the event queue.
*/
assert(p->uid_ <= 0);
// Delete user data because we won't need it any more.
if (p->data_ != 0) {
delete p->data_;
p->data_ = 0;
}
init(p);
p->next_ = free_;
free_ = p;
p->fflag_ = FALSE;
} else {
ch->ref_count() = ch->ref_count() - 1;
}
}
}
inline Packet* Packet::copy() const
{
Packet* p = alloc();
memcpy(p->bits(), bits_, hdrlen_);
if (data_)
p->data_ = data_->copy();
p->txinfo_.init(&txinfo_);
return (p);
}
inline void
Packet::dump_header(Packet *p, int offset, int length)
{
assert(offset + length <= p->hdrlen_);
struct hdr_cmn *ch = HDR_CMN(p);
fprintf(stderr, "\nPacket ID: %d\n", ch->uid());
for(int i = 0; i < length ; i+=16) {
fprintf(stderr, "%02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x\n",
p->bits_[offset + i], p->bits_[offset + i + 1],
p->bits_[offset + i + 2], p->bits_[offset + i + 3],
p->bits_[offset + i + 4], p->bits_[offset + i + 5],
p->bits_[offset + i + 6], p->bits_[offset + i + 7],
p->bits_[offset + i + 8], p->bits_[offset + i + 9],
p->bits_[offset + i + 10], p->bits_[offset + i + 11],
p->bits_[offset + i + 12], p->bits_[offset + i + 13],
p->bits_[offset + i + 14], p->bits_[offset + i + 15]);
}
}
#endif
#include "david.h"
// offset_ definition (static !)
int hdr_david::offset_;
// Register and bind david header
static class DavidHeaderClass : public PacketHeaderClass {
public:
DavidHeaderClass() : PacketHeaderClass("PacketHeader/DAVID",
sizeof(hdr_david)) {
bind_offset(&hdr_david::offset_);
}
} class_davidhdr;
// Register david Agent for TCL
static class DavidClass : public TclClass {
public:
DavidClass() : TclClass("Agent/DAVID") {}
TclObject* create(int, const char*const*) {
return (new DavidAgent());
}
} class_david;
void DavidAgent::trace (char *fmt,...)
{
va_list ap;
if (!trace_target) return;
va_start (ap, fmt);
vsprintf (trace_target->buffer (), fmt, ap);
trace_target->dump ();
va_end (ap);
}
// DavidAgent constructor
DavidAgent::DavidAgent () : Agent(PT_DAVID) {
// Connect the advertise handler with this object to register the
// callback funtion
/*
advertise_handler = new DavidAdvertiseHandler(this);
*/
}
// Startup function
void DavidAgent::startup() {
/*
// Create the advertise event
advertise_event = new Event();
Scheduler::instance().schedule(advertise_handler, advertise_event,
Random::uniform(DAVID_STARTUP_ADVERTISE));
*/
}
/*
void DavidAgent::handler_callback(Event *e) {
// Check for advertise event
if(advertise_event == e) {
// Create a new packet
Packet* pkt = allocpkt();
// Access the David header for the new packet:
hdr_david* hdr = hdr_david::access(pkt);
// type == hello
hdr->type = DAVID_PACKET_HELLO;
// Send the packet
send(pkt, 0);
}
}
*/
// Command function
int DavidAgent::command(int argc, const char*const* argv)
{
if (argc == 2) {
if (strcmp (argv[1], "david-start") == 0) {
/* startup(); */
printf("david-start\n");
return (TCL_OK);
}
if (strcmp(argv[1], "david-send") == 0) {
// Create a new packet
Packet* pkt = allocpkt();
// Access the David header for the new packet:
hdr_david* hdr = hdr_david::access(pkt);
// Send the packet
send(pkt, 0);
// return TCL_OK, so the calling function knows that the
// command has been processed
return (TCL_OK);
}
}
else if (argc == 3) {
TclObject *obj;
if ((obj = TclObject::lookup (argv[2])) == 0) {
fprintf (stderr, "%s: %s lookup of %s failed\n",
__FILE__, argv[1], argv[2]);
return TCL_ERROR;
}
if (strcasecmp (argv[1], "tracetarget") == 0) {
trace_target = (Trace *) obj;
printf("connected\n");
return TCL_OK;
}
}
// If the command hasn't been processed by PingAgent()::command,
// call the command() function for the base class
return (Agent::command(argc, argv));
}
// Trigger function when packet reception occured
void DavidAgent::recv(Packet* pkt, Handler*)
{
// Access the IP header for the received packet:
hdr_ip* hdrip = hdr_ip::access(pkt);
// Access the David header for the received packet:
hdr_david* hdr = hdr_david::access(pkt);
// Check Hello
if(hdr->type == DAVID_PACKET_HELLO)
printf("David: DAVID_PACKET_HELLO received\n");
// Discard the packet
Packet::free(pkt);
}
#ifndef _lifl_david_h_
#define _lifl_david_h_
#define DAVID_STARTUP_ADVERTISE 2.0
// Includes
#include "agent.h"
#include "tclcl.h"
#include "packet.h"
#include "address.h"
#include "ip.h"
#include "random.h"
#include "trace.h"
#define DAVID_PACKET_HELLO 1
// David header
struct hdr_david {
// Packet type
char type;
// required by PacketHeaderManager
static int offset_;
// Header access methods
inline static int& offset() { return offset_; }
inline static hdr_david* access(const Packet* p) {
return (hdr_david*) p->access(offset_);
}
};
class DavidAgent : public Agent {
/*
friend class DavidAdvertiseHandler;
*/
private:
/*
// Callback function for events
void handler_callback(Event *e);
// Periodic advertise event
Event *advertise_event;
// Advertise event handler
DavidAdvertiseHandler *advertise_handler;
*/
// Startup function
void startup();
// Trace variables and functions
void trace(char* fmt, ...);
Trace *trace_target;
public:
DavidAgent();
virtual int command(int argc, const char*const* argv);
virtual void recv(Packet*, Handler*);
};
/*
class DavidAdvertiseHandler : public Handler {
public:
DavidAdvertiseHandler(DavidAgent *a_) { a = a_; }
virtual void handle(Event *e) { a->handler_callback(e); }
private:
DavidAgent *a;
};
*/
#endif
# ======================================================================
# Define options
# ======================================================================
set val(chan) Channel/WirelessChannel ;# channel type
set val(prop) Propagation/TwoRayGround ;# radio-propagation model
set val(netif) Phy/WirelessPhy ;# network interface type
set val(mac) Mac/802_11 ;# MAC type
set val(ifq) Queue/DropTail/PriQueue ;# interface queue type
set val(ll) LL ;# link layer type
set val(ant) Antenna/OmniAntenna ;# antenna model
set val(ifqlen) 50 ;# max packet in ifq
set val(nn) 2 ;# number of mobilenodes
set val(rp) DAVID ;# routing protocol
# ======================================================================
# Main Program
# ======================================================================
# Instance the simulator
set ns [new Simulator]
# Newtrace ON
$ns use-newtrace
# Create NAM and normal traces
set tracefd [open david.tr w]
$ns trace-all $tracefd
set tracenam [open david.nam w]
$ns namtrace-all $tracenam
# Set up topography object
set topo [new Topography]
$topo load_flatgrid 500 500
# Create God
create-god $val(nn)
# Create a single channel
set chan_1_ [new $val(chan)]
# Configure node
$ns node-config \
-adhocRouting $val(rp) \
-llType $val(ll) \
-macType $val(mac) \
-ifqType $val(ifq) \
-ifqLen $val(ifqlen) \
-antType $val(ant) \
-propType $val(prop) \
-phyType $val(netif) \
-topoInstance $topo \
-agentTrace ON \
-routerTrace ON \
-macTrace ON \
-movementTrace ON \
-channel $chan_1_
# Set up each node
for {set i 0} {$i < $val(nn) } {incr i} {
set node_($i) [$ns node]
$node_($i) random-motion 0;
}
# Provide initial co-ordinates for mobilenodes
$node_(0) set X_ 5.0
$node_(0) set Y_ 2.0
$node_(0) set Z_ 0.0
$node_(1) set X_ 390.0
$node_(1) set Y_ 385.0
$node_(1) set Z_ 0.0
# Start DAVID routing
$ns at 0.0 "$node_(0) david-start"
$ns at 0.0 "$node_(1) david-start"
# Simple node movements
$ns at 50.0 "$node_(1) setdest 25.0 20.0 15.0"
$ns at 10.0 "$node_(0) setdest 20.0 18.0 1.0"
$ns at 100.0 "$node_(1) setdest 490.0 480.0 15.0"
# Tell nodes when the simulation ends
#
for {set i 0} {$i < $val(nn) } {incr i} {
$ns at 150.0 "$node_($i) reset";
}
$ns at 150.0 "stop"
$ns at 150.01 "$ns halt"
# Clean up the mess
proc stop {} {
global ns tracefd tracenam
$ns flush-trace
close $tracefd
close $tracenam
}
# As long as you hit that wire with the connecting hook at precisely
# eighty-eight miles per hour the instant the lightning strikes the
# tower ... everything will be fine!
$ns run