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

源码开发语言/平台
当前位置：首页 > 源码/资料 > Linux/Unix编程 > 网络 > 查看源码
ns-lib.tcl
资源名称：WiMAX_Protocol_Code.rar　[点击查看]
上传用户：hzie11
上传日期：2013-10-07
资源大小：1487k
文件大小：61k
源码类别：

网络

开发平台：

C/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: /nfs/jade/vint/CVSROOT/ns-2/tcl/lib/ns-lib.tcl,v 1.271 2005/10/09 19:32:07 tomh 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. #WIMAX
  221. source ns-wimax.tcl
  223. # STL dependent modules get included
  224. # ONLY when STL is found
  226. if {[ns-hasSTL] == 1} {
  227. source ns-nix.tcl
  228. source ../pgm/ns-pgm.tcl
  229. source ../rtglib/ns-rtProtoLS.tcl
  230. }
  232. source ns-qsnode.tcl
  234. # Obsolete modules
  235. #source ns-wireless-mip.tcl
  236. #source ns-nam.tcl
  238. Simulator instproc init args {
  240. # Debojyoti added this for asim 
  242. $self instvar useasim_
  243. $self instvar slinks_
  244. $self instvar nconn_
  245. $self instvar sflows_
  246. $self instvar nsflows_
  248. set slinks_(0:0) 0
  249. set nconn_ 0
  250. set conn_ ""
  251. # for short flows stuff
  252. set sflows_ "" 
  253. set nsflows_ 0
  254. set useasim_ 0
  256. $self create_packetformat
  257. $self use-scheduler Calendar
  258. #$self use-scheduler List
  259. $self set nullAgent_ [new Agent/Null]
  260. $self set-address-format def
  261. if {[lindex $args 0] == "-multicast"} {
  262. $self multicast $args
  263. }
  264. eval $self next $args
  265. }
  267. Simulator instproc nullagent {} {
  268. $self instvar nullAgent_
  269. return $nullAgent_
  270. }
  272. Simulator instproc use-scheduler type {
  273. $self instvar scheduler_
  274. if [info exists scheduler_] {
  275. if { [$scheduler_ info class] == "Scheduler/$type" } {
  276. return
  277. } else {
  278. delete $scheduler_
  279. }
  280. }
  281. set scheduler_ [new Scheduler/$type]
  282. $scheduler_ now
  283. }
  285. Simulator instproc delay_parse { spec } {
  286. return [time_parse $spec]
  287. }
  289. Simulator instproc bw_parse { spec } {
  290. return [bw_parse $spec]
  291. }
  293. #
  294. # A simple method to wrap any object around
  295. # a trace object that dumps to stdout
  296. #
  297. Simulator instproc dumper obj {
  298. set t [$self alloc-trace hop stdout]
  299. $t target $obj
  300. return $t
  301. }
  303. # New node structure
  304. #
  305. # Add APT to support multi-interface: user can specified multiple channels
  306. # when config nod. Still need modifications in routing agents to make
  307. # multi-interfaces really work.   -chen xuan  07/21/00
  308. #
  309. # Define global node configuration
  310. # $ns_ node-config -addressType flat/hierarchical
  311. #                  -adhocRouting   DSDV/DSR/TORA
  312. #                  -llType
  313. #                  -macType
  314. #                  -propType
  315. #                  -ifqType
  316. #                  -ifqLen
  317. #                  -phyType
  318. #                  -antType
  319. #    -channel
  320. #                  -channelType
  321. #                  -topologyInstance
  322. #                  -wiredRouting   ON/OFF
  323. #                  -mobileIP       ON/OFF
  324. #                  -energyModel    "EnergyModel"
  325. #                  -initialEnergy  (in Joules)
  326. #                  -rxPower        (in W)
  327. #                  -txPower        (in W)
  328. #                  -idlePower      (in W)
  329. #
  330. #                  -sleepPower     (in W)
  331. #
  332. #                  -agentTrace  ON
  333. #                  -routerTrace ON 
  334. #                  -macTrace 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 transitionPower  {val} { $self set transitionPower_  $val }
  365. Simulator instproc transitionTime  {val} { $self set transitionTime_  $val }
  366. #
  367. Simulator instproc IncomingErrProc  {val} { $self set inerrProc_  $val }
  368. Simulator instproc OutgoingErrProc  {val} { $self set outerrProc_  $val }
  369. Simulator instproc FECProc  {val} { $self set FECProc_  $val }
  370. Simulator instproc agentTrace  {val} { $self set agentTrace_  $val }
  371. Simulator instproc routerTrace  {val} { $self set routerTrace_  $val }
  372. Simulator instproc macTrace  {val} { $self set macTrace_  $val }
  373. Simulator instproc movementTrace  {val} { $self set movementTrace_  $val }
  374. Simulator instproc toraDebug {val} {$self set toraDebug_ $val }
  375. Simulator instproc satNodeType {val} {$self set satNodeType_ $val}
  376. Simulator instproc downlinkBW {val} {$self set downlinkBW_ $val}
  377. Simulator instproc stopTime {val} {$self set stopTime_ $val}
  379. # change wrt Mike's code
  380. Simulator instproc eotTrace  {val} { $self set eotTrace_  $val }
  381. Simulator instproc diffusionFilter {val} {$self set diffFilter_ $val}
  383. Simulator instproc MPLS { val } { 
  384. if { $val == "ON" } {
  385. Node enable-module "MPLS"
  386. } else {
  387. Node disable-module "MPLS"
  388. }
  389. }
  392. Simulator instproc PGM { val } { 
  393.         if { $val == "ON" } {
  394.                 Node enable-module "PGM"
  395.         } else {
  396.                 Node disable-module "PGM"
  397.         }
  398. }
  399. Simulator instproc LMS { val } {
  400. if { $val == "ON" } {
  401. Node enable-module "LMS"
  402. } else {
  403. Node disable-module "LMS"
  404. }
  405. }
  407. Simulator instproc get-nodetype {} {
  408. $self instvar addressType_ routingAgent_ wiredRouting_ 
  409. set val ""
  411. if { [info exists addressType_] && $addressType_ == "hierarchical" } {
  412. set val Hier
  413. }
  414. if { [info exists routingAgent_] && $routingAgent_ != "" } {
  415. set val Mobile
  416. }
  417. if { [info exists wiredRouting_] && $wiredRouting_ == "ON" } {
  418. set val Base
  419. }
  420. if { [info exists wiredRouting_] && $wiredRouting_ == "OFF"} {
  421. set val Base
  422. }
  423. if { [Simulator set mobile_ip_] } {
  424. if { $val == "Base" && $wiredRouting_ == "ON" } {
  425. set val MIPBS
  426. }
  427. if { $val == "Base" && $wiredRouting_ == "OFF" } {
  428. set val MIPMH
  429. }
  430. }
  431. return $val
  432. }
  434. Simulator instproc node-config args {
  435.         # Object::init-vars{} is defined in ~tclcl/tcl-object.tcl.
  436.         # It initializes all default variables in the following way:
  437.         #  1.  Look for pairs of {-cmd val} in args
  438.         #  2.  If "$self $cmd $val" is not valid then put it in a list of 
  439.         #      arguments to be returned to the caller.
  440.         # 
  441.         # Since we do not handle undefined {-cmd val} pairs, we ignore 
  442.         # return value from init-vars{}.
  443.         set args [eval $self init-vars $args]
  445.         $self instvar addressType_  routingAgent_ propType_  macTrace_ 
  446.     routerTrace_ agentTrace_ movementTrace_ channelType_ channel_ 
  447.     chan topoInstance_ propInstance_ mobileIP_ 
  448.     rxPower_ txPower_ idlePower_ sleepPower_ transitionPower_ 
  449.     transitionTime_ satNodeType_ eotTrace_
  451.         if [info exists macTrace_] {
  452. Simulator set MacTrace_ $macTrace_
  453. }
  454.         if [info exists routerTrace_] {
  455. Simulator set RouterTrace_ $routerTrace_
  456. }
  457.         if [info exists agentTrace_] {
  458. Simulator set AgentTrace_ $agentTrace_
  459. }
  460.         if [info exists movementTrace_] {
  461. Simulator set MovementTrace_ $movementTrace_
  462. }
  464. # change wrt Mike's code
  465. if [info exists eotTrace_] {
  466.                 Simulator set EotTrace_ $eotTrace_
  467.         }
  469.         # hacking for matching old cmu add-interface
  470.         # not good style, for back-compability ONLY
  471. #
  472. # Only create 1 instance of prop
  473. if {[info exists propInstance_]} {
  474. if {[info exists propType_] && [Simulator set propInstCreated_] == 0} {
  475. warn "Both propType and propInstance are set. propType is ignored."
  476. }
  477. } else {
  478. if {[info exists propType_]} {
  479. set propInstance_ [new $propType_]
  480. Simulator set propInstCreated_ 1
  481. }
  482. }
  484. # Add multi-interface support:
  485.   # User can only specify either channelType_ (single_interface as 
  486. # before) or channel_ (multi_interface)
  487.   # If both variables are specified, error!
  488.   if {[info exists channelType_] && [info exists channel_]} { 
  489. error "Can't specify both channel and channelType, error!"
  490. } elseif {[info exists channelType_] && ![info exists satNodeType_]} {
  491. # Single channel, single interface
  492. warn "Please use -channel as shown in tcl/ex/wireless-mitf.tcl"
  493. if {![info exists chan]} {
  494. set chan [new $channelType_]
  495. }
  496.   } elseif {[info exists channel_]} {
  497. # Multiple channel, multiple interfaces
  498. set chan $channel_
  499.   }
  500. if [info exists topoInstance_] {
  501. $propInstance_  topography $topoInstance_
  502. }
  503. # set address type, hierarchical or expanded
  504. if {[string compare $addressType_ ""] != 0} {
  505. $self set-address-format $addressType_ 
  506. }
  507. # set mobileIP flag
  508. if { [info exists mobileIP_] && $mobileIP_ == "ON"} {
  509. Simulator set mobile_ip_  1
  510. } else {
  511. if { [info exists mobileIP_] } {
  512. Simulator set mobile_ip_ 0
  513. }
  514. }
  515. }
  517. # Default behavior is changed: consider nam as not initialized if 
  518. # no shape OR color parameter is given
  519. Simulator instproc node args {
  520. $self instvar Node_ routingAgent_ wiredRouting_ satNodeType_
  521.         if { [Simulator info vars EnableMcast_] != "" } {
  522.                 warn "Flag variable Simulator::EnableMcast_ discontinued.nt
  523.                       Use multicast methods as:ntt
  524.                         % set ns [new Simulator -multicast on]ntt
  525.                         % $ns multicast"
  526.                 $self multicast
  527.                 Simulator unset EnableMcast_
  528.         }
  529.         if { [Simulator info vars NumberInterfaces_] != "" } {
  530.                 warn "Flag variable Simulator::NumberInterfaces_ discontinued.nt
  531.                       Setting this variable will not affect simulations."
  532.                 Simulator unset NumberInterfaces_
  533.         }
  535. # Satellite node
  536. if { [info exists satNodeType_] } {
  537. set node [eval $self create-satnode]
  538. #simulator's nodelist in C++ space
  539. if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  540. # add node to simulator's nodelist in C++ space
  541. $self add-node $node [$node id]
  542. # Want to keep global state of wiredRouting info
  543. SatRouteObject set wiredRouting_ true
  544. }
  545. return $node
  546. }
  548. # wireless-ready node
  549. if { [info exists routingAgent_] && ($routingAgent_ != "") } {
  550. set node [eval $self create-wireless-node $args]
  551. # for base node
  552. if {[info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  553. set Node_([$node id]) $node
  554. #simulator's nodelist in C++ space
  555. $self add-node $node [$node id] 
  556. }
  557. return $node
  558. }
  561. # Enable-mcast is now done automatically inside Node::init{}
  562. # 
  563. # XXX node_factory_ is deprecated, HOWEVER, since it's still used by
  564. # mobile IP, algorithmic routing, manual routing, and backward 
  565. # compability tests of hierarchical routing, we should keep it around
  566. # before all related code are wiped out.
  567. set node [eval new [Simulator set node_factory_] $args]
  568. set Node_([$node id]) $node
  570. #add to simulator's nodelist in C++ space
  571. $self add-node $node [$node id] 
  573. #set the nodeid in c++ Node - ratul
  574. $node nodeid [$node id]
  576. $node set ns_ $self
  577. $self check-node-num
  578. return $node
  579. }
  581. # XXX This is stupid hack. When old code (not using node-config) is used, 
  582. # create-wireless-node{} will not be called, and IMEPFlag_ will remain empty
  583. # (as set in ns-default.tcl), then Node/MobileNode will use global proc 
  584. # cmu-trace to create trace objects; otherwise mobility-trace{} will be 
  585. # triggered.
  586. Simulator instproc imep-support {} {
  587. return [Simulator set IMEPFlag_]
  588. }
  590. # XXX This should be moved into the node initialization procedure instead 
  591. # of standing here in ns-lib.tcl.
  592. Simulator instproc create-wireless-node args {
  593.         $self instvar routingAgent_ wiredRouting_ propInstance_ llType_ 
  594.     macType_ ifqType_ ifqlen_ phyType_ chan antType_ 
  595.     energyModel_ initialEnergy_ txPower_ rxPower_ 
  596.     idlePower_ sleepPower_ transitionPower_ transitionTime_ 
  597.     topoInstance_ level1_ level2_ inerrProc_ outerrProc_ FECProc_
  599. Simulator set IMEPFlag_ OFF
  601.         # create node instance
  602.         set node [eval $self create-node-instance $args]
  603.         
  604.         # basestation address setting
  605.         if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
  606. $node base-station [AddrParams addr2id [$node node-addr]]
  607.      }
  608.         switch -exact $routingAgent_ {
  609.     DSDV {
  610.     set ragent [$self create-dsdv-agent $node]
  611.     }
  612.     DSR {
  613.     $self at 0.0 "$node start-dsr"
  614.     }
  615.     AODV {
  616.     set ragent [$self create-aodv-agent $node]
  617.     }
  618.     TORA {
  619.     Simulator set IMEPFlag_ ON
  620.     set ragent [$self create-tora-agent $node]
  621.     }
  622.     DIFFUSION/RATE {
  623.     eval $node addr $args
  624.     set ragent [$self create-diffusion-rate-agent $node]
  625.     }
  626.     DIFFUSION/PROB {
  627.     eval $node addr $args
  628.     set ragent [$self create-diffusion-probability-agent $node]
  629.     }
  630.     Directed_Diffusion {
  631.     eval $node addr $args
  632.     set ragent [$self create-core-diffusion-rtg-agent $node]
  633.     }
  634.     FLOODING {
  635.     eval $node addr $args
  636.     set ragent [$self create-flooding-agent $node]
  637.     }
  638.     OMNIMCAST {
  639.     eval $node addr $args
  640.     set ragent [$self create-omnimcast-agent $node]
  641.     }
  642.     DumbAgent {
  643.     set ragent [$self create-dumb-agent $node]
  644.     }
  645.     ManualRtg {
  646.     set ragent [$self create-manual-rtg-agent $node]
  647.     }
  648.     default {
  649.     eval $node addr $args
  650.     puts "Wrong node routing agent!"
  651.     exit
  652.     }
  653. }
  655. # errProc_ and FECProc_ are an option unlike other 
  656.         # parameters for node interface
  657. if ![info exist inerrProc_] {
  658. set inerrProc_ ""
  659. }
  660. if ![info exist outerrProc_] {
  661. set outerrProc_ ""
  662. }
  663. if ![info exist FECProc_] {
  664. set FECProc_ ""
  665. }
  669. # Add main node interface
  670. $node add-interface $chan $propInstance_ $llType_ $macType_ 
  671.     $ifqType_ $ifqlen_ $phyType_ $antType_ $topoInstance_ 
  672. $inerrProc_ $outerrProc_ $FECProc_
  673. # Attach agent
  674. if {$routingAgent_ != "DSR"} {
  675. $node attach $ragent [Node set rtagent_port_]
  676. }
  677. if {$routingAgent_ == "DIFFUSION/RATE" ||
  678.             $routingAgent_ == "DIFFUSION/PROB" ||
  679.             $routingAgent_ == "FLOODING" ||
  680.             $routingAgent_ == "OMNIMCAST" ||
  681.     $routingAgent_ == "Directed_Diffusion" } {
  682. $ragent port-dmux [$node demux]
  683. $node instvar ll_
  684. $ragent add-ll $ll_(0)
  685. }
  686. if { $routingAgent_ == "DumbAgent" } {
  687. $ragent port-dmux [$node demux]
  688. }
  691. # Bind routing agent and mip agent if existing basestation 
  692. # address setting
  693.         if { [info exist wiredRouting_] && $wiredRouting_ == "ON" } {
  694. if { $routingAgent_ != "DSR" } {
  695. $node mip-call $ragent
  696. }
  697. }
  698. #
  699.         # This Trace Target is used to log changes in direction
  700.         # and velocity for the mobile node.
  701.         #
  702. set tracefd [$self get-ns-traceall]
  703.         if {$tracefd != "" } {
  704. $node nodetrace $tracefd
  705. $node agenttrace $tracefd
  706. }
  707. set namtracefd [$self get-nam-traceall]
  708. if {$namtracefd != "" } {
  709. $node namattach $namtracefd
  710. }
  711. if [info exists energyModel_] {
  712. if  [info exists level1_] {
  713. set l1 $level1_
  714. } else {
  715. set l1 0.5
  716. }
  717. if  [info exists level2_] {
  718. set l2 $level2_
  719. } else {
  720. set l2 0.2
  721. }
  722. $node addenergymodel [new $energyModel_ $node 
  723. $initialEnergy_ $l1 $l2]
  724.         }
  725.         if [info exists txPower_] {
  726. $node setPt $txPower_
  727.         }
  728.         if [info exists rxPower_] {
  729. $node setPr $rxPower_
  730.         }
  731.         if [info exists idlePower_] {
  732. $node setPidle $idlePower_
  733.         }
  734. #
  735. if [info exists sleepPower_] {
  736. $node setPsleep $sleepPower_
  737.         }
  738. if [info exists transitionPower_] {
  739. $node setPtransition $transitionPower_
  740.         }
  741. if [info exists transitionTime_] {
  742. $node setTtransition $transitionTime_
  743.         }
  744. #
  745. $node topography $topoInstance_
  747. return $node
  748. }
  750. Simulator instproc create-node-instance args {
  751. $self instvar routingAgent_
  752. # DSR is a special case
  753. if {$routingAgent_ == "DSR"} {
  754. set nodeclass [$self set-dsr-nodetype]
  755. } else {
  756. set nodeclass Node/MobileNode
  757. }
  758. return [eval new $nodeclass $args]
  759. }
  761. Simulator instproc set-dsr-nodetype {} {
  762. $self instvar wiredRouting_ 
  763. set nodetype SRNodeNew
  764. # MIP mobilenode
  765. if [Simulator set mobile_ip_] {
  766. set nodetype SRNodeNew/MIPMH
  767. } 
  768. # basestation dsr node
  769. if { [info exists wiredRouting_] && $wiredRouting_ == "ON"} {
  770. set nodetype Node/MobileNode/BaseStationNode
  771. }
  772. return $nodetype
  773. }
  775. Simulator instproc create-tora-agent { node } {
  776.         set ragent [new Agent/TORA [$node id]]
  777. $node set ragent_ $ragent
  778. return $ragent
  779. }
  781. Simulator instproc create-dsdv-agent { node } {
  782. # Create a dsdv routing agent for this node
  783. set ragent [new Agent/DSDV]
  784. # Setup address (supports hier-addr) for dsdv agent
  785. # and mobilenode
  786. set addr [$node node-addr]
  787. $ragent addr $addr
  788. $ragent node $node
  789. if [Simulator set mobile_ip_] {
  790. $ragent port-dmux [$node demux]
  791. }
  792. $node addr $addr
  793. $node set ragent_ $ragent
  794. $self at 0.0 "$ragent start-dsdv"    ;# start updates
  795. return $ragent
  796. }
  799. Simulator instproc create-dumb-agent { node } {
  801. # create a simple wireless agent
  802. # that only forwards packets
  803. # used for testing single hop brdcast/unicast mode 
  804. # for wireless macs
  806. set ragent [new Agent/DumbAgent]
  807. $node set ragent_ $ragent
  809. return $ragent
  810. }
  812. Simulator instproc create-manual-rtg-agent { node } {
  814. # create a simple wireless agent
  815. # that only forwards packets
  816. # used for testing single hop brdcast/unicast mode 
  817. # for wireless macs
  819. set ragent [new Agent/ManualRtgAgent]
  820. $node set ragent_ $ragent
  821. $node attach $ragent [Node set rtagent_port_]
  823. return $ragent
  824. }
  826. Simulator instproc create-aodv-agent { node } {
  827.         #  Create AODV routing agent
  828. set ragent [new Agent/AODV [$node node-addr]]
  829.         $self at 0.0 "$ragent start"     ;# start BEACON/HELLO Messages
  830.         $node set ragent_ $ragent
  831.         return $ragent
  832. }
  834. Simulator instproc use-newtrace {} {
  835. Simulator set WirelessNewTrace_ 1
  836. } 
  838. Simulator instproc use-taggedtrace { {tag ON} } {
  839. Simulator set TaggedTrace_ $tag
  840. }
  842. Simulator instproc hier-node haddr {
  843.   error "hier-nodes should be created with [$ns_ node $haddr]"
  844. }
  846. Simulator instproc now {} {
  847. $self instvar scheduler_
  848. return [$scheduler_ now]
  849. }
  851. Simulator instproc at args {
  852. $self instvar scheduler_
  853. return [eval $scheduler_ at $args]
  854. }
  856. Simulator instproc at-now args {
  857. $self instvar scheduler_
  858. return [eval $scheduler_ at-now $args]
  859. }
  861. Simulator instproc cancel args {
  862. $self instvar scheduler_
  863. return [eval $scheduler_ cancel $args]
  864. }
  866. Simulator instproc after {ival args} {
  867.         eval $self at [expr [$self now] + $ival] $args
  868. }
  870. #
  871. # check if total num of nodes exceed 2 to the power n 
  872. # where <n=node field size in address>
  873. #
  874. Simulator instproc check-node-num {} {
  875. if {[Node set nn_] > [expr pow(2, [AddrParams nodebits])]} {
  876. error "Number of nodes exceeds node-field-size of [AddrParams nodebits] bits"
  877. }
  878. }
  880. #
  881. # Check if number of items at each hier level (num of nodes, or clusters or
  882. # domains) exceed size of that hier level field size (in bits). should be 
  883. # modified to support n-level of hierarchies
  884. #
  885. Simulator instproc chk-hier-field-lengths {} {
  886. AddrParams instvar domain_num_ cluster_num_ nodes_num_
  887. if [info exists domain_num_] {
  888. if {[expr $domain_num_ - 1]> [AddrParams NodeMask 1]} {
  889. error "# of domains exceed dom-field-size "
  890. }
  891. } 
  892. if [info exists cluster_num_] {
  893. set maxval [expr [find-max $cluster_num_] - 1] 
  894. if {$maxval > [expr pow(2, [AddrParams NodeMask 2])]} {
  895. error "# of clusters exceed clus-field-size "
  896. }
  897. }
  898. if [info exists nodes_num_] {
  899. set maxval [expr [find-max $nodes_num_] -1]
  900. if {$maxval > [expr pow(2, [AddrParams NodeMask 3])]} {
  901. error "# of nodess exceed node-field-size"
  902. }
  903. }
  904. }
  907. Simulator instproc check-smac {} {
  908. $self instvar macType_
  909. if { [info exist macType_] && $macType_ == "Mac/SMAC" } {
  910. if { [$macType_ set syncFlag_] } {
  911. 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"
  912. }
  913. }
  914. }
  917. Simulator instproc run {} {
  918. # NIXVECTOR?
  919. # global runstart
  920. # set runstart [clock seconds]
  921. $self check-smac                      ;# print warning if in sleep/wakeup cycle
  922. $self check-node-num
  923. $self rtmodel-configure ;# in case there are any
  924. [$self get-routelogic] configure
  925. $self instvar scheduler_ Node_ link_ started_ 
  927. set started_ 1
  929. #
  930. # Reset every node, which resets every agent.
  931. #
  933. foreach nn [array names Node_] {
  934. $Node_($nn) reset
  935. # GFR Additions for NixVector Routing
  936. if { [Simulator set nix-routing] } {
  937. $Node_($nn) populate-objects
  938. }
  939. }
  941. #
  942. # Also reset every queue
  943. #
  945. foreach qn [array names link_] {
  946. set q [$link_($qn) queue]
  947. $q reset
  948. }
  950. # Do all nam-related initialization here
  951. $self init-nam
  953. # NIXVECTOR xxx?
  954. # global simstart
  955. # set simstart [clock seconds]
  956. return [$scheduler_ run]
  957. }
  959. # johnh xxx?
  960. Simulator instproc log-simstart { } {
  961.         # GFR Modification to log actual start
  962.         global simstart
  963.         puts "Starting Actual Simulation"
  964.         set simstart [clock seconds]
  965. }
  967. Simulator instproc halt {} {
  968. $self instvar scheduler_
  969. #puts "time: [clock format [clock seconds] -format %X]"
  970. $scheduler_ halt
  971. }
  973. Simulator instproc dumpq {} {
  974. $self instvar scheduler_
  975. $scheduler_ dumpq
  976. }
  978. Simulator instproc is-started {} {
  979. $self instvar started_
  980. return [info exists started_]
  981. }
  983. Simulator instproc clearMemTrace {} {
  984. $self instvar scheduler_
  985. $scheduler_ clearMemTrace
  986. }
  988. Simulator instproc simplex-link { n1 n2 bw delay qtype args } {
  989. $self instvar link_ queueMap_ nullAgent_ useasim_
  990. set sid [$n1 id]
  991. set did [$n2 id]
  993. # Debo
  994. if { $useasim_ == 1 } {
  995. set slink_($sid:$did) $self
  996. }
  998. if [info exists queueMap_($qtype)] {
  999. set qtype $queueMap_($qtype)
  1000. }
  1001. # construct the queue
  1002. set qtypeOrig $qtype
  1003. switch -exact $qtype {
  1004. ErrorModule {
  1005. if { [llength $args] > 0 } {
  1006. set q [eval new $qtype $args]
  1007. } else {
  1008. set q [new $qtype Fid]
  1009. }
  1010. }
  1011. intserv {
  1012. set qtype [lindex $args 0]
  1013. set q [new Queue/$qtype]
  1014. }
  1015. default {
  1016. if { [llength $args] == 0} {
  1017. set q [new Queue/$qtype]
  1018. } else {
  1019. set q [new Queue/$qtype $args]
  1020. }
  1021. }
  1022. }
  1023. # Now create the link
  1024. switch -exact $qtypeOrig {
  1025. RTM {
  1026.                         set c [lindex $args 1]
  1027.                         set link_($sid:$did) [new CBQLink       
  1028.                                         $n1 $n2 $bw $delay $q $c]
  1029.                 }
  1030.                 CBQ -
  1031.                 CBQ/WRR {
  1032.                         # assume we have a string of form "linktype linkarg"
  1033.                         if {[llength $args] == 0} {
  1034.                                 # default classifier for cbq is just Fid type
  1035.                                 set c [new Classifier/Hash/Fid 33]
  1036.                         } else {
  1037.                                 set c [lindex $args 0]
  1038.                         }
  1039.                         set link_($sid:$did) [new CBQLink       
  1040.                                         $n1 $n2 $bw $delay $q $c]
  1041.                 }
  1042. FQ      {
  1043. set link_($sid:$did) [new FQLink $n1 $n2 $bw $delay $q]
  1044. }
  1045.                 intserv {
  1046.                         #XX need to clean this up
  1047.                         set link_($sid:$did) [new IntServLink   
  1048.                                         $n1 $n2 $bw $delay $q
  1049. [concat $qtypeOrig $args]]
  1050.                 }
  1051.                 default {
  1052.                         set link_($sid:$did) [new SimpleLink    
  1053.                                         $n1 $n2 $bw $delay $q]
  1054.                 }
  1055.         }
  1056. if {$qtype == "RED/Pushback"} {
  1057. set pushback 1
  1058. } else {
  1059. set pushback 0
  1060. }
  1061. $n1 add-neighbor $n2 $pushback
  1063. #XXX yuck
  1064. if {[string first "RED" $qtype] != -1 || 
  1065.     [string first "PI" $qtype] != -1 || 
  1066.     [string first "Vq" $qtype] != -1 ||
  1067.     [string first "REM" $qtype] != -1 ||  
  1068.     [string first "GK" $qtype] != -1 ||  
  1069.     [string first "RIO" $qtype] != -1 ||
  1070.     [string first "XCP" $qtype] != -1} {
  1071. $q link [$link_($sid:$did) set link_]
  1072. }
  1074. set trace [$self get-ns-traceall]
  1075. if {$trace != ""} {
  1076. $self trace-queue $n1 $n2 $trace
  1077. }
  1078. set trace [$self get-nam-traceall]
  1079. if {$trace != ""} {
  1080. $self namtrace-queue $n1 $n2 $trace
  1081. }
  1083. # Register this simplex link in nam link list. Treat it as 
  1084. # a duplex link in nam
  1085. $self register-nam-linkconfig $link_($sid:$did)
  1086. }
  1088. #
  1089. # This is used by Link::orient to register/update the order in which links 
  1090. # should created in nam. This is important because different creation order
  1091. # may result in different layout.
  1092. #
  1093. # A poor hack. :( Any better ideas?
  1094. #
  1095. Simulator instproc register-nam-linkconfig link {
  1096. $self instvar linkConfigList_ link_
  1097. if [info exists linkConfigList_] {
  1098. # Check whether the reverse simplex link is registered,
  1099. # if so, don't register this link again.
  1100. # We should have a separate object for duplex link.
  1101. set i1 [[$link src] id]
  1102. set i2 [[$link dst] id]
  1103. if [info exists link_($i2:$i1)] {
  1104. set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
  1105. if {$pos >= 0} {
  1106. set a1 [$link_($i2:$i1) get-attribute 
  1107. "ORIENTATION"]
  1108. set a2 [$link get-attribute "ORIENTATION"]
  1109. if {$a1 == "" && $a2 != ""} {
  1110. # If this duplex link has not been 
  1111. # assigned an orientation, do it.
  1112. set linkConfigList_ [lreplace 
  1113. $linkConfigList_ $pos $pos]
  1114. } else {
  1115. return
  1116. }
  1117. }
  1118. }
  1119. # Remove $link from list if it's already there
  1120. set pos [lsearch $linkConfigList_ $link]
  1121. if {$pos >= 0} {
  1122. set linkConfigList_ 
  1123. [lreplace $linkConfigList_ $pos $pos]
  1124. }
  1125. }
  1126. lappend linkConfigList_ $link
  1127. }
  1129. #
  1130. # GT-ITM may occasionally generate duplicate links, so we need this check
  1131. # to ensure duplicated links do not appear in nam trace files.
  1132. #
  1133. Simulator instproc remove-nam-linkconfig {i1 i2} {
  1134. $self instvar linkConfigList_ link_
  1135. if ![info exists linkConfigList_] {
  1136. return
  1137. }
  1138. set pos [lsearch $linkConfigList_ $link_($i1:$i2)]
  1139. if {$pos >= 0} {
  1140. set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
  1141. return
  1142. }
  1143. set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
  1144. if {$pos >= 0} {
  1145. set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
  1146. }
  1147. }
  1149. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001
  1150. #
  1151. # we create a simplex link (NOT duplex) from the core to the interface. we can
  1152. # use arbitrary params (bw, delay, etc) since we'll never actually transmit
  1153. # data on these links. they are only used for routing (ie, to determine which 
  1154. # interface a packet should go out from)
  1155. #
  1156. Simulator instproc multihome-add-interface { core if } {
  1157.    $self instvar link_
  1158.    set coreId [$core id]
  1159.    set ifId [$if id]
  1161. # arbitrary values (doesn't matter since link will NEVER be used!)
  1162. set bw 1Mb
  1163. set delay 100ms
  1164. set type DropTail
  1166. if [info exists link_($coreId:$ifId)] {
  1167. $self remove-nam-linkconfig $coreId $ifId
  1168. }
  1169. eval $self simplex-link $core $if $bw $delay $type 
  1170. # Modified by GFR for nix-vector routing
  1171. if { [Simulator set nix-routing] } {
  1172. # Inform nodes of neighbors
  1173. $n1 set-neighbor [$core id]
  1174. $n2 set-neighbor [$if id]
  1175. }
  1178.      $core instvar multihome_interfaces_ num_interfaces_
  1179.      set interface_ {}
  1181.      # interface node
  1182.      lappend interface_ $if
  1184.      # link from interface node to core node
  1185.      lappend interface_ [$link_($coreId:$ifId) set head_]
  1187.      lappend multihome_interfaces_ $interface_
  1188. }
  1190. Simulator instproc duplex-link { n1 n2 bw delay type args } {
  1191. $self instvar link_
  1192. set i1 [$n1 id]
  1193. set i2 [$n2 id]
  1194. if [info exists link_($i1:$i2)] {
  1195. $self remove-nam-linkconfig $i1 $i2
  1196. }
  1197. eval $self simplex-link $n1 $n2 $bw $delay $type $args
  1198. eval $self simplex-link $n2 $n1 $bw $delay $type $args
  1199. # Modified by GFR for nix-vector routing
  1200. if { [Simulator set nix-routing] } {
  1201. # Inform nodes of neighbors
  1202. $n1 set-neighbor [$n2 id]
  1203. $n2 set-neighbor [$n1 id]
  1204. }
  1205. }
  1207. Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
  1208. eval $self duplex-link $n1 $n2 $bw $pd intserv $sched $signal $adc $args
  1209. }
  1211. Simulator instproc simplex-link-op { n1 n2 op args } {
  1212. $self instvar link_
  1213. eval $link_([$n1 id]:[$n2 id]) $op $args
  1214. }
  1216. Simulator instproc duplex-link-op { n1 n2 op args } {
  1217. $self instvar link_
  1218. eval $link_([$n1 id]:[$n2 id]) $op $args
  1219. eval $link_([$n2 id]:[$n1 id]) $op $args
  1220. }
  1222. Simulator instproc flush-trace {} {
  1223. $self instvar alltrace_
  1224. if [info exists alltrace_] {
  1225. foreach trace $alltrace_ {
  1226. $trace flush
  1227. }
  1228. }
  1229. }
  1231. Simulator instproc namtrace-all file   {
  1232. $self instvar namtraceAllFile_
  1233. if {$file != ""} {
  1234. set namtraceAllFile_ $file
  1235. } else {
  1236. unset namtraceAllFile_
  1237. }
  1238. }
  1240. Simulator instproc energy-color-change {level1 level2} {
  1241. $self instvar level1_ level2_
  1242.   set level1_ $level1
  1243.   set level2_ $level2
  1244. }
  1246. Simulator instproc namtrace-all-wireless {file optx opty} {
  1247.         $self instvar namtraceAllFile_
  1249. # indicate that we need a W event written to the trace
  1250. $self set namNeedsW_ 1
  1251. if { $optx != "" && $opty != "" } {
  1252. $self set namWx_ $optx
  1253. $self set namWy_ $opty
  1254. }
  1256. $self namtrace-all $file
  1257. }
  1259. Simulator instproc nam-end-wireless {stoptime} {
  1260.         $self instvar namtraceAllFile_
  1262.         if {$namtraceAllFile_ != ""} {
  1263. $self puts-nam-config "W -t $stoptime"
  1264.         }
  1265. }
  1267. Simulator instproc namtrace-some file {
  1268. $self instvar namtraceSomeFile_
  1269. set namtraceSomeFile_ $file
  1270. }
  1272. # Support for event-tracing
  1273.         
  1274. Simulator instproc eventtrace-all {{file ""}} {
  1275. $self instvar eventTraceAll_ eventtraceAllFile_ traceAllFile_
  1276. set eventTraceAll_ 1
  1277. if {$file != ""} {
  1278. set eventtraceAllFile_ $file
  1279. } else {
  1280. set eventtraceAllFile_ $traceAllFile_
  1281. }
  1283. }
  1287. Simulator instproc initial_node_pos {nodep size} {
  1288. $self instvar addressType_
  1289. $self instvar energyModel_ 
  1291. if [info exists energyModel_] {  
  1292. set nodeColor "green"
  1293. } else {
  1294. set nodeColor "black"
  1295. }
  1296. if { [info exists addressType_] && $addressType_ == "hierarchical" } {
  1297. # Hierarchical addressing
  1298. $self puts-nam-config "n -t * -a [$nodep set address_] 
  1299. -s [$nodep id] -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] 
  1300. -z $size -v circle -c $nodeColor"
  1301. } else { 
  1302. # Flat addressing
  1303. $self puts-nam-config "n -t * -s [$nodep id] 
  1304. -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size 
  1305. -v circle -c $nodeColor"
  1306. }
  1307. }
  1309. Simulator instproc trace-all file {
  1310. $self instvar traceAllFile_
  1311. set traceAllFile_ $file
  1312. }
  1314. Simulator instproc get-nam-traceall {} {
  1315. $self instvar namtraceAllFile_
  1316. if [info exists namtraceAllFile_] {
  1317. return $namtraceAllFile_
  1318. } else {
  1319. return ""
  1320. }
  1321. }
  1323. Simulator instproc get-ns-traceall {} {
  1324. $self instvar traceAllFile_
  1325. if [info exists traceAllFile_] {
  1326. return $traceAllFile_
  1327. } else {
  1328. return ""
  1329. }
  1330. }
  1332. # If exists a traceAllFile_, print $str to $traceAllFile_
  1333. Simulator instproc puts-ns-traceall { str } {
  1334. $self instvar traceAllFile_
  1335. if [info exists traceAllFile_] {
  1336. puts $traceAllFile_ $str
  1337. }
  1338. }
  1340. # If exists a traceAllFile_, print $str to $traceAllFile_
  1341. Simulator instproc puts-nam-traceall { str } {
  1342. $self instvar namtraceAllFile_
  1343. if [info exists namtraceAllFile_] {
  1344. puts $namtraceAllFile_ $str
  1345. } elseif [info exists namtraceSomeFile_] {
  1346. puts $namtraceSomeFile_ $str
  1347. }
  1348. }
  1350. # namConfigFile is used for writing color/link/node/queue/annotations. 
  1351. # XXX It cannot co-exist with namtraceAll.
  1352. Simulator instproc namtrace-config { f } {
  1353. $self instvar namConfigFile_
  1354. set namConfigFile_ $f
  1355. }
  1357. Simulator instproc get-nam-config {} {
  1358. $self instvar namConfigFile_
  1359. if [info exists namConfigFile_] {
  1360. return $namConfigFile_
  1361. } else {
  1362. return ""
  1363. }
  1364. }
  1366. # Used only for writing nam configurations to trace file(s). This is different
  1367. # from puts-nam-traceall because we may want to separate configuration 
  1368. # informations and actual tracing information
  1369. Simulator instproc puts-nam-config { str } {
  1370. $self instvar namtraceAllFile_ namConfigFile_
  1372. if [info exists namConfigFile_] {
  1373. puts $namConfigFile_ $str
  1374. } elseif [info exists namtraceAllFile_] {
  1375. puts $namtraceAllFile_ $str
  1376. } elseif [info exists namtraceSomeFile_] {
  1377. puts $namtraceSomeFile_ $str
  1378. }
  1379. }
  1381. Simulator instproc color { id name } {
  1382. $self instvar color_
  1383. set color_($id) $name
  1384. }
  1386. Simulator instproc get-color { id } {
  1387. $self instvar color_
  1388. return $color_($id)
  1389. }
  1391. # you can pass in {} as a null file
  1392. Simulator instproc create-trace { type file src dst {op ""} } {
  1393. $self instvar alltrace_
  1394. set p [new Trace/$type]
  1395. $p tagged [Simulator set TaggedTrace_]
  1396. if [catch {$p set src_ [$src id]}] {
  1397. $p set src_ $src
  1398. }
  1399. if [catch {$p set dst_ [$dst id]}] {
  1400. $p set dst_ $dst
  1401. }
  1402. lappend alltrace_ $p
  1403. if {$file != ""} {
  1404. $p ${op}attach $file
  1405. }
  1406. return $p
  1407. }
  1410. Simulator instproc create-eventtrace {type owner } {
  1411. $self instvar alltrace_ 
  1412. $self instvar eventTraceAll_ eventtraceAllFile_ namtraceAllFile_
  1414. if ![info exists eventTraceAll_] return
  1416. if { $eventTraceAll_ == 1 } {
  1418. set et [new BaseTrace/$type]
  1419. $owner cmd eventtrace $et
  1421. lappend alltrace_ $et
  1422. $et attach $eventtraceAllFile_
  1423. if [info exists namtraceAllFile_] {
  1424. $et namattach $namtraceAllFile_
  1425. }
  1426. }
  1427. }
  1430. Simulator instproc namtrace-queue { n1 n2 {file ""} } {
  1431. $self instvar link_ namtraceAllFile_
  1432. if {$file == ""} {
  1433. if ![info exists namtraceAllFile_] return
  1434. set file $namtraceAllFile_
  1435. }
  1436. $link_([$n1 id]:[$n2 id]) nam-trace $self $file
  1437.     
  1438. # Added later for queue specific tracing events other than enque, 
  1439. # deque and drop as of now nam does not understand special events. 
  1440. # Changes will have to be made to nam for it to understand events 
  1441. # like early drops if they are prefixed differently than "d". - ratul
  1442. set queue [$link_([$n1 id]:[$n2 id]) queue]
  1443. $queue attach-nam-traces $n1 $n2 $file
  1444. }
  1446. Simulator instproc trace-queue { n1 n2 {file ""} } {
  1447. $self instvar link_ traceAllFile_
  1448. if {$file == ""} {
  1449. if ![info exists traceAllFile_] return
  1450. set file $traceAllFile_
  1451. }
  1452. $link_([$n1 id]:[$n2 id]) trace $self $file
  1454. # Added later for queue specific tracing events other than enque, 
  1455. # deque and drop - ratul
  1456. set queue [$link_([$n1 id]:[$n2 id]) queue]
  1457. $queue attach-traces $n1 $n2 $file
  1458. }
  1460. #
  1461. # arrange for queue length of link between nodes n1 and n2
  1462. # to be tracked and return object that can be queried
  1463. # to learn average q size etc.  XXX this API still rough
  1464. #
  1465. Simulator instproc monitor-queue { n1 n2 qtrace { sampleInterval 0.1 } } {
  1466. $self instvar link_
  1467. return [$link_([$n1 id]:[$n2 id]) init-monitor $self $qtrace $sampleInterval]
  1468. }
  1470. Simulator instproc queue-limit { n1 n2 limit } {
  1471. $self instvar link_
  1472. [$link_([$n1 id]:[$n2 id]) queue] set limit_ $limit
  1473. if {[[$link_([$n1 id]:[$n2 id]) queue] info class] == "Queue/XCP"} {
  1474. [$link_([$n1 id]:[$n2 id]) queue] queue-limit $limit
  1475. }
  1476. }
  1478. Simulator instproc drop-trace { n1 n2 trace } {
  1479. $self instvar link_
  1480. [$link_([$n1 id]:[$n2 id]) queue] drop-target $trace
  1481. }
  1483. Simulator instproc cost {n1 n2 c} {
  1484. $self instvar link_
  1485. $link_([$n1 id]:[$n2 id]) cost $c
  1486. }
  1488. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001
  1489. Simulator instproc multihome-attach-agent { core agent } {
  1490.        $agent set-multihome-core [$core entry]
  1492.        foreach interface [$core set multihome_interfaces_] {
  1493.    set ifNode [lindex $interface 0]
  1494. set coreLink [lindex $interface 1]
  1496.        # attach agent to the node for each interface
  1497.        $ifNode attach $agent
  1498.        set addr [$agent set agent_addr_]
  1499.        set port [$agent set agent_port_]
  1500.        set entry [$ifNode entry]
  1502.        # give the interface info to the agent
  1503. $agent add-multihome-interface $addr $port $entry $coreLink
  1505.        $agent instvar multihome_bindings_
  1506.        set binding_ {}
  1507.        lappend binding_ $addr
  1508.        lappend binding_ $port
  1509.        lappend multihome_bindings_ $binding_
  1510.        }
  1511. }
  1513. Simulator instproc attach-agent { node agent } {
  1514. $node attach $agent
  1515. # $agent set nodeid_ [$node id]
  1517.         # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/22/2001 
  1518. #
  1519. # list of tuples (addr, port)
  1520. # This is NEEDED so that single homed agents can play with multihomed
  1521. # ones!
  1522. # multihoming only for SCTP agents -Padma H.
  1523. if {[lindex [split [$agent info class] "/"] 1] == "SCTP"} {
  1524. $agent instvar multihome_bindings_
  1525. set binding_ {}
  1526. set addr [$agent set agent_addr_]
  1527. set port [$agent set agent_port_]
  1528. lappend binding_ $addr
  1529. lappend binding_ $port
  1530. lappend multihome_bindings_ $binding_
  1531. }
  1532. }
  1534. Simulator instproc attach-tbf-agent { node agent tbf } {
  1535. $node attach $agent
  1536. $agent attach-tbf $tbf
  1537. }
  1540. Simulator instproc detach-agent { node agent } {
  1542. # Debo added this
  1543. $self instvar conn_ nconn_ sflows_ nsflows_ useasim_
  1545. if {$useasim_ == 1} {
  1546. set list "" 
  1547. set s [$node id]
  1548. set d [[$self get-node-by-addr [$agent set dst_addr_]] id]
  1549. foreach x $conn_ {
  1550. set t [split $x ":"] 
  1551. if {[string compare [lindex $t 0]:[lindex $t 1] $s:$d] != 0} {
  1552. lappend list_ $x
  1553. }
  1554. }
  1555. set conn_ list
  1556. set nconn_ [expr $nconn_ -1]
  1557. # ---------------------------------------
  1558. }
  1560. $self instvar nullAgent_
  1561. $node detach $agent $nullAgent_
  1562. }
  1564. #
  1565. #   Helper proc for setting delay on an existing link
  1566. #
  1567. Simulator instproc delay { n1 n2 delay {type simplex} } {
  1568. $self instvar link_
  1569. set sid [$n1 id]
  1570. set did [$n2 id]
  1571. if [info exists link_($sid:$did)] {
  1572. set d [$link_($sid:$did) link]
  1573. $d set delay_ $delay
  1574. }
  1575. if {$type == "duplex"} {
  1576. if [info exists link_($did:$sid)] {
  1577. set d [$link_($did:$sid) link]
  1578. $d set delay_ $delay
  1579. }
  1580. }
  1581. }
  1583. # 
  1584. #   Helper proc for setting bandwidth on an existing link
  1585. #
  1586. Simulator instproc bandwidth { n1 n2 bandwidth {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 bandwidth_ $bandwidth
  1593.         } 
  1594.         if {$type == "duplex"} {
  1595.                 if [info exists link_($did:$sid)] {
  1596.                         set d [$link_($did:$sid) link]
  1597.                         $d set bandwidth_ $bandwidth
  1598.                 }
  1599.         }
  1600. }
  1603. #XXX need to check that agents are attached to nodes already
  1604. Simulator instproc connect {src dst} {
  1606. $self instvar conn_ nconn_ sflows_ nsflows_ useasim_
  1608.         # Armando L. Caro Jr. <acaro@@cis,udel,edu>
  1609. # does the agent type support multihoming??
  1610. # @@@ do we need to worry about $useasim_ below?? (wasn't in 2.1b8)
  1611.      if {[lindex [split [$src info class] "/"] 1] == "SCTP"} {
  1612.      $self multihome-connect $src $dst
  1613.      }
  1615. $self simplex-connect $src $dst
  1616. $self simplex-connect $dst $src
  1619. # Debo
  1621. if {$useasim_ == 1} {
  1622. set sid [$src nodeid]
  1623. set sport [$src set agent_port_]
  1624. set did [$dst nodeid]
  1625. set dport [$dst set agent_port_]
  1627. if {[lindex [split [$src info class] "/"] 1] == "TCP"} {
  1628. lappend conn_ $sid:$did:$sport:$dport
  1629. incr nconn_
  1630. # set $nconn_ [expr $nconn_ + 1]
  1631. # puts "Set a connection with id $nconn_ between $sid and $did"
  1632. }
  1633. }
  1635. return $src
  1636. }
  1638. # Armando L. Caro Jr. <acaro@@cis,udel,edu> 10/12/2001
  1639. Simulator instproc multihome-connect {src dst} {
  1641.         set destNum 0
  1642. foreach binding [$src set multihome_bindings_] {
  1643. incr destNum
  1644.    set addr [lindex $binding 0]
  1645.    set port [lindex $binding 1]
  1646.        $dst add-multihome-destination $addr $port
  1647.      }
  1648. if {$destNum == 0} {
  1649.         # src isn't multihomed, so make sure we do an
  1650. # add-multihome-destination
  1651. $dst add-multihome-destination 
  1652. [$src set agent_addr_] [$src set agent_port_]
  1653. }
  1655.         set destNum 0
  1656. foreach binding [$dst set multihome_bindings_] {
  1657. incr destNum
  1658.    set addr [lindex $binding 0]
  1659.    set port [lindex $binding 1]
  1660.        $src add-multihome-destination $addr $port
  1661.      }
  1662. if {$destNum == 0} {
  1663.         # dst isn't multihomed, so make sure we do an
  1664. # add-multihome-destination
  1665. $src add-multihome-destination 
  1666. [$dst set agent_addr_] [$dst set agent_port_]
  1667. }
  1668. }
  1670. Simulator instproc simplex-connect { src dst } {
  1671. $src set dst_addr_ [$dst set agent_addr_] 
  1672. $src set dst_port_ [$dst set agent_port_]
  1675.         # Polly Huang: to support abstract TCP simulations
  1676.         if {[lindex [split [$src info class] "/"] 1] == "AbsTCP"} {
  1677.     $self at [$self now] "$self rtt $src $dst"
  1678.     $dst set class_ [$src set class_]
  1679.         }
  1681. return $src
  1682. }
  1684. #
  1685. # Here are a bunch of helper methods.
  1686. #
  1688. Simulator proc instance {} {
  1689. set ns [Simulator info instances]
  1690. if { $ns != "" } {
  1691. return $ns
  1692. }
  1693. foreach sim [Simulator info subclass] {
  1694. set ns [$sim info instances]
  1695. if { $ns != "" } {
  1696. return $ns
  1697. }
  1698. }
  1699. error "Cannot find instance of simulator"
  1700. }
  1702. Simulator instproc get-number-of-nodes {} {
  1703. return  [$self array size Node_]
  1704. }
  1706. Simulator instproc get-node-by-id id {
  1707. $self instvar Node_
  1708. return $Node_($id)
  1709. }
  1711. # Given an node's address, Return the node-id
  1712. Simulator instproc get-node-id-by-addr address {
  1713. $self instvar Node_
  1714. set n [Node set nn_]
  1715. for {set q 0} {$q < $n} {incr q} {
  1716. set nq $Node_($q)
  1717. if {[string compare [$nq node-addr] $address] == 0} {
  1718. return $q
  1719. }
  1720. }
  1721. error "get-node-id-by-addr:Cannot find node with given address"
  1722. }
  1724. # Given an node's address, return the node 
  1725. Simulator instproc get-node-by-addr address {
  1726. return [$self get-node-by-id [$self get-node-id-by-addr $address]]
  1727. }
  1729. Simulator instproc all-nodes-list {} {
  1730. $self instvar Node_
  1731. set nodes ""
  1732. foreach n [lsort -dictionary [array names Node_]] {
  1733. lappend nodes $Node_($n)
  1734. }
  1735. return $nodes
  1736. }
  1738. Simulator instproc link { n1 n2 } {
  1739.         $self instvar Node_ link_
  1740.         if { ![catch "$n1 info class Node"] } {
  1741. set n1 [$n1 id]
  1742. }
  1743.         if { ![catch "$n2 info class Node"] } {
  1744. set n2 [$n2 id]
  1745. }
  1746. if [info exists link_($n1:$n2)] {
  1747. return $link_($n1:$n2)
  1748. }
  1749. return ""
  1750. }
  1752. # Creates connection. First creates a source agent of type s_type and binds
  1753. # it to source.  Next creates a destination agent of type d_type and binds
  1754. # it to dest.  Finally creates bindings for the source and destination agents,
  1755. # connects them, and  returns the source agent.
  1756. Simulator instproc create-connection {s_type source d_type dest pktClass} {
  1757. set s_agent [new Agent/$s_type]
  1758. set d_agent [new Agent/$d_type]
  1759. $s_agent set fid_ $pktClass
  1760. $d_agent set fid_ $pktClass
  1761. $self attach-agent $source $s_agent
  1762. $self attach-agent $dest $d_agent
  1763. $self connect $s_agent $d_agent
  1765. return $s_agent
  1766. }
  1768. # Creates a highspeed connection. Similar to create-connection 
  1769. # above except the sink agent requires additional work -- Sylvia
  1770. Simulator instproc create-highspeed-connection {s_type source d_type dest pktClass} {
  1771.         set s_agent [new Agent/$s_type]
  1772.         set d_agent [new Agent/$d_type]
  1773.         $d_agent resize_buffers
  1774.         $s_agent set fid_ $pktClass
  1775.         $d_agent set fid_ $pktClass
  1776.         $self attach-agent $source $s_agent
  1777.         $self attach-agent $dest $d_agent
  1778.         $self connect $s_agent $d_agent
  1780.         return $s_agent
  1781. }
  1783. # Creates connection. First creates a source agent of type s_type and binds
  1784. # it to source.  Next creates a destination agent of type d_type and binds
  1785. # it to dest.  Finally creates bindings for the source and destination agents,
  1786. # connects them, and  returns a list of source agent and destination agent.
  1787. Simulator instproc create-connection-list {s_type source d_type dest pktClass} {
  1788.     set s_agent [new Agent/$s_type]
  1789.     set d_agent [new Agent/$d_type]
  1790.     $s_agent set fid_ $pktClass
  1791.     $d_agent set fid_ $pktClass
  1792.     $self attach-agent $source $s_agent
  1793.     $self attach-agent $dest $d_agent
  1794.     $self connect $s_agent $d_agent
  1796.     return [list $s_agent $d_agent]
  1797. }   
  1799. # Creates connection. First creates a source agent of type s_type and binds
  1800. # it to source.  Next creates a destination agent of type d_type and binds
  1801. # it to dest.  Finally creates bindings for the source and destination agents,
  1802. # connects them, and  returns the source agent. 
  1803. # The destination agent is set to listen, for full-tcp.
  1804. Simulator instproc create-connection-listen {s_type source d_type dest pktClass} {
  1805.     set s_agent [new Agent/$s_type]
  1806.     set d_agent [new Agent/$d_type]
  1807.     $s_agent set fid_ $pktClass
  1808.     $d_agent set fid_ $pktClass
  1809.     $self attach-agent $source $s_agent
  1810.     $self attach-agent $dest $d_agent
  1811.     $self connect $s_agent $d_agent
  1812.     $d_agent listen
  1814.     return $s_agent 
  1815. }   
  1817. # This seems to be an obsolete procedure.
  1818. Simulator instproc create-tcp-connection {s_type source d_type dest pktClass} {
  1819. set s_agent [new Agent/$s_type]
  1820. set d_agent [new Agent/$d_type]
  1821. $s_agent set fid_ $pktClass
  1822. $d_agent set fid_ $pktClass
  1823. $self attach-agent $source $s_agent
  1824. $self attach-agent $dest $d_agent
  1825. return "$s_agent $d_agent"
  1826. }
  1828. #
  1829. # Other classifier methods overload the instproc-likes to track 
  1830. # and return the installed objects.
  1831. #
  1832. Classifier instproc install {slot val} {
  1833. $self set slots_($slot) $val
  1834. $self cmd install $slot $val
  1835. }
  1837. Classifier instproc installNext val {
  1838. set slot [$self cmd installNext $val]
  1839. $self set slots_($slot) $val
  1840. set slot
  1841. }
  1843. Classifier instproc adjacents {} {
  1844. $self array get slots_
  1845. }
  1847. Classifier instproc in-slot? slot {
  1848. $self instvar slots_
  1849. set ret ""
  1850. if {[array size slots_] < $slot} {
  1851. set ret slots_($slot)
  1852. }
  1853. set ret
  1854. }
  1856. # For debugging
  1857. Classifier instproc dump {} {
  1858. $self instvar slots_ offset_ shift_ mask_
  1859. puts "classifier $self"
  1860. puts "t$offset_ offset"
  1861. puts "t$shift_ shift"
  1862. puts "t$mask_ mask"
  1863. puts "t[array size slots_] slots"
  1864. foreach i [lsort -integer [array names slots_]] {
  1865. set iv $slots_($i)
  1866. puts "ttslot $i: $iv ([$iv info class])"
  1867. }
  1868. }
  1870. Classifier instproc no-slot slot {
  1871.         puts stderr "--- Classfier::no-slot{} default handler (tcl/lib/ns-lib.tcl) ---"
  1872.         puts stderr "t$self: no target for slot $slot"
  1873.         puts stderr "t$self type: [$self info class]"
  1874.         puts stderr "content dump:"
  1875.         $self dump
  1876.         puts stderr "---------- Finished standard no-slot{} default handler ----------"
  1877.         # Clear output before we bail out
  1878.         [Simulator instance] flush-trace
  1879.         exit 1
  1880. }
  1882. Classifier/Hash instproc dump args {
  1883. eval $self next $args
  1884. $self instvar default_
  1885. puts "t$default_ default"
  1886. }
  1888. Classifier/Hash instproc init nbuck {
  1889. # We need to make sure that port shift/mask values are there
  1890. # so we set them after they get their default values
  1891. $self next $nbuck
  1892. $self instvar shift_ mask_
  1893. set shift_ [AddrParams NodeShift 1]
  1894. set mask_ [AddrParams NodeMask 1]
  1895. }
  1897. Classifier/Port/Reserve instproc init args {
  1898.         eval $self next
  1899.         $self reserve-port 2
  1900. }
  1902. Simulator instproc makeflowmon { cltype { clslots 29 } } {
  1903. set flowmon [new QueueMonitor/ED/Flowmon]
  1904. set cl [new Classifier/Hash/$cltype $clslots]
  1906. $cl proc unknown-flow { src dst fid }  {
  1907. set fdesc [new QueueMonitor/ED/Flow]
  1908. set dsamp [new Samples]
  1909. $fdesc set-delay-samples $dsamp
  1910. set slot [$self installNext $fdesc] 
  1911. $self set-hash auto $src $dst $fid $slot
  1912. }
  1914. $cl proc no-slot slotnum {
  1915. #
  1916. # note: we can wind up here when a packet passes
  1917. # through either an Out or a Drop Snoop Queue for
  1918. # a queue that the flow doesn't belong to anymore.
  1919. # Since there is no longer hash state in the
  1920. # hash classifier, we get a -1 return value for the
  1921. # hash classifier's classify() function, and there
  1922. # is no node at slot_[-1].  What to do about this?
  1923. # Well, we are talking about flows that have already
  1924. # been moved and so should rightly have their stats
  1925. # zero'd anyhow, so for now just ignore this case..
  1926. # puts "classifier $self, no-slot for slotnum $slotnum"
  1927. }
  1928. $flowmon classifier $cl
  1929. return $flowmon
  1930. }
  1932. # attach a flow monitor to a link
  1933. # 3rd argument dictates whether early drop support is to be used
  1935. Simulator instproc attach-fmon {lnk fm { edrop 0 } } {
  1936. set isnoop [new SnoopQueue/In]
  1937. set osnoop [new SnoopQueue/Out]
  1938. set dsnoop [new SnoopQueue/Drop]
  1939. $lnk attach-monitors $isnoop $osnoop $dsnoop $fm
  1940. if { $edrop != 0 } {
  1941.     set edsnoop [new SnoopQueue/EDrop]
  1942.     $edsnoop set-monitor $fm
  1943.     [$lnk queue] early-drop-target $edsnoop
  1944.     $edsnoop target [$self set nullAgent_]
  1945. }
  1946. [$lnk queue] drop-target $dsnoop
  1947. }
  1949. # Added by Yun Wang
  1951. Simulator instproc maketbtagger { cltype { clslots 29 } } {
  1953.         set tagger [new QueueMonitor/ED/Tagger]
  1954.         set cl [new Classifier/Hash/$cltype $clslots]
  1956.         $cl proc unknown-flow { src dst fid }  {
  1957.                 set fdesc [new QueueMonitor/ED/Flow/TB]
  1958.                 set dsamp [new Samples]
  1959.                 $fdesc set-delay-samples $dsamp
  1960.                 set slot [$self installNext $fdesc]
  1961.                 $self set-hash auto $src $dst $fid $slot
  1962.         }
  1964.         $cl proc set-rate { src dst fid hashbucket rate depth init} {
  1965.                 set fdesc [new QueueMonitor/ED/Flow/TB]
  1966.                 set dsamp [new Samples]
  1967.                 $fdesc set-delay-samples $dsamp
  1968.                 $fdesc set target_rate_ $rate
  1969.                 $fdesc set bucket_depth_ $depth
  1970.                 # Initialize the bucket as full
  1971.                 $fdesc set tbucket_ $init  
  1972.                 set slot [$self installNext $fdesc]
  1973.                 $self set-hash $hashbucket $src $dst $fid $slot
  1974.         }
  1976.         $cl proc no-slot slotnum {
  1977.                 #
  1978.                 # note: we can wind up here when a packet passes
  1979.                 # through either an Out or a Drop Snoop Queue for
  1980.                 # a queue that the flow doesn't belong to anymore.
  1981.                 # Since there is no longer hash state in the
  1982.                 # hash classifier, we get a -1 return value for the
  1983.                 # hash classifier's classify() function, and there
  1984.                 # is no node at slot_[-1].  What to do about this?
  1985.                 # Well, we are talking about flows that have already
  1986.                 # been moved and so should rightly have their stats
  1987.                 # zero'd anyhow, so for now just ignore this case..
  1988.                 # puts "classifier $self, no-slot for slotnum $slotnum"
  1989.         }
  1990.         $tagger classifier $cl
  1991.         return $tagger
  1992. }
  1994. # Added by Yun Wang
  1996. Simulator instproc maketswtagger { cltype { clslots 29 } } {
  1998.         set tagger [new QueueMonitor/ED/Tagger]
  1999.         set cl [new Classifier/Hash/$cltype $clslots]
  2001.         $cl proc unknown-flow { src dst fid hashbucket }  {
  2002.                 set fdesc [new QueueMonitor/ED/Flow/TSW]
  2003.                 set dsamp [new Samples]
  2004.                 $fdesc set-delay-samples $dsamp
  2005.                 set slot [$self installNext $fdesc]
  2006.                 $self set-hash $hashbucket $src $dst $fid $slot
  2007.         }
  2009.         $cl proc no-slot slotnum {
  2010.                 #
  2011.                 # note: we can wind up here when a packet passes
  2012.                 # through either an Out or a Drop Snoop Queue for
  2013.                 # a queue that the flow doesn't belong to anymore.
  2014.                 # Since there is no longer hash state in the
  2015.                 # hash classifier, we get a -1 return value for the
  2016.                 # hash classifier's classify() function, and there
  2017.                 # is no node at slot_[-1].  What to do about this?
  2018.                 # Well, we are talking about flows that have already
  2019.                 # been moved and so should rightly have their stats
  2020.                 # zero'd anyhow, so for now just ignore this case..
  2021.                 # puts "classifier $self, no-slot for slotnum $slotnum"
  2022.         }
  2023.         $tagger classifier $cl
  2024.         return $tagger
  2025. }
  2027. # attach a Tagger to a link
  2028. # Added by Yun Wang
  2030. Simulator instproc attach-tagger {lnk fm} {
  2031.         set isnoop [new SnoopQueue/Tagger]
  2032.         $lnk attach-taggers $isnoop $fm
  2033. }
  2035. # Imported from session.tcl. It is deleted there.
  2036. ### to insert loss module to regular links in detailed Simulator
  2037. Simulator instproc lossmodel {lossobj from to} {
  2038. set link [$self link $from $to]
  2039. $link errormodule $lossobj
  2040. }
  2042. # This function generates losses that can be visualized by nam.
  2043. Simulator instproc link-lossmodel {lossobj from to} {
  2044. set link [$self link $from $to]
  2045. $link insert-linkloss $lossobj
  2046. }
  2049. #### Polly Huang: Simulator class instproc to support abstract tcp simulations
  2051. Simulator instproc rtt { src dst } {
  2052. $self instvar routingTable_ delay_
  2053. set srcid [[$src set node_] id]
  2054. set dstid [[$dst set node_] id]
  2055. set delay 0
  2056. set tmpid $srcid
  2057. while {$tmpid != $dstid} {
  2058. set nextid [$routingTable_ lookup $tmpid $dstid]
  2059. set tmpnode [$self get-node-by-id $tmpid]
  2060. set nextnode [$self get-node-by-id $nextid]
  2061. set tmplink [[$self link $tmpnode $nextnode] link]
  2062. set delay [expr $delay + [expr 2 * [$tmplink set delay_]]]
  2063. set delay [expr $delay + [expr 8320 / [$tmplink set bandwidth_]]]
  2064. set tmpid $nextid
  2065. }
  2066. $src rtt $delay
  2067. return $delay
  2068. }
  2070. Simulator instproc abstract-tcp {} {
  2071. $self instvar TahoeAckfsm_ RenoAckfsm_ TahoeDelAckfsm_ RenoDelAckfsm_ dropper_ 
  2072. $self set TahoeAckfsm_ [new FSM/TahoeAck]
  2073. $self set RenoAckfsm_ [new FSM/RenoAck]
  2074. $self set TahoeDelAckfsm_ [new FSM/TahoeDelAck]
  2075. $self set RenoDelAckfsm_ [new FSM/RenoDelAck]
  2076. $self set nullAgent_ [new DropTargetAgent]
  2077. }
  2079. # Chalermek: For Diffusion, Flooding, and Omnicient Multicast 
  2081. Simulator instproc create-diffusion-rate-agent {node} {
  2082. global opt
  2083. set diff [new Agent/Diffusion/RateGradient]
  2085. $node set diffagent_ $diff
  2086. $node set ragent_ $diff
  2088. $diff on-node $node
  2090. if [info exist opt(enablePos)] {
  2091. if {$opt(enablePos) == "true"} {
  2092. $diff enable-pos
  2093. } else {
  2094. $diff disable-pos
  2095. }
  2096. } 
  2098. if [info exist opt(enableNeg)] {
  2099. if {$opt(enableNeg) == "true"} {
  2100. $diff enable-neg
  2101. } else {
  2102. $diff disable-neg
  2103. }
  2104. } 
  2105.     
  2106. if [info exist opt(suppression)] {
  2107. if {$opt(suppression) == "true"} {
  2108. $diff enable-suppression
  2109. } else {
  2110. $diff disable-suppression
  2111. }
  2112. } 
  2114. if [info exist opt(subTxType)] {
  2115. $diff set-sub-tx-type $opt(subTxType)
  2116. } 
  2118. if [info exist opt(orgTxType)] {
  2119. $diff set-org-tx-type $opt(orgTxType)
  2120. } 
  2122. if [info exist opt(posType)] {
  2123. $diff set-pos-type $opt(posType)
  2124. } 
  2126. if [info exist opt(posNodeType)] {
  2127. $diff set-pos-node-type $opt(posNodeType)
  2128. } 
  2130. if [info exist opt(negWinType)] {
  2131. $diff set-neg-win-type $opt(negWinType)
  2132. } 
  2134. if [info exist opt(negThrType)] {
  2135. $diff set-neg-thr-type $opt(negThrType)
  2136. } 
  2138. if [info exist opt(negMaxType)] {
  2139. $diff set-neg-max-type $opt(negMaxType)
  2140. } 
  2142. $self put-in-list $diff
  2143. $self at 0.0 "$diff start"
  2145. return $diff
  2146. }
  2148. Simulator instproc create-diffusion-probability-agent {node} {
  2149. global opt
  2150. set diff [new Agent/Diffusion/ProbGradient]
  2152. $node set diffagent_ $diff
  2153. $node set ragent_ $diff
  2155. $diff on-node $node
  2157. if [info exist opt(enablePos)] {
  2158. if {$opt(enablePos) == "true"} {
  2159. $diff enable-pos
  2160. } else {
  2161. $diff disable-pos
  2162. }
  2163. } 
  2164. if [info exist opt(enableNeg)] {
  2165. if {$opt(enableNeg) == "true"} {
  2166. $diff enable-neg
  2167. } else {
  2168. $diff disable-neg
  2169. }
  2170. } 
  2172. $self put-in-list $diff
  2173. $self at 0.0 "$diff start"
  2175. return $diff
  2176. }
  2178. # Diffusioncore agent (in diffusion) maps to the wireless routing agent
  2179. # in ns
  2180. Simulator instproc create-core-diffusion-rtg-agent {node} {
  2181. $self instvar stopTime_ diffFilter_
  2182. Node instvar ragent_ dmux_
  2183. set ragent [new Agent/DiffusionRouting [$node id]]
  2184. $node set ragent_ $ragent
  2185. # at stop-time core-diffusion dumps stats data
  2186. # see diffusion.cc for details
  2187. if { [info exists stopTime_] } {
  2188. $ragent stop-time $stopTime_
  2189. }
  2190. if { ![info exists diffFilter_] } {
  2191. puts stderr "Error: No filter defined for diffusion!n"
  2192. exit 1
  2193. }
  2194. $node create-diffusionApp-agent $diffFilter_
  2195. return $ragent
  2196. }
  2198. Simulator instproc create-flooding-agent {node} {
  2199. set flood [new Agent/Flooding]
  2201. $node set ragent_ $flood
  2203. $flood on-node $node
  2205. $self put-in-list $flood
  2206. $self at 0.0 "$flood start"
  2208. return $flood
  2209. }
  2211. Simulator instproc create-omnimcast-agent {node} {
  2212. set omni [new Agent/OmniMcast]
  2214. $node set ragent_ $omni
  2216. $omni on-node $node
  2218. $self put-in-list $omni
  2219. $self at 0.0 "$omni start"
  2221. return $omni
  2222. }
  2224. # XXX These are very simulation-specific methods, why should they belong here?
  2225. Simulator instproc put-in-list {agent} {
  2226. $self instvar lagent
  2227. lappend lagent $agent
  2228. }
  2230. Simulator instproc terminate-all-agents {} {
  2231. $self instvar lagent
  2232. foreach i $lagent {
  2233. $i terminate
  2234. }
  2235. }
  2237. Simulator instproc prepare-to-stop {} {
  2238. $self instvar lagent
  2239. foreach i $lagent {
  2240. $i stop
  2241. }
  2242. }
  2243.