开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
ns-lib.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：61k
源码类别：

通讯编程

开发平台：

Visual C++

ns-lib.tcl：源码内容
  1. # -*- Mode:tcl; tcl-indent-level:8; tab-width:8; indent-tabs-mode:t -*-
  2. #
  3. # Copyright (c) 1996 Regents of the University of California.
  4. # All rights reserved.
  5. # 
  6. # Redistribution and use in source and binary forms, with or without
  7. # modification, are permitted provided that the following conditions
  8. # are met:
  9. # 1. Redistributions of source code must retain the above copyright
  10. #    notice, this list of conditions and the following disclaimer.
  11. # 2. Redistributions in binary form must reproduce the above copyright
  12. #    notice, this list of conditions and the following disclaimer in the
  13. #    documentation and/or other materials provided with the distribution.
  14. # 3. All advertising materials mentioning features or use of this software
  15. #    must display the following acknowledgement:
  16. #  This product includes software developed by the MASH Research
  17. #  Group at the University of California Berkeley.
  18. # 4. Neither the name of the University nor of the Research Group may be
  19. #    used to endorse or promote products derived from this software without
  20. #    specific prior written permission.
  21. # 
  22. # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  23. # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  24. # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  25. # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  26. # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  27. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  28. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  29. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  30. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  31. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  32. # SUCH DAMAGE.
  33. #
  35. # @(#) $Header: /cvsroot/nsnam/ns-2/tcl/lib/ns-lib.tcl,v 1.276 2008/02/18 03:39:02 tom_henderson Exp $
  38. #
  39. # Word of warning to developers:
  40. # this code (and all it sources) is compiled into the
  41. # ns executable.  You need to rebuild ns or explicitly
  42. # source this code to see changes take effect.
  43. #
  47. proc warn {msg} {
  48. global warned_
  49. if {![info exists warned_($msg)]} {
  50. puts stderr "warning: $msg"
  51. set warned_($msg) 1
  52. }
  53. }
  55. if {[info commands debug] == ""} {
  56. proc debug args {
  57. warn {Script debugging disabled.  Reconfigure with --with-tcldebug, and recompile.}
  58. }
  59. }
  61. proc assert args {
  62.         if [catch "expr $args" ret] {
  63.                 set ret [eval expr $args]
  64.         }
  65.         if {! $ret} {
  66.                 error "assertion failed: $args"
  67.         }
  68. }
  70. proc find-max list {
  71. set max 0
  72. foreach val $list {
  73. if {$val > $max} {
  74. set max $val
  75. }
  76. }
  77. return $max
  78. }
  80. proc bw_parse { bspec } {
  81. if { [scan $bspec "%f%s" b unit] == 1 } {
  82. set unit bps
  83. }
  84. regsub {[/p]s(ec)?$} $unit {} unit
  85. if [string match {*B} $unit] {
  86. set b [expr $b*8]
  87. set unit "[string trimright $unit B]b"
  88. }
  89. switch $unit {
  90. b { return $b }
  91. kb { return [expr $b*1000] }
  92. Mb { return [expr $b*1000000] }
  93. Gb { return [expr $b*1000000000] }
  94. default { 
  95. puts "error: bw_parse: unknown unit `$unit'" 
  96. exit 1
  97. }
  98. }
  99. }
  101. proc time_parse { spec } {
  102. if { [scan $spec "%f%s" t unit] == 1 } {
  103. set unit s
  104. }
  105. regsub {sec$} $unit {s} unit
  106. switch $unit {
  107. s { return $t }
  108. ms { return [expr $t*1e-3] }
  109. us { return [expr $t*1e-6] }
  110. ns { return [expr $t*1e-9] }
  111. ps { return [expr $t*1e-12] }
  112. default { 
  113. puts "error: time_parse: unknown unit `$unit'" 
  114. exit 1
  115. }
  116. }
  117. }
  119. proc delay_parse { spec } {
  120. return [time_parse $spec]
  121. }
  124. #
  125. # Create the core OTcl class called "Simulator".
  126. # This is the principal interface to the simulation engine.
  127. #
  128. #Class Simulator
  130. #
  131. # XXX Whenever you modify the source list below, please also change the
  132. # OTcl script dependency list in Makefile.in
  133. #
  134. source ns-autoconf.tcl
  135. source ns-address.tcl
  136. source ns-node.tcl
  137. source ns-rtmodule.tcl
  138. source ns-hiernode.tcl
  139. source ns-mobilenode.tcl
  140. source ns-bsnode.tcl
  141. source ns-link.tcl
  142. source ns-source.tcl
  143. source ns-compat.tcl
  144. source ns-packet.tcl
  145. source ns-queue.tcl
  146. source ns-trace.tcl
  147. source ns-random.tcl
  148. source ns-agent.tcl
  149. source ns-route.tcl
  150. source ns-errmodel.tcl
  151. source ns-intserv.tcl
  152. source ns-cmutrace.tcl
  153. source ns-mip.tcl
  154. source ns-sat.tcl
  155. #source ns-nix.tcl
  156. source ns-diffusion.tcl
  157. source ../rtp/session-rtp.tcl
  158. source ../interface/ns-iface.tcl
  159. source ../lan/ns-mac.tcl
  161. # Added by Sushmita to support event tracing for mac-simple and 802.11
  162. source ../lan/ns-mac-simple.tcl
  163. source ../lan/ns-mac-802_11.tcl
  165. source ../lan/ns-ll.tcl
  166. source ../lan/vlan.tcl
  167. source ../lan/abslan.tcl
  168. source ../mcast/timer.tcl
  169. source ../mcast/ns-mcast.tcl
  170. source ns-srcrt.tcl
  171. source ../mcast/McastProto.tcl
  172. source ../mcast/DM.tcl
  173. source ../ctr-mcast/CtrMcast.tcl
  174. source ../ctr-mcast/CtrMcastComp.tcl
  175. source ../ctr-mcast/CtrRPComp.tcl
  176. source ../mcast/BST.tcl
  177. source ../mcast/srm.tcl
  178. source ../mcast/srm-ssm.tcl
  179. # These files removed due to licensing conflicts
  180. # source ../mcast/mftp_snd.tcl
  181. # source ../mcast/mftp_rcv.tcl
  182. # source ../mcast/mftp_rcv_stat.tcl
  183. source ../mcast/McastMonitor.tcl
  184. source ../rlm/rlm.tcl
  185. source ../rlm/rlm-ns.tcl
  186. source ../session/session.tcl
  187. source ../webcache/http-server.tcl
  188. source ../webcache/http-cache.tcl
  189. source ../webcache/http-agent.tcl
  190. source ../webcache/http-mcache.tcl
  191. source ../webcache/webtraf.tcl
  192. source ../webcache/empweb.tcl
  193. source ns-namsupp.tcl
  194. source ../mobility/dsdv.tcl
  195. source ../mobility/dsr.tcl
  196. source ../mobility/com.tcl
  198. source ../plm/plm.tcl
  199. source ../plm/plm-ns.tcl
  200. source ../plm/plm-topo.tcl
  202. # MPLS
  203. source ../mpls/ns-mpls-simulator.tcl
  204. source ../mpls/ns-mpls-node.tcl
  205. source ../mpls/ns-mpls-ldpagent.tcl
  206. source ../mpls/ns-mpls-classifier.tcl
  208. source ns-default.tcl
  209. source ../emulate/ns-emulate.tcl
  211. #pushback
  212. source ns-pushback.tcl
  214. # PGM
  215. #source ../pgm/ns-pgm.tcl
  217. #LMS
  218. source ../mcast/ns-lms.tcl
  220. # STL dependent modules get included
  221. # ONLY when STL is found
  223. if {[ns-hasSTL] == 1} {
  224. source ns-nix.tcl
  225. source ../pgm/ns-pgm.tcl
  226. source ../rtglib/ns-rtProtoLS.tcl
  227. source ../delaybox/delaybox.tcl
  228. source ../packmime/packmime.tcl
  229. }
  231. source ns-qsnode.tcl
  233. # Obsolete modules
  234. #source ns-wireless-mip.tcl
  235. #source ns-nam.tcl
  237. Simulator instproc init args {
  239. # Debojyoti added this for asim 
  241. $self instvar useasim_
  242. $self instvar slinks_
  243. $self instvar nconn_
  244. $self instvar sflows_
  245. $self instvar nsflows_
  247. set slinks_(0:0) 0
  248. set nconn_ 0
  249. set conn_ ""
  250. # for short flows stuff
  251. set sflows_ "" 
  252. set nsflows_ 0
  253. set useasim_ 0
  255. $self create_packetformat
  256. $self use-scheduler Calendar
  257. #$self use-scheduler List
  258. $self set nullAgent_ [new Agent/Null]
  259. $self set-address-format def
  260. if {[lindex $args 0] == "-multicast"} {
  261. $self multicast $args
  262. }
  263. eval $self next $args
  264. }
  266. Simulator instproc nullagent {} {
  267. $self instvar nullAgent_
  268. return $nullAgent_
  269. }
  271. Simulator instproc use-scheduler type {
  272. $self instvar scheduler_
  273. if [info exists scheduler_] {
  274. if { [$scheduler_ info class] == "Scheduler/$type" } {
  275. return
  276. } else {
  277. delete $scheduler_
  278. }
  279. }
  280. set scheduler_ [new Scheduler/$type]
  281. $scheduler_ now
  282. }
  284. Simulator instproc delay_parse { spec } {
  285. return [time_parse $spec]
  286. }
  288. Simulator instproc bw_parse { spec } {
  289. return [bw_parse $spec]
  290. }
  292. #
  293. # A simple method to wrap any object around
  294. # a trace object that dumps to stdout
  295. #
  296. Simulator instproc dumper obj {
  297. set t [$self alloc-trace hop stdout]
  298. $t target $obj
  299. return $t
  300. }
  302. # New node structure
  303. #
  304. # Add APT to support multi-interface: user can specified multiple channels
  305. # when config nod. Still need modifications in routing agents to make
  306. # multi-interfaces really work.   -chen xuan  07/21/00
  307. #
  308. # Define global node configuration
  309. # $ns_ node-config -addressType flat/hierarchical
  310. #                  -adhocRouting   DSDV/DSR/TORA
  311. #                  -llType
  312. #                  -macType
  313. #                  -propType
  314. #                  -ifqType
  315. #                  -ifqLen
  316. #                  -phyType
  317. #                  -antType
  318. #    -channel
  319. #                  -channelType
  320. #                  -topologyInstance
  321. #                  -wiredRouting   ON/OFF
  322. #                  -mobileIP       ON/OFF
  323. #                  -energyModel    "EnergyModel"
  324. #                  -initialEnergy  (in Joules)
  325. #                  -rxPower        (in W)
  326. #                  -txPower        (in W)
  327. #                  -idlePower      (in W)
  328. #
  329. #                  -sleepPower     (in W)
  330. #    -sleepTime    (in sec indicating when the node can start sleeping)
  331. #                  -agentTrace  ON
  332. #                  -routerTrace ON 
  333. #                  -macTrace OFF 
  334. #                  -phyTrace OFF 
  335. #                  -toraDebug OFF                
  336. #                  -movementTrace OFF
  337. # change wrt Mike's code
  338. #                  -eotTrace OFF
  339. #                  -diffusionFilter "GradientFilter/OnePhasePullFilter/GeoRoutingFilter/RmstFilter/SourceRouteFilter/LogFilter/TagFilter"
  342. Simulator instproc addressType  {val} { $self set addressType_  $val }
  343. Simulator instproc adhocRouting  {val} { $self set routingAgent_  $val }
  344. Simulator instproc llType  {val} { $self set llType_  $val }
  345. Simulator instproc macType  {val} { $self set macType_  $val }
  346. Simulator instproc propType  {val} { $self set propType_  $val }
  347. Simulator instproc propInstance  {val} { $self set propInstance_  $val }
  348. Simulator instproc ifqType  {val} { $self set ifqType_  $val }
  349. Simulator instproc ifqLen  {val} { $self set ifqlen_  $val }
  350. Simulator instproc phyType  {val} { $self set phyType_  $val }
  351. Simulator instproc antType  {val} { $self set antType_  $val }
  352. Simulator instproc channel {val} {$self set channel_ $val}
  353. Simulator instproc channelType {val} {$self set channelType_ $val}
  354. Simulator instproc topoInstance {val} {$self set topoInstance_ $val}
  355. Simulator instproc wiredRouting {val} {$self set wiredRouting_ $val}
  356. Simulator instproc mobileIP {val} {$self set mobileIP_ $val}
  357. Simulator instproc energyModel  {val} { $self set energyModel_  $val }
  358. Simulator instproc initialEnergy  {val} { $self set initialEnergy_  $val }
  359. Simulator instproc txPower  {val} { $self set txPower_  $val }
  360. Simulator instproc rxPower  {val} { $self set rxPower_  $val }
  361. Simulator instproc idlePower  {val} { $self set idlePower_  $val }
  362. #
  363. Simulator instproc sleepPower  {val} { $self set sleepPower_  $val }
  364. Simulator instproc sleepTime  {val} { $self set sleepTime_  $val }
  365. Simulator instproc transitionPower  {val} { $self set transitionPower_  $val }
  366. Simulator instproc transitionTime  {val} { $self set transitionTime_  $val }
  367. #
  368. Simulator instproc IncomingErrProc  {val} { $self set inerrProc_  $val }
  369. Simulator instproc OutgoingErrProc  {val} { $self set outerrProc_  $val }
  370. Simulator instproc FECProc  {val} { $self set FECProc_  $val }
  371. Simulator instproc agentTrace  {val} { $self set agentTrace_  $val }
  372. Simulator instproc routerTrace  {val} { $self set routerTrace_  $val }
  373. Simulator instproc macTrace  {val} { $self set macTrace_  $val }
  374. Simulator instproc phyTrace  {val} { $self set phyTrace_  $val }
  375. Simulator instproc movementTrace  {val} { $self set movementTrace_  $val }
  376. Simulator instproc toraDebug {val} {$self set toraDebug_ $val }
  377. Simulator instproc satNodeType {val} {$self set satNodeType_ $val}
  378. Simulator instproc downlinkBW {val} {$self set downlinkBW_ $val}
  379. Simulator instproc stopTime {val} {$self set stopTime_ $val}
  381. # This method is needed so that new Routing Agents can be implemented in a dynamic
  382. # library and used without having to modify Simulator::create-wireless-node
  383. Simulator instproc rtAgentFunction {val} {$self set rtAgentFunction_ $val}
  386. # change wrt Mike's code
  387. Simulator instproc eotTrace  {val} { $self set eotTrace_  $val }
  388. Simulator instproc diffusionFilter {val} {$self set diffFilter_ $val}
  390. Simulator instproc MPLS { val } { 
  391. if { $val == "ON" } {
  392. Node enable-module "MPLS"
  393. } else {
  394. Node disable-module "MPLS"
  395. }
  396. }
  399. Simulator instproc PGM { val } { 
  400.         if { $val == "ON" } {
  401.                 Node enable-module "PGM"
  402.         } else {
  403.                 Node disable-module "PGM"
  404.         }
  405. }
  406. Simulator instproc LMS { val } {
  407. if { $val == "ON" } {
  408. Node enable-module "LMS"
  409. } else {
  410. Node disable-module "LMS"
  411. }
  412. }
  414. Simulator instproc get-nodetype {} {
  415. $self instvar addressType_ routingAgent_ wiredRouting_ 
  416. set val ""
  418. if { [info exists addressType_] && $addressType_ == "hierarchical" } {
  419. set val Hier
  420. }
  421. if { [info exists routingAgent_] && $routingAgent_ != "" } {
  422. set val Mobile
  423. }
  424. if { [info exists wiredRouting_] && $wiredRouting_ == "ON" } {
  425. set val Base
  426. }
  427. if { [info exists wiredRouting_] && $wiredRouting_ == "OFF"} {
  428. set val Base
  429. }
  430. if { [Simulator set mobile_ip_] } {
  431. if { $val == "Base" && $wiredRouting_ == "ON" } {
  432. set val MIPBS
  433. }
  434. if { $val == "Base" && $wiredRouting_ == "OFF" } {
  435. set val MIPMH
  436. }
  437. }
  438. return $val
  439. }
  441. Simulator instproc node-config args {
  442.         # Object::init-vars{} is defined in ~tclcl/tcl-object.tcl.
  443.         # It initializes all default variables in the following way:
  444.         #  1.  Look for pairs of {-cmd val} in args
  445.         #  2.  If "$self $cmd $val" is not valid then put it in a list of 
  446.         #      arguments to be returned to the caller.
  447.         # 
  448.         # Since we do not handle undefined {-cmd val} pairs, we ignore 
  449.         # return value from init-vars{}.
  450.         set args [eval $self init-vars $args]
  452.         $self instvar addressType_  routingAgent_ propType_  macTrace_ 
  453.     routerTrace_ agentTrace_ movementTrace_ channelType_ channel_ 
  454.     chan topoInstance_ propInstance_ mobileIP_ 
  455.     rxPower_ txPower_ idlePower_ sleepPower_ sleepTime_ transitionPower_ 
  456.     transitionTime_ satNodeType_ eotTrace_ phyTrace_
  458. if [info exists phyTrace_] {
  459. Simulator set PhyTrace_ $phyTrace_
  460. }
  463.         if [info exists macTrace_] {
  464. Simulator set MacTrace_ $macTrace_
  465. }
  466.         if [info exists routerTrace_] {
  467. Simulator set RouterTrace_ $routerTrace_
  468. }
  469.         if [info exists agentTrace_] {
  470. Simulator set AgentTrace_ $agentTrace_
  471. }
  472.         if [info exists movementTrace_] {
  473. Simulator set MovementTrace_ $movementTrace_
  474. }
  476. # change wrt Mike's code
  477. if [info exists eotTrace_] {
  478.                 Simulator set EotTrace_ $eotTrace_
  479.         }
  481.         # hacking for matching old cmu add-interface
  482.         # not good style, for back-compability ONLY
  483. #
  484. # Only create 1 instance of prop
  485. if {[info exists propInstance_]} {
  486. if {[info exists propType_] && [Simulator set propInstCreated_] == 0} {
  487. warn "Both propType and propInstance are set. propType is ignored."
  488. }
  489. } else {
  490. if {[info exists propType_]} {
  491. set propInstance_ [new $propType_]
  492. Simulator set propInstCreated_ 1
  493. }
  494. }
  496. # Add multi-interface support:
  497.   # User can only specify either channelType_ (single_interface as 
  498. # before) or channel_ (multi_interface)
  499.   # If both variables are specified, error!
  500.   if {[info exists channelType_] && [info exists channel_]} { 
  501. error "Can't specify both channel and channelType, error!"
  502. } elseif {[info exists channelType_] && ![info exists satNodeType_]} {
  503. # Single channel, single interface
  504. warn "Please use -channel as shown in tcl/ex/wireless-mitf.tcl"
  505. if {![info exists chan]} {
  506. set chan [new $channelType_]
  507. }
  508.   } elseif {[info exists channel_]} {
  509. # Multiple channel, multiple interfaces
  510. set chan $channel_
  511.   }
  512. if [info exists topoInstance_] {
  513. $propInstance_  topography $topoInstance_
  514. }
  515. # set address type, hierarchical or expanded
  516. if {[string compare $addressType_ ""] != 0} {
  517. $self set-address-format $addressType_ 
  518. }
  519. # set mobileIP flag
  520. if { [info exists mobileIP_] && $mobileIP_ == "ON"} {
  521. Simulator set mobile_ip_  1
  522. } else {
  523. if { [info exists mobileIP_] } {
  524. Simulator set mobile_ip_ 0
  525. }
  526. }
  527. }
  529. # Default behavior is changed: consider nam as not initialized if 
  530. # no shape OR color parameter is given
  531. Simulator instproc node args {
  532. $self instvar Node_ routingAgent_ wiredRouting_ satNodeType_
  533.         if { [Simulator info vars EnableMcast_] != "" } {
  534.                 warn "Flag variable Simulator::EnableMcast_ discontinued.nt
  535.                       Use multicast methods as:ntt
  536.                         % set ns [new Simulator -multicast on]ntt
  537.                         % $ns multicast"
  538.                 $self multicast
  539.                 Simulator unset EnableMcast_
  540.         }
  541.         if { [Simulator info vars NumberInterfaces_] != "" } {
  542.                 warn "Flag variable Simulator::NumberInterfaces_ discontinued.nt
  543.                       Setting this variable will not affect simulations."
  544.                 Simulator unset NumberInterfaces_
  545.         }
  547. # Satellite node
  548. if { [info exists satNodeType_] } {
  549. set node [eval $self create-satnode]
  550. #simulator's nodelist in C++ space
  551. if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  552. # add node to simulator's nodelist in C++ space
  553. $self add-node $node [$node id]
  554. # Want to keep global state of wiredRouting info
  555. SatRouteObject set wiredRouting_ true
  556. }
  557. return $node
  558. }
  560. # wireless-ready node
  561. if { [info exists routingAgent_] && ($routingAgent_ != "") } {
  562. set node [eval $self create-wireless-node $args]
  563. # for base node
  564. if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  565. set Node_([$node id]) $node
  566. #simulator's nodelist in C++ space
  567. $self add-node $node [$node id] 
  568. }
  569. return $node
  570. }
  573. # Enable-mcast is now done automatically inside Node::init{}
  574. # 
  575. # XXX node_factory_ is deprecated, HOWEVER, since it's still used by
  576. # mobile IP, algorithmic routing, manual routing, and backward 
  577. # compability tests of hierarchical routing, we should keep it around
  578. # before all related code are wiped out.
  579. set node [eval new [Simulator set node_factory_] $args]
  580. set Node_([$node id]) $node
  582. #add to simulator's nodelist in C++ space
  583. $self add-node $node [$node id] 
  585. #set the nodeid in c++ Node - ratul
  586. $node nodeid [$node id]
  588. $node set ns_ $self
  589. $self check-node-num
  590. return $node
  591. }
  593. # XXX This is stupid hack. When old code (not using node-config) is used, 
  594. # create-wireless-node{} will not be called, and IMEPFlag_ will remain empty
  595. # (as set in ns-default.tcl), then Node/MobileNode will use global proc 
  596. # cmu-trace to create trace objects; otherwise mobility-trace{} will be 
  597. # triggered.
  598. Simulator instproc imep-support {} {
  599. return [Simulator set IMEPFlag_]
  600. }
  602. # XXX This should be moved into the node initialization procedure instead 
  603. # of standing here in ns-lib.tcl.
  604. Simulator instproc create-wireless-node args {
  605.         $self instvar routingAgent_ wiredRouting_ propInstance_ llType_ 
  606.     macType_ ifqType_ ifqlen_ phyType_ chan antType_ 
  607.     energyModel_ initialEnergy_ txPower_ rxPower_ 
  608.     idlePower_ sleepPower_ sleepTime_ transitionPower_ transitionTime_ 
  609.     topoInstance_ level1_ level2_ inerrProc_ outerrProc_ FECProc_ rtAgentFunction_
  611. Simulator set IMEPFlag_ OFF
  613.         # create node instance
  614.         set node [eval $self create-node-instance $args]
  615.         
  616.         # basestation address setting
  617.         if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
  618. $node base-station [AddrParams addr2id [$node node-addr]]
  619.      }
  620.         if {$rtAgentFunction_ != ""} {
  621. set ragent [$self $rtAgentFunction_ $node]
  622. } else {
  623. switch -exact $routingAgent_ {
  624.     DSDV {
  625.     set ragent [$self create-dsdv-agent $node]
  626.     }
  627.     DSR {
  628.     $self at 0.0 "$node start-dsr"
  629.     }
  630.     AODV {
  631.     set ragent [$self create-aodv-agent $node]
  632.     }
  633.     TORA {
  634.     Simulator set IMEPFlag_ ON
  635.     set ragent [$self create-tora-agent $node]
  636.     }
  637.     DIFFUSION/RATE {
  638.     eval $node addr $args
  639.     set ragent [$self create-diffusion-rate-agent $node]
  640.     }
  641.     DIFFUSION/PROB {
  642.     eval $node addr $args
  643.     set ragent [$self create-diffusion-probability-agent $node]
  644.     }
  645.     Directed_Diffusion {
  646.     eval $node addr $args
  647.     set ragent [$self create-core-diffusion-rtg-agent $node]
  648.     }
  649.     FLOODING {
  650.     eval $node addr $args
  651.     set ragent [$self create-flooding-agent $node]
  652.     }
  653.     OMNIMCAST {
  654.     eval $node addr $args
  655.     set ragent [$self create-omnimcast-agent $node]
  656.     }
  657.     DumbAgent {
  658.     set ragent [$self create-dumb-agent $node]
  659.     }
  660.     ManualRtg {
  661.     set ragent [$self create-manual-rtg-agent $node]
  662.     }
  663.     default {
  664.     eval $node addr $args
  665.     puts "Wrong node routing agent!"
  666.     exit
  667.     }
  668. }
  669. }
  671. # errProc_ and FECProc_ are an option unlike other 
  672.         # parameters for node interface
  673. if ![info exist inerrProc_] {
  674. set inerrProc_ ""
  675. }
  676. if ![info exist outerrProc_] {
  677. set outerrProc_ ""
  678. }
  679. if ![info exist FECProc_] {
  680. set FECProc_ ""
  681. }
  685. # Add main node interface
  686. $node add-interface $chan $propInstance_ $llType_ $macType_ 
  687.     $ifqType_ $ifqlen_ $phyType_ $antType_ $topoInstance_ 
  688. $inerrProc_ $outerrProc_ $FECProc_
  689. # Attach agent
  690. if {$routingAgent_ != "DSR"} {
  691. $node attach $ragent [Node set rtagent_port_]
  692. }
  693. if {$routingAgent_ == "DIFFUSION/RATE" ||
  694.             $routingAgent_ == "DIFFUSION/PROB" ||
  695.             $routingAgent_ == "FLOODING" ||
  696.             $routingAgent_ == "OMNIMCAST" ||
  697.     $routingAgent_ == "Directed_Diffusion" } {
  698. $ragent port-dmux [$node demux]
  699. $node instvar ll_
  700. $ragent add-ll $ll_(0)
  701. }
  702. if { $routingAgent_ == "DumbAgent" } {
  703. $ragent port-dmux [$node demux]
  704. }
  707. # Bind routing agent and mip agent if existing basestation 
  708. # address setting
  709.         if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
  710. if { $routingAgent_ != "DSR" } {
  711. $node mip-call $ragent
  712. }
  713. }
  714. #
  715.         # This Trace Target is used to log changes in direction
  716.         # and velocity for the mobile node.
  717.         #
  718. set tracefd [$self get-ns-traceall]
  719.         if {$tracefd != "" } {
  720. $node nodetrace $tracefd
  721. $node agenttrace $tracefd
  722. }
  723. set namtracefd [$self get-nam-traceall]
  724. if {$namtracefd != "" } {
  725. $node namattach $namtracefd
  726. }
  727. if [info exists energyModel_] {
  728. if  [info exists level1_] {
  729. set l1 $level1_
  730. } else {
  731. set l1 0.5
  732. }
  733. if  [info exists level2_] {
  734. set l2 $level2_
  735. } else {
  736. set l2 0.2
  737. }
  738. $node addenergymodel [new $energyModel_ $node 
  739. $initialEnergy_ $l1 $l2]
  740.         }
  741.         if [info exists txPower_] {
  742. $node setPt $txPower_
  743.         }
  744.         if [info exists rxPower_] {
  745. $node setPr $rxPower_
  746.         }
  747.         if [info exists idlePower_] {
  748. $node setPidle $idlePower_
  749.         }
  750. #
  751. if [info exists sleepPower_] {
  752. $node setPsleep $sleepPower_
  753.         }
  754. if [info exists sleepTime_] {
  755. $node setTSleep $sleepTime_
  756.         }
  757. if [info exists transitionPower_] {
  758. $node setPtransition $transitionPower_
  759.         }
  760. if [info exists transitionTime_] {
  761. $node setTtransition $transitionTime_
  762.         }
  763. #
  764. $node topography $topoInstance_
  766. return $node
  767. }
  769. Simulator instproc create-node-instance args {
  770. $self instvar routingAgent_
  771. # DSR is a special case
  772. if {$routingAgent_ == "DSR"} {
  773. set nodeclass [$self set-dsr-nodetype]
  774. } else {
  775. set nodeclass Node/MobileNode
  776. }
  777. return [eval new $nodeclass $args]
  778. }
  780. Simulator instproc set-dsr-nodetype {} {
  781. $self instvar wiredRouting_ 
  782. set nodetype SRNodeNew
  783. # MIP mobilenode
  784. if [Simulator set mobile_ip_] {
  785. set nodetype SRNodeNew/MIPMH
  786. } 
  787. # basestation dsr node
  788. if { [info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  789. set nodetype Node/MobileNode/BaseStationNode
  790. }
  791. return $nodetype
  792. }
  794. Simulator instproc create-tora-agent { node } {
  795.         set ragent [new Agent/TORA [$node id]]
  796. $node set ragent_ $ragent
  797. return $ragent
  798. }
  800. Simulator instproc create-dsdv-agent { node } {
  801. # Create a dsdv routing agent for this node
  802. set ragent [new Agent/DSDV]
  803. # Setup address (supports hier-addr) for dsdv agent
  804. # and mobilenode
  805. set addr [$node node-addr]
  806. $ragent addr $addr
  807. $ragent node $node
  808. if [Simulator set mobile_ip_] {
  809. $ragent port-dmux [$node demux]
  810. }
  811. $node addr $addr
  812. $node set ragent_ $ragent
  813. $self at 0.0 "$ragent start-dsdv"    ;# start updates
  814. return $ragent
  815. }
  818. Simulator instproc create-dumb-agent { node } {
  820. # create a simple wireless agent
  821. # that only forwards packets
  822. # used for testing single hop brdcast/unicast mode 
  823. # for wireless macs
  825. set ragent [new Agent/DumbAgent]
  826. $node set ragent_ $ragent
  828. return $ragent
  829. }
  831. Simulator instproc create-manual-rtg-agent { node } {
  833. # create a simple wireless agent
  834. # that only forwards packets
  835. # used for testing single hop brdcast/unicast mode 
  836. # for wireless macs
  838. set ragent [new Agent/ManualRtgAgent]
  839. $node set ragent_ $ragent
  840. $node attach $ragent [Node set rtagent_port_]
  842. return $ragent
  843. }
  845. Simulator instproc create-aodv-agent { node } {
  846.         #  Create AODV routing agent
  847. set ragent [new Agent/AODV [$node node-addr]]
  848.         $self at 0.0 "$ragent start"     ;# start BEACON/HELLO Messages
  849.         $node set ragent_ $ragent
  850.         return $ragent
  851. }
  853. Simulator instproc use-newtrace {} {
  854. Simulator set WirelessNewTrace_ 1
  855. } 
  857. Simulator instproc use-taggedtrace { {tag ON} } {
  858. Simulator set TaggedTrace_ $tag
  859. }
  861. Simulator instproc hier-node haddr {
  862.   error "hier-nodes should be created with [$ns_ node $haddr]"
  863. }
  865. Simulator instproc now {} {
  866. $self instvar scheduler_
  867. return [$scheduler_ now]
  868. }
  870. Simulator instproc at args {
  871. $self instvar scheduler_
  872. return [eval $scheduler_ at $args]
  873. }
  875. Simulator instproc at-now args {
  876. $self instvar scheduler_
  877. return [eval $scheduler_ at-now $args]
  878. }
  880. Simulator instproc cancel args {
  881. $self instvar scheduler_
  882. return [eval $scheduler_ cancel $args]
  883. }
  885. Simulator instproc after {ival args} {
  886.         eval $self at [expr [$self now] + $ival] $args
  887. }
  889. #
  890. # check if total num of nodes exceed 2 to the power n 
  891. # where <n=node field size in address>
  892. #
  893. Simulator instproc check-node-num {} {
  894. if {[Node set nn_] > [expr pow(2, [AddrParams nodebits])]} {
  895. error "Number of nodes exceeds node-field-size of [AddrParams nodebits] bits"
  896. }
  897. }
  899. #
  900. # Check if number of items at each hier level (num of nodes, or clusters or
  901. # domains) exceed size of that hier level field size (in bits). should be 
  902. # modified to support n-level of hierarchies
  903. #
  904. Simulator instproc chk-hier-field-lengths {} {
  905. AddrParams instvar domain_num_ cluster_num_ nodes_num_
  906. if [info exists domain_num_] {
  907. if {[expr $domain_num_ - 1]> [AddrParams NodeMask 1]} {
  908. error "# of domains exceed dom-field-size "
  909. }
  910. } 
  911. if [info exists cluster_num_] {
  912. set maxval [expr [find-max $cluster_num_] - 1] 
  913. if {$maxval > [expr pow(2, [AddrParams NodeMask 2])]} {
  914. error "# of clusters exceed clus-field-size "
  915. }
  916. }
  917. if [info exists nodes_num_] {
  918. set maxval [expr [find-max $nodes_num_] -1]
  919. if {$maxval > [expr pow(2, [AddrParams NodeMask 3])]} {
  920. error "# of nodess exceed node-field-size"
  921. }
  922. }
  923. }
  926. Simulator instproc check-smac {} {
  927. $self instvar macType_
  928. if { [info exist macType_] && $macType_ == "Mac/SMAC" } {
  929. if { [$macType_ set syncFlag_] } {
  930. puts "nNOTE: SMAC is running with sleep-wakeup cycles on. Please make sure to run yr applications AFTER the nodes get sync'ed which is about 40sec for the default settings.n"
  931. }
  932. }
  933. }
  936. Simulator instproc run {} {
  937. # NIXVECTOR?
  938. # global runstart
  939. # set runstart [clock seconds]
  940. $self check-smac                      ;# print warning if in sleep/wakeup cycle
  941. $self check-node-num
  942. $self rtmodel-configure ;# in case there are any
  943. [$self get-routelogic] configure
  944. $self instvar scheduler_ Node_ link_ started_ 
  946. set started_ 1
  948. #
  949. # Reset every node, which resets every agent.
  950. #
  952. foreach nn [array names Node_] {
  953. $Node_($nn) reset
  954. # GFR Additions for NixVector Routing
  955. if { [Simulator set nix-routing] } {
  956. $Node_($nn) populate-objects
  957. }
  958. }
  960. #
  961. # Also reset every queue
  962. #
  964. foreach qn [array names link_] {
  965. set q [$link_($qn) queue]
  966. $q reset
  967. }
  969. # Do all nam-related initialization here
  970. $self init-nam
  972. # NIXVECTOR xxx?
  973. # global simstart
  974. # set simstart [clock seconds]
  975. return [$scheduler_ run]
  976. }
  978. # johnh xxx?
  979. Simulator instproc log-simstart { } {
  980.         # GFR Modification to log actual start
  981.         global simstart
  982.         puts "Starting Actual Simulation"
  983.         set simstart [clock seconds]
  984. }
  986. Simulator instproc halt {} {
  987. $self instvar scheduler_
  988. #puts "time: [clock format [clock seconds] -format %X]"
  989. $scheduler_ halt
  990. }
  992. Simulator instproc dumpq {} {
  993. $self instvar scheduler_
  994. $scheduler_ dumpq
  995. }
  997. Simulator instproc is-started {} {
  998. $self instvar started_
  999. return [info exists started_]
  1000. }
  1002. Simulator instproc clearMemTrace {} {
  1003. $self instvar scheduler_
  1004. $scheduler_ clearMemTrace
  1005. }
  1007. Simulator instproc simplex-link { n1 n2 bw delay qtype args } {
  1008. $self instvar link_ queueMap_ nullAgent_ useasim_
  1009. set sid [$n1 id]
  1010. set did [$n2 id]
  1012. # Debo
  1013. if { $useasim_ == 1 } {
  1014. set slink_($sid:$did) $self
  1015. }
  1017. if [info exists queueMap_($qtype)] {
  1018. set qtype $queueMap_($qtype)
  1019. }
  1020. # construct the queue
  1021. set qtypeOrig $qtype
  1022. switch -exact $qtype {
  1023. ErrorModule {
  1024. if { [llength $args] > 0 } {
  1025. set q [eval new $qtype $args]
  1026. } else {
  1027. set q [new $qtype Fid]
  1028. }
  1029. }
  1030. intserv {
  1031. set qtype [lindex $args 0]
  1032. set q [new Queue/$qtype]
  1033. }
  1034. default {
  1035. if { [llength $args] == 0} {
  1036. set q [new Queue/$qtype]
  1037. } else {
  1038. set q [new Queue/$qtype $args]
  1039. }
  1040. }
  1041. }
  1042. # Now create the link
  1043. switch -exact $qtypeOrig {
  1044. RTM {
  1045.                         set c [lindex $args 1]
  1046.                         set link_($sid:$did) [new CBQLink       
  1047.                                         $n1 $n2 $bw $delay $q $c]
  1048.                 }
  1049.                 CBQ -
  1050.                 CBQ/WRR {
  1051.                         # assume we have a string of form "linktype linkarg"
  1052.                         if {[llength $args] == 0} {
  1053.                                 # default classifier for cbq is just Fid type
  1054.                                 set c [new Classifier/Hash/Fid 33]
  1055.                         } else {
  1056.                                 set c [lindex $args 0]
  1057.                         }
  1058.                         set link_($sid:$did) [new CBQLink       
  1059.                                         $n1 $n2 $bw $delay $q $c]
  1060.                 }
  1061. FQ      {
  1062. set link_($sid:$did) [new FQLink $n1 $n2 $bw $delay $q]
  1063. }
  1064.                 intserv {
  1065.                         #XX need to clean this up
  1066.                         set link_($sid:$did) [new IntServLink   
  1067.                                         $n1 $n2 $bw $delay $q
  1068. [concat $qtypeOrig $args]]
  1069.                 }
  1070.                 default {
  1071.                         set link_($sid:$did) [new SimpleLink    
  1072.                                         $n1 $n2 $bw $delay $q]
  1073.                 }
  1074.         }
  1075. if {$qtype == "RED/Pushback"} {
  1076. set pushback 1
  1077. } else {
  1078. set pushback 0
  1079. }
  1080. $n1 add-neighbor $n2 $pushback
  1082. #XXX yuck
  1083. if {[string first "RED" $qtype] != -1 || 
  1084.     [string first "PI" $qtype] != -1 || 
  1085.     [string first "Vq" $qtype] != -1 ||
  1086.     [string first "REM" $qtype] != -1 ||  
  1087.     [string first "GK" $qtype] != -1 ||  
  1088.     [string first "RIO" $qtype] != -1 ||
  1089.     [string first "XCP" $qtype] != -1} {
  1090. $q link [$link_($sid:$did) set link_]
  1091. }
  1093. set trace [$self get-ns-traceall]
  1094. if {$trace != ""} {
  1095. $self trace-queue $n1 $n2 $trace
  1096. }
  1097. set trace [$self get-nam-traceall]
  1098. if {$trace != ""} {
  1099. $self namtrace-queue $n1 $n2 $trace
  1100. }
  1102. # Register this simplex link in nam link list. Treat it as 
  1103. # a duplex link in nam
  1104. $self register-nam-linkconfig $link_($sid:$did)
  1105. }
  1107. #
  1108. # This is used by Link::orient to register/update the order in which links 
  1109. # should created in nam. This is important because different creation order
  1110. # may result in different layout.
  1111. #
  1112. # A poor hack. :( Any better ideas?
  1113. #
  1114. Simulator instproc register-nam-linkconfig link {
  1115. $self instvar linkConfigList_ link_
  1116. if [info exists linkConfigList_] {
  1117. # Check whether the reverse simplex link is registered,
  1118. # if so, don't register this link again.
  1119. # We should have a separate object for duplex link.
  1120. set i1 [[$link src] id]
  1121. set i2 [[$link dst] id]
  1122. if [info exists link_($i2:$i1)] {
  1123. set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
  1124. if {$pos >= 0} {
  1125. set a1 [$link_($i2:$i1) get-attribute 
  1126. "ORIENTATION"]
  1127. set a2 [$link get-attribute "ORIENTATION"]
  1128. if {$a1 == "" && $a2 != ""} {
  1129. # If this duplex link has not been 
  1130. # assigned an orientation, do it.
  1131. set linkConfigList_ [lreplace 
  1132. $linkConfigList_ $pos $pos]
  1133. } else {
  1134. return
  1135. }
  1136. }
  1137. }
  1138. # Remove $link from list if it's already there
  1139. set pos [lsearch $linkConfigList_ $link]
  1140. if {$pos >= 0} {
  1141. set linkConfigList_ 
  1142. [lreplace $linkConfigList_ $pos $pos]
  1143. }
  1144. }
  1145. lappend linkConfigList_ $link
  1146. }
  1148. #
  1149. # GT-ITM may occasionally generate duplicate links, so we need this check
  1150. # to ensure duplicated links do not appear in nam trace files.
  1151. #
  1152. Simulator instproc remove-nam-linkconfig {i1 i2} {
  1153. $self instvar linkConfigList_ link_
  1154. if ![info exists linkConfigList_] {
  1155. return
  1156. }
  1157. set pos [lsearch $linkConfigList_ $link_($i1:$i2)]
  1158. if {$pos >= 0} {
  1159. set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
  1160. return
  1161. }
  1162. set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
  1163. if {$pos >= 0} {
  1164. set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
  1165. }
  1166. }
  1168. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001
  1169. #
  1170. # we create a simplex link (NOT duplex) from the core to the interface. we can
  1171. # use arbitrary params (bw, delay, etc) since we'll never actually transmit
  1172. # data on these links. they are only used for routing (ie, to determine which 
  1173. # interface a packet should go out from)
  1174. #
  1175. Simulator instproc multihome-add-interface { core if } {
  1176.    $self instvar link_
  1177.    set coreId [$core id]
  1178.    set ifId [$if id]
  1180. # arbitrary values (doesn't matter since link will NEVER be used!)
  1181. set bw 1Mb
  1182. set delay 100ms
  1183. set type DropTail
  1185. if [info exists link_($coreId:$ifId)] {
  1186. $self remove-nam-linkconfig $coreId $ifId
  1187. }
  1188. eval $self simplex-link $core $if $bw $delay $type 
  1189. # Modified by GFR for nix-vector routing
  1190. if { [Simulator set nix-routing] } {
  1191. # Inform nodes of neighbors
  1192. $n1 set-neighbor [$core id]
  1193. $n2 set-neighbor [$if id]
  1194. }
  1197.      $core instvar multihome_interfaces_ num_interfaces_
  1198.      set interface_ {}
  1200.      # interface node
  1201.      lappend interface_ $if
  1203.      # link from interface node to core node
  1204.      lappend interface_ [$link_($coreId:$ifId) set head_]
  1206.      lappend multihome_interfaces_ $interface_
  1207. }
  1209. Simulator instproc duplex-link { n1 n2 bw delay type args } {
  1210. $self instvar link_
  1211. set i1 [$n1 id]
  1212. set i2 [$n2 id]
  1213. if [info exists link_($i1:$i2)] {
  1214. $self remove-nam-linkconfig $i1 $i2
  1215. }
  1216. eval $self simplex-link $n1 $n2 $bw $delay $type $args
  1217. eval $self simplex-link $n2 $n1 $bw $delay $type $args
  1218. # Modified by GFR for nix-vector routing
  1219. if { [Simulator set nix-routing] } {
  1220. # Inform nodes of neighbors
  1221. $n1 set-neighbor [$n2 id]
  1222. $n2 set-neighbor [$n1 id]
  1223. }
  1224. }
  1226. Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
  1227. eval $self duplex-link $n1 $n2 $bw $pd intserv $sched $signal $adc $args
  1228. }
  1230. Simulator instproc simplex-link-op { n1 n2 op args } {
  1231. $self instvar link_
  1232. eval $link_([$n1 id]:[$n2 id]) $op $args
  1233. }
  1235. Simulator instproc duplex-link-op { n1 n2 op args } {
  1236. $self instvar link_
  1237. eval $link_([$n1 id]:[$n2 id]) $op $args
  1238. eval $link_([$n2 id]:[$n1 id]) $op $args
  1239. }
  1241. Simulator instproc flush-trace {} {
  1242. $self instvar alltrace_
  1243. if [info exists alltrace_] {
  1244. foreach trace $alltrace_ {
  1245. $trace flush
  1246. }
  1247. }
  1248. }
  1250. Simulator instproc namtrace-all file   {
  1251. $self instvar namtraceAllFile_
  1252. if {$file != ""} {
  1253. set namtraceAllFile_ $file
  1254. } else {
  1255. unset namtraceAllFile_
  1256. }
  1257. }
  1259. Simulator instproc energy-color-change {level1 level2} {
  1260. $self instvar level1_ level2_
  1261.   set level1_ $level1
  1262.   set level2_ $level2
  1263. }
  1265. Simulator instproc namtrace-all-wireless {file optx opty} {
  1266.         $self instvar namtraceAllFile_
  1268. # indicate that we need a W event written to the trace
  1269. $self set namNeedsW_ 1
  1270. if { $optx != "" && $opty != "" } {
  1271. $self set namWx_ $optx
  1272. $self set namWy_ $opty
  1273. }
  1275. $self namtrace-all $file
  1276. }
  1278. Simulator instproc nam-end-wireless {stoptime} {
  1279.         $self instvar namtraceAllFile_
  1281.         if {$namtraceAllFile_ != ""} {
  1282. $self puts-nam-config "W -t $stoptime"
  1283.         }
  1284. }
  1286. Simulator instproc namtrace-some file {
  1287. $self instvar namtraceSomeFile_
  1288. set namtraceSomeFile_ $file
  1289. }
  1291. # Support for event-tracing
  1292.         
  1293. Simulator instproc eventtrace-all {{file ""}} {
  1294. $self instvar eventTraceAll_ eventtraceAllFile_ traceAllFile_
  1295. set eventTraceAll_ 1
  1296. if {$file != ""} {
  1297. set eventtraceAllFile_ $file
  1298. } else {
  1299. set eventtraceAllFile_ $traceAllFile_
  1300. }
  1302. }
  1306. Simulator instproc initial_node_pos {nodep size} {
  1307. $self instvar addressType_
  1308. $self instvar energyModel_ 
  1310. if [info exists energyModel_] {  
  1311. set nodeColor "green"
  1312. } else {
  1313. set nodeColor "black"
  1314. }
  1315. if { [info exists addressType_] && $addressType_ == "hierarchical" } {
  1316. # Hierarchical addressing
  1317. $self puts-nam-config "n -t * -a [$nodep set address_] 
  1318. -s [$nodep id] -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] 
  1319. -z $size -v circle -c $nodeColor"
  1320. } else { 
  1321. # Flat addressing
  1322. $self puts-nam-config "n -t * -s [$nodep id] 
  1323. -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size 
  1324. -v circle -c $nodeColor"
  1325. }
  1326. }
  1328. Simulator instproc trace-all file {
  1329. $self instvar traceAllFile_
  1330. set traceAllFile_ $file
  1331. }
  1333. Simulator instproc get-nam-traceall {} {
  1334. $self instvar namtraceAllFile_
  1335. if [info exists namtraceAllFile_] {
  1336. return $namtraceAllFile_
  1337. } else {
  1338. return ""
  1339. }
  1340. }
  1342. Simulator instproc get-ns-traceall {} {
  1343. $self instvar traceAllFile_
  1344. if [info exists traceAllFile_] {
  1345. return $traceAllFile_
  1346. } else {
  1347. return ""
  1348. }
  1349. }
  1351. # If exists a traceAllFile_, print $str to $traceAllFile_
  1352. Simulator instproc puts-ns-traceall { str } {
  1353. $self instvar traceAllFile_
  1354. if [info exists traceAllFile_] {
  1355. puts $traceAllFile_ $str
  1356. }
  1357. }
  1359. # If exists a traceAllFile_, print $str to $traceAllFile_
  1360. Simulator instproc puts-nam-traceall { str } {
  1361. $self instvar namtraceAllFile_
  1362. if [info exists namtraceAllFile_] {
  1363. puts $namtraceAllFile_ $str
  1364. } elseif [info exists namtraceSomeFile_] {
  1365. puts $namtraceSomeFile_ $str
  1366. }
  1367. }
  1369. # namConfigFile is used for writing color/link/node/queue/annotations. 
  1370. # XXX It cannot co-exist with namtraceAll.
  1371. Simulator instproc namtrace-config { f } {
  1372. $self instvar namConfigFile_
  1373. set namConfigFile_ $f
  1374. }
  1376. Simulator instproc get-nam-config {} {
  1377. $self instvar namConfigFile_
  1378. if [info exists namConfigFile_] {
  1379. return $namConfigFile_
  1380. } else {
  1381. return ""
  1382. }
  1383. }
  1385. # Used only for writing nam configurations to trace file(s). This is different
  1386. # from puts-nam-traceall because we may want to separate configuration 
  1387. # informations and actual tracing information
  1388. Simulator instproc puts-nam-config { str } {
  1389. $self instvar namtraceAllFile_ namConfigFile_
  1391. if [info exists namConfigFile_] {
  1392. puts $namConfigFile_ $str
  1393. } elseif [info exists namtraceAllFile_] {
  1394. puts $namtraceAllFile_ $str
  1395. } elseif [info exists namtraceSomeFile_] {
  1396. puts $namtraceSomeFile_ $str
  1397. }
  1398. }
  1400. Simulator instproc color { id name } {
  1401. $self instvar color_
  1402. set color_($id) $name
  1403. }
  1405. Simulator instproc get-color { id } {
  1406. $self instvar color_
  1407. return $color_($id)
  1408. }
  1410. # you can pass in {} as a null file
  1411. Simulator instproc create-trace { type file src dst {op ""} } {
  1412. $self instvar alltrace_
  1413. set p [new Trace/$type]
  1414. $p tagged [Simulator set TaggedTrace_]
  1415. if [catch {$p set src_ [$src id]}] {
  1416. $p set src_ $src
  1417. }
  1418. if [catch {$p set dst_ [$dst id]}] {
  1419. $p set dst_ $dst
  1420. }
  1421. lappend alltrace_ $p
  1422. if {$file != ""} {
  1423. $p ${op}attach $file
  1424. }
  1425. return $p
  1426. }
  1429. Simulator instproc create-eventtrace {type owner } {
  1430. $self instvar alltrace_ 
  1431. $self instvar eventTraceAll_ eventtraceAllFile_ namtraceAllFile_
  1433. if ![info exists eventTraceAll_] return
  1435. if { $eventTraceAll_ == 1 } {
  1437. set et [new BaseTrace/$type]
  1438. $owner cmd eventtrace $et
  1440. lappend alltrace_ $et
  1441. $et attach $eventtraceAllFile_
  1442. if [info exists namtraceAllFile_] {
  1443. $et namattach $namtraceAllFile_
  1444. }
  1445. }
  1446. }
  1449. Simulator instproc namtrace-queue { n1 n2 {file ""} } {
  1450. $self instvar link_ namtraceAllFile_
  1451. if {$file == ""} {
  1452. if ![info exists namtraceAllFile_] return
  1453. set file $namtraceAllFile_
  1454. }
  1455. $link_([$n1 id]:[$n2 id]) nam-trace $self $file
  1456.     
  1457. # Added later for queue specific tracing events other than enque, 
  1458. # deque and drop as of now nam does not understand special events. 
  1459. # Changes will have to be made to nam for it to understand events 
  1460. # like early drops if they are prefixed differently than "d". - ratul
  1461. set queue [$link_([$n1 id]:[$n2 id]) queue]
  1462. $queue attach-nam-traces $n1 $n2 $file
  1463. }
  1465. Simulator instproc trace-queue { n1 n2 {file ""} } {
  1466. $self instvar link_ traceAllFile_
  1467. if {$file == ""} {
  1468. if ![info exists traceAllFile_] return
  1469. set file $traceAllFile_
  1470. }
  1471. $link_([$n1 id]:[$n2 id]) trace $self $file
  1473. # Added later for queue specific tracing events other than enque, 
  1474. # deque and drop - ratul
  1475. set queue [$link_([$n1 id]:[$n2 id]) queue]
  1476. $queue attach-traces $n1 $n2 $file
  1477. }
  1479. #
  1480. # arrange for queue length of link between nodes n1 and n2
  1481. # to be tracked and return object that can be queried
  1482. # to learn average q size etc.  XXX this API still rough
  1483. #
  1484. Simulator instproc monitor-queue { n1 n2 qtrace { sampleInterval 0.1 } } {
  1485. $self instvar link_
  1486. return [$link_([$n1 id]:[$n2 id]) init-monitor $self $qtrace $sampleInterval]
  1487. }
  1489. Simulator instproc queue-limit { n1 n2 limit } {
  1490. $self instvar link_
  1491. [$link_([$n1 id]:[$n2 id]) queue] set limit_ $limit
  1492. if {[[$link_([$n1 id]:[$n2 id]) queue] info class] == "Queue/XCP"} {
  1493. [$link_([$n1 id]:[$n2 id]) queue] queue-limit $limit
  1494. }
  1495. }
  1497. Simulator instproc drop-trace { n1 n2 trace } {
  1498. $self instvar link_
  1499. [$link_([$n1 id]:[$n2 id]) queue] drop-target $trace
  1500. }
  1502. Simulator instproc cost {n1 n2 c} {
  1503. $self instvar link_
  1504. $link_([$n1 id]:[$n2 id]) cost $c
  1505. }
  1507. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001
  1508. Simulator instproc multihome-attach-agent { core agent } {
  1509.        $agent set-multihome-core [$core entry]
  1511.        foreach interface [$core set multihome_interfaces_] {
  1512.    set ifNode [lindex $interface 0]
  1513. set coreLink [lindex $interface 1]
  1515.        # attach agent to the node for each interface
  1516.        $ifNode attach $agent
  1517.        set addr [$agent set agent_addr_]
  1518.        set port [$agent set agent_port_]
  1519.        set entry [$ifNode entry]
  1521.        # give the interface info to the agent
  1522. $agent add-multihome-interface $addr $port $entry $coreLink
  1524.        $agent instvar multihome_bindings_
  1525.        set binding_ {}
  1526.        lappend binding_ $addr
  1527.        lappend binding_ $port
  1528.        lappend multihome_bindings_ $binding_
  1529.        }
  1530. }
  1532. Simulator instproc attach-agent { node agent } {
  1533. $node attach $agent
  1534. # $agent set nodeid_ [$node id]
  1536.         # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001 
  1537. #
  1538. # list of tuples (addr, port)
  1539. # This is NEEDED so that single homed agents can play with multihomed
  1540. # ones!
  1541. # multihoming only for SCTP agents -Padma H.
  1542. if {[lindex [split [$agent info class] "/"] 1] == "SCTP"} {
  1543. $agent instvar multihome_bindings_
  1544. set binding_ {}
  1545. set addr [$agent set agent_addr_]
  1546. set port [$agent set agent_port_]
  1547. lappend binding_ $addr
  1548. lappend binding_ $port
  1549. lappend multihome_bindings_ $binding_
  1550. }
  1551. }
  1553. Simulator instproc attach-tbf-agent { node agent tbf } {
  1554. $node attach $agent
  1555. $agent attach-tbf $tbf
  1556. }
  1559. Simulator instproc detach-agent { node agent } {
  1561. # Debo added this
  1562. $self instvar conn_ nconn_ sflows_ nsflows_ useasim_
  1564. if {$useasim_ == 1} {
  1565. set list "" 
  1566. set s [$node id]
  1567. set d [[$self get-node-by-addr [$agent set dst_addr_]] id]
  1568. foreach x $conn_ {
  1569. set t [split $x ":"] 
  1570. if {[string compare [lindex $t 0]:[lindex $t 1] $s:$d] != 0} {
  1571. lappend list_ $x
  1572. }
  1573. }
  1574. set conn_ list
  1575. set nconn_ [expr $nconn_ -1]
  1576. # ---------------------------------------
  1577. }
  1579. $self instvar nullAgent_
  1580. $node detach $agent $nullAgent_
  1581. }
  1583. #
  1584. #   Helper proc for setting delay on an existing link
  1585. #
  1586. Simulator instproc delay { n1 n2 delay {type simplex} } {
  1587. $self instvar link_
  1588. set sid [$n1 id]
  1589. set did [$n2 id]
  1590. if [info exists link_($sid:$did)] {
  1591. set d [$link_($sid:$did) link]
  1592. $d set delay_ $delay
  1593. }
  1594. if {$type == "duplex"} {
  1595. if [info exists link_($did:$sid)] {
  1596. set d [$link_($did:$sid) link]
  1597. $d set delay_ $delay
  1598. }
  1599. }
  1600. }
  1602. # 
  1603. #   Helper proc for setting bandwidth on an existing link
  1604. #
  1605. Simulator instproc bandwidth { n1 n2 bandwidth {type simplex} } {
  1606.         $self instvar link_
  1607.         set sid [$n1 id]
  1608.         set did [$n2 id]
  1609.         if [info exists link_($sid:$did)] {
  1610.                 set d [$link_($sid:$did) link]
  1611.                 $d set bandwidth_ $bandwidth
  1612.         } 
  1613.         if {$type == "duplex"} {
  1614.                 if [info exists link_($did:$sid)] {
  1615.                         set d [$link_($did:$sid) link]
  1616.                         $d set bandwidth_ $bandwidth
  1617.                 }
  1618.         }
  1619. }
  1622. #XXX need to check that agents are attached to nodes already
  1623. Simulator instproc connect {src dst} {
  1625. $self instvar conn_ nconn_ sflows_ nsflows_ useasim_
  1627.         # Armando L. Caro Jr. <acaro@@cis,udel,edu>
  1628. # does the agent type support multihoming??
  1629. # @@@ do we need to worry about $useasim_ below?? (wasn't in 2.1b8)
  1630.      if {[lindex [split [$src info class] "/"] 1] == "SCTP"} {
  1631.      $self multihome-connect $src $dst
  1632.      }
  1634. $self simplex-connect $src $dst
  1635. $self simplex-connect $dst $src
  1638. # Debo
  1640. if {$useasim_ == 1} {
  1641. set sid [$src nodeid]
  1642. set sport [$src set agent_port_]
  1643. set did [$dst nodeid]
  1644. set dport [$dst set agent_port_]
  1646. if {[lindex [split [$src info class] "/"] 1] == "TCP"} {
  1647. lappend conn_ $sid:$did:$sport:$dport
  1648. incr nconn_
  1649. # set $nconn_ [expr $nconn_ + 1]
  1650. # puts "Set a connection with id $nconn_ between $sid and $did"
  1651. }
  1652. }
  1654. return $src
  1655. }
  1657. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/12/2001
  1658. Simulator instproc multihome-connect {src dst} {
  1660.         set destNum 0
  1661. foreach binding [$src set multihome_bindings_] {
  1662. incr destNum
  1663.    set addr [lindex $binding 0]
  1664.    set port [lindex $binding 1]
  1665.        $dst add-multihome-destination $addr $port
  1666.      }
  1667. if {$destNum == 0} {
  1668.         # src isn't multihomed, so make sure we do an
  1669. # add-multihome-destination
  1670. $dst add-multihome-destination 
  1671. [$src set agent_addr_] [$src set agent_port_]
  1672. }
  1674.         set destNum 0
  1675. foreach binding [$dst set multihome_bindings_] {
  1676. incr destNum
  1677.    set addr [lindex $binding 0]
  1678.    set port [lindex $binding 1]
  1679.        $src add-multihome-destination $addr $port
  1680.      }
  1681. if {$destNum == 0} {
  1682.         # dst isn't multihomed, so make sure we do an
  1683. # add-multihome-destination
  1684. $src add-multihome-destination 
  1685. [$dst set agent_addr_] [$dst set agent_port_]
  1686. }
  1687. }
  1689. Simulator instproc simplex-connect { src dst } {
  1690. $src set dst_addr_ [$dst set agent_addr_] 
  1691. $src set dst_port_ [$dst set agent_port_]
  1694.         # Polly Huang: to support abstract TCP simulations
  1695.         if {[lindex [split [$src info class] "/"] 1] == "AbsTCP"} {
  1696.     $self at [$self now] "$self rtt $src $dst"
  1697.     $dst set class_ [$src set class_]
  1698.         }
  1700. return $src
  1701. }
  1703. #
  1704. # Here are a bunch of helper methods.
  1705. #
  1707. Simulator proc instance {} {
  1708. set ns [Simulator info instances]
  1709. if { $ns != "" } {
  1710. return $ns
  1711. }
  1712. foreach sim [Simulator info subclass] {
  1713. set ns [$sim info instances]
  1714. if { $ns != "" } {
  1715. return $ns
  1716. }
  1717. }
  1718. error "Cannot find instance of simulator"
  1719. }
  1721. Simulator instproc get-number-of-nodes {} {
  1722. return  [$self array size Node_]
  1723. }
  1725. Simulator instproc get-node-by-id id {
  1726. $self instvar Node_
  1727. return $Node_($id)
  1728. }
  1730. # Given an node's address, Return the node-id
  1731. Simulator instproc get-node-id-by-addr address {
  1732. $self instvar Node_
  1733. set n [Node set nn_]
  1734. for {set q 0} {$q < $n} {incr q} {
  1735. set nq $Node_($q)
  1736. if {[string compare [$nq node-addr] $address] == 0} {
  1737. return $q
  1738. }
  1739. }
  1740. error "get-node-id-by-addr:Cannot find node with given address"
  1741. }
  1743. # Given an node's address, return the node 
  1744. Simulator instproc get-node-by-addr address {
  1745. return [$self get-node-by-id [$self get-node-id-by-addr $address]]
  1746. }
  1748. Simulator instproc all-nodes-list {} {
  1749. $self instvar Node_
  1750. set nodes ""
  1751. foreach n [lsort -dictionary [array names Node_]] {
  1752. lappend nodes $Node_($n)
  1753. }
  1754. return $nodes
  1755. }
  1757. Simulator instproc link { n1 n2 } {
  1758.         $self instvar Node_ link_
  1759.         if { ![catch "$n1 info class Node"] } {
  1760. set n1 [$n1 id]
  1761. }
  1762.         if { ![catch "$n2 info class Node"] } {
  1763. set n2 [$n2 id]
  1764. }
  1765. if [info exists link_($n1:$n2)] {
  1766. return $link_($n1:$n2)
  1767. }
  1768. return ""
  1769. }
  1771. # Creates connection. First creates a source agent of type s_type and binds
  1772. # it to source.  Next creates a destination agent of type d_type and binds
  1773. # it to dest.  Finally creates bindings for the source and destination agents,
  1774. # connects them, and  returns the source agent.
  1775. Simulator instproc create-connection {s_type source d_type dest pktClass} {
  1776. set s_agent [new Agent/$s_type]
  1777. set d_agent [new Agent/$d_type]
  1778. $s_agent set fid_ $pktClass
  1779. $d_agent set fid_ $pktClass
  1780. $self attach-agent $source $s_agent
  1781. $self attach-agent $dest $d_agent
  1782. $self connect $s_agent $d_agent
  1784. return $s_agent
  1785. }
  1787. # Creates a highspeed connection. Similar to create-connection 
  1788. # above except the sink agent requires additional work -- Sylvia
  1789. Simulator instproc create-highspeed-connection {s_type source d_type dest pktClass} {
  1790.         set s_agent [new Agent/$s_type]
  1791.         set d_agent [new Agent/$d_type]
  1792.         $d_agent resize_buffers
  1793.         $s_agent set fid_ $pktClass
  1794.         $d_agent set fid_ $pktClass
  1795.         $self attach-agent $source $s_agent
  1796.         $self attach-agent $dest $d_agent
  1797.         $self connect $s_agent $d_agent
  1799.         return $s_agent
  1800. }
  1802. # Creates connection. First creates a source agent of type s_type and binds
  1803. # it to source.  Next creates a destination agent of type d_type and binds
  1804. # it to dest.  Finally creates bindings for the source and destination agents,
  1805. # connects them, and  returns a list of source agent and destination agent.
  1806. Simulator instproc create-connection-list {s_type source d_type dest pktClass} {
  1807.     set s_agent [new Agent/$s_type]
  1808.     set d_agent [new Agent/$d_type]
  1809.     $s_agent set fid_ $pktClass
  1810.     $d_agent set fid_ $pktClass
  1811.     $self attach-agent $source $s_agent
  1812.     $self attach-agent $dest $d_agent
  1813.     $self connect $s_agent $d_agent
  1815.     return [list $s_agent $d_agent]
  1816. }   
  1818. # Creates connection. First creates a source agent of type s_type and binds
  1819. # it to source.  Next creates a destination agent of type d_type and binds
  1820. # it to dest.  Finally creates bindings for the source and destination agents,
  1821. # connects them, and  returns the source agent. 
  1822. # The destination agent is set to listen, for full-tcp.
  1823. Simulator instproc create-connection-listen {s_type source d_type dest pktClass} {
  1824.     set s_agent [new Agent/$s_type]
  1825.     set d_agent [new Agent/$d_type]
  1826.     $s_agent set fid_ $pktClass
  1827.     $d_agent set fid_ $pktClass
  1828.     $self attach-agent $source $s_agent
  1829.     $self attach-agent $dest $d_agent
  1830.     $self connect $s_agent $d_agent
  1831.     $d_agent listen
  1833.     return $s_agent 
  1834. }   
  1836. # This seems to be an obsolete procedure.
  1837. Simulator instproc create-tcp-connection {s_type source d_type dest pktClass} {
  1838. set s_agent [new Agent/$s_type]
  1839. set d_agent [new Agent/$d_type]
  1840. $s_agent set fid_ $pktClass
  1841. $d_agent set fid_ $pktClass
  1842. $self attach-agent $source $s_agent
  1843. $self attach-agent $dest $d_agent
  1844. return "$s_agent $d_agent"
  1845. }
  1847. #
  1848. # Other classifier methods overload the instproc-likes to track 
  1849. # and return the installed objects.
  1850. #
  1851. Classifier instproc install {slot val} {
  1852. $self set slots_($slot) $val
  1853. $self cmd install $slot $val
  1854. }
  1856. Classifier instproc installNext val {
  1857. set slot [$self cmd installNext $val]
  1858. $self set slots_($slot) $val
  1859. set slot
  1860. }
  1862. Classifier instproc adjacents {} {
  1863. $self array get slots_
  1864. }
  1866. Classifier instproc in-slot? slot {
  1867. $self instvar slots_
  1868. set ret ""
  1869. if {[info exists slots_($slot)]} {
  1870.         set ret $slots_($slot)
  1871. }
  1872. set ret
  1873. }
  1875. # For debugging
  1876. Classifier instproc dump {} {
  1877. $self instvar slots_ offset_ shift_ mask_
  1878. puts "classifier $self"
  1879. puts "t$offset_ offset"
  1880. puts "t$shift_ shift"
  1881. puts "t$mask_ mask"
  1882. puts "t[array size slots_] slots"
  1883. foreach i [lsort -integer [array names slots_]] {
  1884. set iv $slots_($i)
  1885. puts "ttslot $i: $iv ([$iv info class])"
  1886. }
  1887. }
  1889. Classifier instproc no-slot slot {
  1890.         puts stderr "--- Classfier::no-slot{} default handler (tcl/lib/ns-lib.tcl) ---"
  1891.         puts stderr "t$self: no target for slot $slot"
  1892.         puts stderr "t$self type: [$self info class]"
  1893.         puts stderr "content dump:"
  1894.         $self dump
  1895.         puts stderr "---------- Finished standard no-slot{} default handler ----------"
  1896.         # Clear output before we bail out
  1897.         [Simulator instance] flush-trace
  1898.         exit 1
  1899. }
  1901. Classifier/Hash instproc dump args {
  1902. eval $self next $args
  1903. $self instvar default_
  1904. puts "t$default_ default"
  1905. }
  1907. Classifier/Hash instproc init nbuck {
  1908. # We need to make sure that port shift/mask values are there
  1909. # so we set them after they get their default values
  1910. $self next $nbuck
  1911. $self instvar shift_ mask_
  1912. set shift_ [AddrParams NodeShift 1]
  1913. set mask_ [AddrParams NodeMask 1]
  1914. }
  1916. Classifier/Port/Reserve instproc init args {
  1917.         eval $self next
  1918.         $self reserve-port 2
  1919. }
  1921. Simulator instproc makeflowmon { cltype { clslots 29 } } {
  1922. set flowmon [new QueueMonitor/ED/Flowmon]
  1923. set cl [new Classifier/Hash/$cltype $clslots]
  1925. $cl proc unknown-flow { src dst fid }  {
  1926. set fdesc [new QueueMonitor/ED/Flow]
  1927. set dsamp [new Samples]
  1928. $fdesc set-delay-samples $dsamp
  1929. set slot [$self installNext $fdesc] 
  1930. $self set-hash auto $src $dst $fid $slot
  1931. }
  1933. $cl proc no-slot slotnum {
  1934. #
  1935. # note: we can wind up here when a packet passes
  1936. # through either an Out or a Drop Snoop Queue for
  1937. # a queue that the flow doesn't belong to anymore.
  1938. # Since there is no longer hash state in the
  1939. # hash classifier, we get a -1 return value for the
  1940. # hash classifier's classify() function, and there
  1941. # is no node at slot_[-1].  What to do about this?
  1942. # Well, we are talking about flows that have already
  1943. # been moved and so should rightly have their stats
  1944. # zero'd anyhow, so for now just ignore this case..
  1945. # puts "classifier $self, no-slot for slotnum $slotnum"
  1946. }
  1947. $flowmon classifier $cl
  1948. return $flowmon
  1949. }
  1951. # attach a flow monitor to a link
  1952. # 3rd argument dictates whether early drop support is to be used
  1954. Simulator instproc attach-fmon {lnk fm { edrop 0 } } {
  1955. set isnoop [new SnoopQueue/In]
  1956. set osnoop [new SnoopQueue/Out]
  1957. set dsnoop [new SnoopQueue/Drop]
  1958. $lnk attach-monitors $isnoop $osnoop $dsnoop $fm
  1959. if { $edrop != 0 } {
  1960.     set edsnoop [new SnoopQueue/EDrop]
  1961.     $edsnoop set-monitor $fm
  1962.     [$lnk queue] early-drop-target $edsnoop
  1963.     $edsnoop target [$self set nullAgent_]
  1964. }
  1965. [$lnk queue] drop-target $dsnoop
  1966. }
  1968. # Added by Yun Wang
  1970. Simulator instproc maketbtagger { cltype { clslots 29 } } {
  1972.         set tagger [new QueueMonitor/ED/Tagger]
  1973.         set cl [new Classifier/Hash/$cltype $clslots]
  1975.         $cl proc unknown-flow { src dst fid }  {
  1976.                 set fdesc [new QueueMonitor/ED/Flow/TB]
  1977.                 set dsamp [new Samples]
  1978.                 $fdesc set-delay-samples $dsamp
  1979.                 set slot [$self installNext $fdesc]
  1980.                 $self set-hash auto $src $dst $fid $slot
  1981.         }
  1983.         $cl proc set-rate { src dst fid hashbucket rate depth init} {
  1984.                 set fdesc [new QueueMonitor/ED/Flow/TB]
  1985.                 set dsamp [new Samples]
  1986.                 $fdesc set-delay-samples $dsamp
  1987.                 $fdesc set target_rate_ $rate
  1988.                 $fdesc set bucket_depth_ $depth
  1989.                 # Initialize the bucket as full
  1990.                 $fdesc set tbucket_ $init  
  1991.                 set slot [$self installNext $fdesc]
  1992.                 $self set-hash $hashbucket $src $dst $fid $slot
  1993.         }
  1995.         $cl proc no-slot slotnum {
  1996.                 #
  1997.                 # note: we can wind up here when a packet passes
  1998.                 # through either an Out or a Drop Snoop Queue for
  1999.                 # a queue that the flow doesn't belong to anymore.
  2000.                 # Since there is no longer hash state in the
  2001.                 # hash classifier, we get a -1 return value for the
  2002.                 # hash classifier's classify() function, and there
  2003.                 # is no node at slot_[-1].  What to do about this?
  2004.                 # Well, we are talking about flows that have already
  2005.                 # been moved and so should rightly have their stats
  2006.                 # zero'd anyhow, so for now just ignore this case..
  2007.                 # puts "classifier $self, no-slot for slotnum $slotnum"
  2008.         }
  2009.         $tagger classifier $cl
  2010.         return $tagger
  2011. }
  2013. # Added by Yun Wang
  2015. Simulator instproc maketswtagger { cltype { clslots 29 } } {
  2017.         set tagger [new QueueMonitor/ED/Tagger]
  2018.         set cl [new Classifier/Hash/$cltype $clslots]
  2020.         $cl proc unknown-flow { src dst fid hashbucket }  {
  2021.                 set fdesc [new QueueMonitor/ED/Flow/TSW]
  2022.                 set dsamp [new Samples]
  2023.                 $fdesc set-delay-samples $dsamp
  2024.                 set slot [$self installNext $fdesc]
  2025.                 $self set-hash $hashbucket $src $dst $fid $slot
  2026.         }
  2028.         $cl proc no-slot slotnum {
  2029.                 #
  2030.                 # note: we can wind up here when a packet passes
  2031.                 # through either an Out or a Drop Snoop Queue for
  2032.                 # a queue that the flow doesn't belong to anymore.
  2033.                 # Since there is no longer hash state in the
  2034.                 # hash classifier, we get a -1 return value for the
  2035.                 # hash classifier's classify() function, and there
  2036.                 # is no node at slot_[-1].  What to do about this?
  2037.                 # Well, we are talking about flows that have already
  2038.                 # been moved and so should rightly have their stats
  2039.                 # zero'd anyhow, so for now just ignore this case..
  2040.                 # puts "classifier $self, no-slot for slotnum $slotnum"
  2041.         }
  2042.         $tagger classifier $cl
  2043.         return $tagger
  2044. }
  2046. # attach a Tagger to a link
  2047. # Added by Yun Wang
  2049. Simulator instproc attach-tagger {lnk fm} {
  2050.         set isnoop [new SnoopQueue/Tagger]
  2051.         $lnk attach-taggers $isnoop $fm
  2052. }
  2054. # Imported from session.tcl. It is deleted there.
  2055. ### to insert loss module to regular links in detailed Simulator
  2056. Simulator instproc lossmodel {lossobj from to} {
  2057. set link [$self link $from $to]
  2058. $link errormodule $lossobj
  2059. }
  2061. # This function generates losses that can be visualized by nam.
  2062. Simulator instproc link-lossmodel {lossobj from to} {
  2063. set link [$self link $from $to]
  2064. $link insert-linkloss $lossobj
  2065. }
  2068. #### Polly Huang: Simulator class instproc to support abstract tcp simulations
  2070. Simulator instproc rtt { src dst } {
  2071. $self instvar routingTable_ delay_
  2072. set srcid [[$src set node_] id]
  2073. set dstid [[$dst set node_] id]
  2074. set delay 0
  2075. set tmpid $srcid
  2076. while {$tmpid != $dstid} {
  2077. set nextid [$routingTable_ lookup $tmpid $dstid]
  2078. set tmpnode [$self get-node-by-id $tmpid]
  2079. set nextnode [$self get-node-by-id $nextid]
  2080. set tmplink [[$self link $tmpnode $nextnode] link]
  2081. set delay [expr $delay + [expr 2 * [$tmplink set delay_]]]
  2082. set delay [expr $delay + [expr 8320 / [$tmplink set bandwidth_]]]
  2083. set tmpid $nextid
  2084. }
  2085. $src rtt $delay
  2086. return $delay
  2087. }
  2089. Simulator instproc abstract-tcp {} {
  2090. $self instvar TahoeAckfsm_ RenoAckfsm_ TahoeDelAckfsm_ RenoDelAckfsm_ dropper_ 
  2091. $self set TahoeAckfsm_ [new FSM/TahoeAck]
  2092. $self set RenoAckfsm_ [new FSM/RenoAck]
  2093. $self set TahoeDelAckfsm_ [new FSM/TahoeDelAck]
  2094. $self set RenoDelAckfsm_ [new FSM/RenoDelAck]
  2095. $self set nullAgent_ [new DropTargetAgent]
  2096. }
  2098. # Chalermek: For Diffusion, Flooding, and Omnicient Multicast 
  2100. Simulator instproc create-diffusion-rate-agent {node} {
  2101. global opt
  2102. set diff [new Agent/Diffusion/RateGradient]
  2104. $node set diffagent_ $diff
  2105. $node set ragent_ $diff
  2107. $diff on-node $node
  2109. if [info exist opt(enablePos)] {
  2110. if {$opt(enablePos) == "true"} {
  2111. $diff enable-pos
  2112. } else {
  2113. $diff disable-pos
  2114. }
  2115. } 
  2117. if [info exist opt(enableNeg)] {
  2118. if {$opt(enableNeg) == "true"} {
  2119. $diff enable-neg
  2120. } else {
  2121. $diff disable-neg
  2122. }
  2123. } 
  2124.     
  2125. if [info exist opt(suppression)] {
  2126. if {$opt(suppression) == "true"} {
  2127. $diff enable-suppression
  2128. } else {
  2129. $diff disable-suppression
  2130. }
  2131. } 
  2133. if [info exist opt(subTxType)] {
  2134. $diff set-sub-tx-type $opt(subTxType)
  2135. } 
  2137. if [info exist opt(orgTxType)] {
  2138. $diff set-org-tx-type $opt(orgTxType)
  2139. } 
  2141. if [info exist opt(posType)] {
  2142. $diff set-pos-type $opt(posType)
  2143. } 
  2145. if [info exist opt(posNodeType)] {
  2146. $diff set-pos-node-type $opt(posNodeType)
  2147. } 
  2149. if [info exist opt(negWinType)] {
  2150. $diff set-neg-win-type $opt(negWinType)
  2151. } 
  2153. if [info exist opt(negThrType)] {
  2154. $diff set-neg-thr-type $opt(negThrType)
  2155. } 
  2157. if [info exist opt(negMaxType)] {
  2158. $diff set-neg-max-type $opt(negMaxType)
  2159. } 
  2161. $self put-in-list $diff
  2162. $self at 0.0 "$diff start"
  2164. return $diff
  2165. }
  2167. Simulator instproc create-diffusion-probability-agent {node} {
  2168. global opt
  2169. set diff [new Agent/Diffusion/ProbGradient]
  2171. $node set diffagent_ $diff
  2172. $node set ragent_ $diff
  2174. $diff on-node $node
  2176. if [info exist opt(enablePos)] {
  2177. if {$opt(enablePos) == "true"} {
  2178. $diff enable-pos
  2179. } else {
  2180. $diff disable-pos
  2181. }
  2182. } 
  2183. if [info exist opt(enableNeg)] {
  2184. if {$opt(enableNeg) == "true"} {
  2185. $diff enable-neg
  2186. } else {
  2187. $diff disable-neg
  2188. }
  2189. } 
  2191. $self put-in-list $diff
  2192. $self at 0.0 "$diff start"
  2194. return $diff
  2195. }
  2197. # Diffusioncore agent (in diffusion) maps to the wireless routing agent
  2198. # in ns
  2199. Simulator instproc create-core-diffusion-rtg-agent {node} {
  2200. $self instvar stopTime_ diffFilter_
  2201. Node instvar ragent_ dmux_
  2202. set ragent [new Agent/DiffusionRouting [$node id]]
  2203. $node set ragent_ $ragent
  2204. # at stop-time core-diffusion dumps stats data
  2205. # see diffusion.cc for details
  2206. if { [info exists stopTime_] } {
  2207. $ragent stop-time $stopTime_
  2208. }
  2209. if { ![info exists diffFilter_] } {
  2210. puts stderr "Error: No filter defined for diffusion!n"
  2211. exit 1
  2212. }
  2213. $node create-diffusionApp-agent $diffFilter_
  2214. return $ragent
  2215. }
  2217. Simulator instproc create-flooding-agent {node} {
  2218. set flood [new Agent/Flooding]
  2220. $node set ragent_ $flood
  2222. $flood on-node $node
  2224. $self put-in-list $flood
  2225. $self at 0.0 "$flood start"
  2227. return $flood
  2228. }
  2230. Simulator instproc create-omnimcast-agent {node} {
  2231. set omni [new Agent/OmniMcast]
  2233. $node set ragent_ $omni
  2235. $omni on-node $node
  2237. $self put-in-list $omni
  2238. $self at 0.0 "$omni start"
  2240. return $omni
  2241. }
  2243. # XXX These are very simulation-specific methods, why should they belong here?
  2244. Simulator instproc put-in-list {agent} {
  2245. $self instvar lagent
  2246. lappend lagent $agent
  2247. }
  2249. Simulator instproc terminate-all-agents {} {
  2250. $self instvar lagent
  2251. foreach i $lagent {
  2252. $i terminate
  2253. }
  2254. }
  2256. Simulator instproc prepare-to-stop {} {
  2257. $self instvar lagent
  2258. foreach i $lagent {
  2259. $i stop
  2260. }
  2261. }
  2262.