Open Mash Cross Reference
mash/tcl/net/rlm-mash.tcl

   # rlm-mash.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1996-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/net/rlm-mash.tcl,v 1.5 2002/02/03 04:28:06 lim Exp $
  
  
  import MMG Layer
  
  #FIXME
  set rlm_debug_flag 1
  
  Class Layer/mash -superclass Layer
  
  Layer/mash instproc init {mmg net n} {
          $self next $mmg
          $self instvar net_ l_ n_
          set net_ $net
          set n_ $n
          set l_ [$net_ set net_($n)]
  }
  
  Layer/mash instproc join-group {} {
          $self instvar mmg_ net_
          set level [expr [$mmg_ set subscription_] - 1]
          $net_ set-subscription-level $level
  
          $self next
  }
  
  Layer/mash instproc leave-group {} {
          $self instvar mmg_ net_
          set level [expr [$mmg_ set subscription_] - 1]
          $net_ set-subscription-level $level
  
          $self next
  }
  
  Layer/mash instproc nlost {} {
          $self instvar l_
          return [$l_ nlost]
  }
  
  Layer/mash instproc npkts {} {
          $self instvar l_ n_
          return [$l_ npkts $n_]
  }
  
  #
  # This class serves as an interface between the MMG class which
  # implements the RLM protocol machinery, and the objects in mash
  # that are involved in the RLM protocol (i.e., network objects
  # join/leave multicast groups, session objects report packet loss,
  # etc..).<p>
  #
  # An application with the <i>useRLM</i> option turned on will run
  # the RLM protocol when a NetworkManager is given an AddressBlock
  # with multiple multicast groups.  For now, a single global
  # instance of the protocol is run across all sources since
  # per-source pruning (IGMPv3) has not been deployed.<p>
  #
  Class MMG/mash -superclass MMG
  
  MMG/mash instproc init {net caddr} {
          $self instvar net_
          set net_ $net
  
          $self next [$net set nchan_]
  
          #FIXME make ctrl object listening to $caddr
          proc ctrl$self {args} { puts "ctrl: $args" }
          $self set ctrl_ ctrl$self
  }
 
 MMG/mash instproc create-layer {layerNo} {
         $self instvar net_
         return [new Layer/mash $self $net_ $layerNo]
 }
 
 MMG/mash instproc now {} {
         return [gettimeofday]
 }
 
 MMG/mash instproc set_timer {which delay} {
         $self instvar timers_
         if [info exists timers_($which)] {
                 puts "timer botched ($which)"
                 exit 1
         }
         set delay [expr int($delay * 1000)]
         set timers_($which) [after $delay "$self trigger_timer $which"]
 }
 
 MMG/mash instproc trigger_timer {which} {
         $self instvar timers_
         unset timers_($which)
         $self trigger_$which
 }
 
 MMG/mash instproc cancel_timer {which} {
         $self instvar ns_ timers_
         if [info exists timers_($which)] {
                 #FIXME does this cancel the timer?
                 after cancel $timers_($which)
                 unset timers_($which)
         }
 }
 
 
 
 MMG/mash instproc debug { msg } {
         $self instvar debug_
         if {!$debug_} { return }
 
         $self instvar subscription_ state_
         set time [format %.05f [$self now]]
         puts stderr "$time layer $subscription_ $state_ $msg"
 }
 
 
 #FIXME
 proc uniform01 {} {
     return [expr double(([random] % 10000000) + 1) / 1e7]
 }
 
 proc uniform { a b } {
         return [expr ($b - $a) * [uniform01] + $a]
 }
 
 proc exponential mean {
         return [expr - $mean * log([uniform01])]
 }
 
 proc trunc_exponential lambda {
         while 1 {
                 set u [exponential $lambda]
                 if { $u < [expr 4 * $lambda] } {
                         return $u
                 }
         }
 }