test-suite-message.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:7k
源码类别:

通讯编程

开发平台:

Visual C++

  1. # Copyright (c) 1995 The Regents of the University of California.
  2. # All rights reserved.
  3. #
  4. # Redistribution and use in source and binary forms, with or without
  5. # modification, are permitted provided that the following conditions
  6. # are met:
  7. # 1. Redistributions of source code must retain the above copyright
  8. #    notice, this list of conditions and the following disclaimer.
  9. # 2. Redistributions in binary form must reproduce the above copyright
  10. #    notice, this list of conditions and the following disclaimer in the
  11. #    documentation and/or other materials provided with the distribution.
  12. # 3. All advertising materials mentioning features or use of this software
  13. #    must display the following acknowledgement:
  14. # This product includes software developed by the Computer Systems
  15. # Engineering Group at Lawrence Berkeley Laboratory.
  16. # 4. Neither the name of the University nor of the Laboratory may be used
  17. #    to endorse or promote products derived from this software without
  18. #    specific prior written permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  21. # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  22. # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  23. # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  24. # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31. #
  32. # Test message passing developed by Tim.
  33. #
  34. # Each agent keeps track of what messages it has seen
  35. # and only forwards those which it hasn't seen before.
  36. # Each message is of the form "ID:DATA" where ID is some arbitrary
  37. # message identifier and DATA is the payload.  In order to reduce
  38. # memory usage, the agent stores only the message ID.
  39. # Note that I have not put in any mechanism to expire old message IDs
  40. # from the list of seen messages.  There also isn't any standard mechanism
  41. # for assigning message IDs.  An actual assignment may wish to have the
  42. # students come up with solutions for these problems.
  43. set MESSAGE_PORT 42
  44. # subclass Agent/MessagePassing to make it do flooding
  45. Class Agent/MessagePassing/Flooding -superclass Agent/MessagePassing
  46. Agent/MessagePassing/Flooding instproc send_message {size msgid msg} {
  47.     $self instvar messages_seen node_
  48.     global MESSAGE_PORT
  49.     #$ns trace-annotate "Node [$node_ node-addr] is sending {$msgid:$msg}"
  50.     puts "Node [$node_ node-addr] is sending {$msgid:$msg}"
  51.     lappend messages_seen $msgid
  52.     $self send_to_neighbors -1 $MESSAGE_PORT $size "$msgid:$msg"
  53. }
  54. Agent/MessagePassing/Flooding instproc send_to_neighbors {skip port size data} {
  55.     $self instvar node_
  56. foreach x [$node_ neighbors] {
  57.     set addr [$x set address_]
  58.     if {$addr != $skip} {
  59. $self sendto $size $data $addr $port
  60.     }
  61. }
  62. }
  63. Agent/MessagePassing/Flooding instproc recv {source sport size data} {
  64.     $self instvar messages_seen node_
  65.     global ns
  66.     # extract message ID from message
  67.     set message_id [lindex [split $data ":"] 0]
  68.     if {[lsearch $messages_seen $message_id] == -1} {
  69. lappend messages_seen $message_id
  70.     puts "Node [$node_ node-addr] received {$data}"
  71.     #$ns trace-annotate "Node [$node_ node-addr] received {$data}"
  72. $self send_to_neighbors $source $sport $size $data
  73.     } else {
  74.     puts "Node [$node_ node-addr] received redundant copy of message #$message_id"
  75. #$ns trace-annotate "Node [$node_ node-addr] received redundant copy of message #$message_id"
  76.     }
  77. }
  78. Class TestSuite
  79. TestSuite instproc init { name } {
  80. $self instvar ns_ testname_ group_size num_groups num_nodes n a
  81. global MESSAGE_PORT
  82. set testname_ $name
  83. set ns_ [new Simulator]
  84. # parameters for topology generator
  85. set group_size 7
  86. set num_groups 5
  87. set num_nodes [expr $group_size * $num_groups]
  88. # create a bunch of nodes
  89. for {set i 0} {$i < $num_nodes} {incr i} {
  90. set n($i) [$ns_ node]
  91. }
  92. # attach a new Agent/MessagePassing/Flooding to each node on port $MESSAGE_PORT
  93. for {set i 0} {$i < $num_nodes} {incr i} {
  94. set a($i) [new Agent/MessagePassing/Flooding]
  95. $n($i) attach  $a($i) $MESSAGE_PORT
  96. $a($i) set messages_seen {}
  97. }
  98. }
  99. TestSuite instproc finish args {
  100. $self instvar traceFile_ ns_
  101. $ns_ flush-trace
  102. close $traceFile_
  103. exit 0
  104. }
  105. TestSuite instproc openTrace { stopTime } {
  106. $self instvar ns_ traceFile_
  107. set traceFile_ [open flooding.tr w]
  108. $ns_ trace-all $traceFile_
  109. $ns_ at $stopTime "$self finish"
  110. }
  111. proc usage {} {
  112. global argv0
  113. puts stderr "usage: ns $argv0 <tests> [<quiet>]"
  114. puts stderr "Valid tests are:t[get-subclasses TestSuite Test/]"
  115. exit 1
  116. }
  117. proc isProc? {cls prc} {
  118. if [catch "Object info subclass $cls/$prc" r] {
  119. global argv0
  120. puts stderr "$argv0: no such $cls: $prc"
  121. usage
  122. }
  123. }
  124. proc get-subclasses {cls pfx} {
  125. set ret ""
  126. set l [string length $pfx]
  127. set c $cls
  128. while {[llength $c] > 0} {
  129. set t [lindex $c 0]
  130. set c [lrange $c 1 end]
  131. if [string match ${pfx}* $t] {
  132. lappend ret [string range $t $l end]
  133. }
  134. eval lappend c [$t info subclass]
  135. }
  136. set ret
  137. }
  138. TestSuite proc runTest {} {
  139. global argc argv quiet
  140. set quiet false
  141. switch $argc {
  142. 1 {
  143. set test $argv
  144. isProc? Test $test
  145. set topo ""
  146. }
  147. 2 {
  148. set test [lindex $argv 0]
  149. isProc? Test $test
  150. set extra [lindex $argv 1]
  151. if {$extra == "QUIET"} {
  152. set quiet true
  153. }
  154. }
  155. default {
  156. usage
  157. }
  158. }
  159. set t [new Test/$test $test]
  160. $t run
  161. }
  162. # First case: in a wired network
  163. Class Test/wired -superclass TestSuite
  164. Test/wired instproc init args {
  165. eval $self next $args
  166. $self openTrace 1.0
  167. $self create-topo
  168. }
  169. Test/wired instproc create-topo args {
  170. $self instvar ns_ n num_groups group_size
  171. # create links between the nodes
  172. for {set g 0} {$g < $num_groups} {incr g} {
  173. for {set i 0} {$i < $group_size} {incr i} {
  174. $ns_ duplex-link $n([expr $g*$group_size+$i]) $n([expr $g*$group_size+($i+1)%$group_size]) 2Mb 15ms DropTail
  175. }
  176. $ns_ duplex-link $n([expr $g*$group_size]) $n([expr (($g+1)%$num_groups)*$group_size+2]) 2Mb 15ms DropTail
  177. if {$g%2} {
  178. $ns_ duplex-link $n([expr $g*$group_size+3]) $n([expr (($g+3)%$num_groups)*$group_size+1]) 2Mb 15ms DropTail
  179. }
  180. }
  181. }
  182. Test/wired instproc run {} {
  183. $self instvar ns_ a
  184. # now set up some events
  185. $ns_ at 0.0 "$a(5) send_message 900 1 {first message}"
  186. $ns_ at 0.3 "$a(17) send_message 700 2 {another one}"
  187. $ns_ at 0.6 "$a(24) send_message 500 abc {yet another one}"
  188. $ns_ run
  189. }
  190. TestSuite runTest