Open Mash Cross Reference
mash/tcl/common/mash-timer.tcl

   import MashRNG 
   import MashLog
   
   #----------------------------------------------------------------------
   # Class:
   #   MashTimer
   # Description:
   #   This is a new, general timer class that is meant to complement the
   #   Timer class in Mash.   It has a simpler interface, and you do not
  #   have to subclass MashTimer to define your own timeout.  Instead,
  #   you pass in the timeout routine as an arguments to the constructor.
  #----------------------------------------------------------------------
  Class MashTimer 
  
  #--------------------------------------------------------------------
  # Method:
  #   MashTimer init
  # Arguments:
  #   type -- 
  #      a string describing the type of timer, either "once" or 
  #     "periodic", or "random_periodic"
  #   timeout -- 
  #     timeout before callback is called.
  #   callback -- 
  #     which is the command to eval when timeout occurs.
  #--------------------------------------------------------------------
  MashTimer public init { type timeout callback } {
      $self instvar timeout_ callback_ id_ type_
  
      set valid_types { "once" "periodic" "random_periodic" }
  
      if {[lsearch $valid_types $type] == -1} {
          puts stderr "Invalid MashTimer type \"$type\" : valid types are : $valid_types"
      }
  
      set type_ $type
      set timeout_ $timeout
      set callback_ $callback
      if {$type == "random_periodic" } {
          if {$timeout < 0.5} {
              error "ERROR: timeout for random periodic timer must be > 0.5. $timeout is given as timeout instead."
          }
          set timeout [expr $timeout + [MashRNG uniform -500 500]]
      }
      $self sched $timeout
  }
  
  #--------------------------------------------------------------------
  # Method:
  #   MashTimer sched
  # Description:
  #   Schedule the timeout to be called after time ms
  #--------------------------------------------------------------------
  MashTimer private sched {time} {
      $self instvar id_
      set time [expr int($time + 0.5)]
      set id_ [after $time "$self timeout"]
  }
  
  
  #--------------------------------------------------------------------
  # Method:
  #   MashTimer cancel
  # Description:
  #   Cancel the timer.
  #--------------------------------------------------------------------
  MashTimer private cancel {} {
      $self instvar id_
      after cancel $id_
  }
  
  
  #--------------------------------------------------------------------
  # Method:
  #   MashTimer resched
  # Description:
  #   Cancel the current timer and reschedule a timeout after time ms.
  #--------------------------------------------------------------------
  MashTimer private resched {} {
      $self instvar timeout_
      $self cancel
      $self sched $timeout_
  }
  
  
  #--------------------------------------------------------------------
  # Method:
  #   MashTimer timeout
  # Description:
  #   This callback is activated whenever the current timer expire.
  #--------------------------------------------------------------------
  MashTimer private timeout {} {
      $self instvar timeout_ callback_ id_ type_
      if {$type_ == "periodic"} {
          set id_ [$self sched $timeout_]
      } elseif {$type_ == "random_periodic"} {
          set timeout [expr $timeout_ + [MashRNG uniform -500 500]]
          set id_ [$self sched $timeout]
      }
 
 #   Since the callback may delete the timer, we should eval this 
 #   last
     eval $callback_
 }
 
 
 #--------------------------------------------------------------------
 # Method:
 #   MashTimer destroy
 # Description:
 #   Cancel the timer, and self-destruct.
 #--------------------------------------------------------------------
 MashTimer private destroy {} {
     $self cancel
     $self next
 }
 
 Class MashTimer/Once -superclass MashTimer
 MashTimer/Once instproc init { timeout callback } {
     $self next "once" $timeout $callback
 }
 
 Class MashTimer/Periodic -superclass MashTimer
 MashTimer/Periodic instproc init { timeout callback } {
     $self next "periodic" $timeout $callback
 }
 
 Class MashTimer/RandomPeriodic -superclass MashTimer
 MashTimer/RandomPeriodic instproc init { timeout callback } {
     $self next "random_periodic" $timeout $callback
 }
 
 Class MashTimer/ConstBW -superclass MashTimer
 MashTimer/ConstBW instproc init { timeout callback bw } {
     $self instvar num_of_srcs_ threshold_ callback_ avg_size_ alpha_ bw_
     set num_of_srcs_ 0
     set avg_size_ 28
     set alpha_ 0.125
     set threshold_ $timeout
     set callback_ $callback
     set bw_ $bw
 
     $self sched $timeout
 }
 
 MashTimer/ConstBW instproc num_of_srcs { args } {
     $self instvar num_of_srcs_
     if {$args == ""} {
         return $num_of_srcs_
     } else {
         set num_of_srcs_ [lindex $args 0]
     }
 }
 
 MashTimer/ConstBW instproc add_src { } {
     $self instvar num_of_srcs_
     incr num_of_srcs_
 }
 
 MashTimer/ConstBW instproc del_src { } {
     $self instvar num_of_srcs_
     incr num_of_srcs_ -1
 }
 
 MashTimer/ConstBW instproc add_sample { size } {
     $self instvar avg_size_ alpha_
     set avg_size_ [expr {$avg_size_ + $alpha_*($size+28-$avg_size_)}]
     #MashLog info "MashTimer: sample: $size"
 }
 
 MashTimer/ConstBW instproc adapt { } {
     $self instvar avg_size_ alpha_ bw_ num_of_srcs_ threshold_
     set t [expr {1000*($num_of_srcs_*$avg_size_*8)/$bw_}]
     #MashLog info "MashTimer: adapting:self=$self:ns=$num_of_srcs_:s=$avg_size_:bw=$bw_:timer=$t"
     if {$t < $threshold_} {
         return $threshold_
     } else {
         return $t
     }
 }
 
 MashTimer/ConstBW private timeout {} {
     $self instvar timeout_ callback_ id_ type_
     set timeout_ [$self adapt]
     set id_ [$self sched $timeout_]
 
     eval $callback_
 }
 
 # vim:ts=8:sw=4:expandtab