Open Mash Cross Reference
mash/tcl/psvp/temporal-selector.tcl

   # temporal-selector.tcl --
   #
   #       This file contains the TemporalSelector base class
   #
   # Copyright (c) 1998-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.
  
  # The TemporalSelector object responds to graph interface communication
  # received through its recv_graph_comm method and sends graph
  # interface communication through the send_graph_comm method.
  #
  
  # Object fields
  #
  # input_id_list_ : list of input ids. The same ids are expected to be used
  #                  by individual execution subgraphs
  # input_info_ : array of info on input_ids. For each input id $i,
  #       ($i,spec) : multicast spec for input data
  #       ($i,trigger) : 0/1 indicating if input is execution trigger
  #       ($i,selector) : selector object for this input
  # vagent_array_ : array associated by "addr,port" indexes that holds
  #                 the name of video agents used by this object.
  # subgraph_list_ : list of subgraph identifiers. These identifiers are
  #                  local only.
  # subgraph_info_ : array of info on subgraphs. For each subgraph $s and
  #                  each input id $i,
  #       ($s,comm_obj) : graph comm object for talking to this subgraph
  #       ($s,spec) : cntrl spec for this subgraph
  # id_ : id of this object to be used in graph communication
  # comm_obj_ : object for graph comm (from above, NOT to subgraphs)
  # callback_array_ : holds comm callbacks with index <sid>,<mid>
  
  import GraphComm
  import PsvpVideoAgent
  import TemporalSelectorInput
  
  Class TemporalSelector
  
  TemporalSelector instproc init {id control_spec} {
      $self next;
  
      $self instvar input_id_list_;
      $self instvar input_info_;
      $self instvar vagent_array_;
      $self instvar subgraph_list_;
      $self instvar subgraph_info_;
      $self instvar id_;
      $self instvar comm_obj_;
      $self instvar callback_array_;
      $self instvar next_subgraph_;
      $self instvar ctoken_subgraph_q_;
      $self instvar sid_;
      $self instvar ctoken_count_;
      $self instvar token_rate_period_;
      $self instvar rate_pressure_ rate_constant_;
  
  #    set rate_pressure_ 1.1;
       set rate_pressure_ 1.0
  #    set rate_constant_ [expr 1.0/1000.0];
      set rate_constant_ 0.0;
  
      set input_id_list_ "";
      set id_ $id;
  
      set comm_obj_ [new GraphComm/TemporalSelector $self $id_ $control_spec];
  
      set sid_ -1;
      set subgraph_list_ "";
      set next_subgraph_ "";
      set ctoken_subgraph_q_ "";
      set ctoken_count_ 0;
      set token_rate_period_ 1000;
  
      $self instvar trigger_count_;
      $self instvar fire_count_;
  
     set trigger_count_ 0;
     set fire_count_ 0;
 }
 
 TemporalSelector instproc decr_ctoken_count {} {
     $self instvar ctoken_count_;
 
     incr ctoken_count_ -1;
 
 }
 
 TemporalSelector instproc decr_trigger_count {} {
     $self instvar trigger_count_;
 
     incr trigger_count_ -1;
 }
 
 TemporalSelector instproc handle_trigger_count {} {
     $self instvar trigger_count_;
     $self instvar token_rate_period_;
 
     incr trigger_count_ 1;
     after $token_rate_period_ "$self decr_trigger_count";
 }
 
 TemporalSelector instproc decr_fire_count {} {
     $self instvar fire_count_
 
     incr fire_count_ -1;
 }
 
 TemporalSelector instproc handle_fire_count {} {
     $self instvar fire_count_;
     $self instvar token_rate_period_;
 
     incr fire_count_ 1;
 
     after $token_rate_period_ "$self decr_fire_count";
 }
 
 TemporalSelector instproc SetupInput {new_input} {
     $self instvar subgraph_list_;
     $self instvar subgraph_info_;
     $self instvar vagent_array_;
 
     $self instvar input_id_list_;
     $self instvar input_info_;
 
     if {[lsearch $input_id_list_ $new_input] == -1} {
         $self instvar comm_obj_;
 
         lappend input_id_list_ $new_input;
         set input_info_($new_input,spec) "";
         set input_info_($new_input,trigger) 0;
         set input_info_($new_input,selector) "";
 
         $comm_obj_ create_input $new_input
     }
 }
 
 TemporalSelector instproc ReflectInputAttr {iname aname} {
     $self instvar comm_obj_
 
     $comm_obj_ create_input_attr $iname $aname
 }
 
 TemporalSelector instproc trigger {} {
     $self instvar next_subgraph_;
     $self instvar ctoken_subgraph_q_;
     $self instvar subgraph_list_;
     $self instvar subgraph_info_;
     $self instvar input_id_list_;
     $self instvar input_info_;
     $self instvar fire_count_;
 
     $self handle_trigger_count;
 
     # This is a total hack to prevent overflowing the processors.
 
     $self instvar last_time_click_;
     $self instvar update_status;
     $self instvar ctoken_count_ token_rate_period_;
     $self instvar rate_pressure_ rate_constant_;
 
     if {![info exists last_time_click_]} {
         set last_time_click_ [clock clicks];
     }
 
     set now [clock clicks];
 
     set target_rate [expr ($rate_pressure_ * \
             (($ctoken_count_*1.0) / ($token_rate_period_*1.0)) + \
             $rate_constant_)];
 
     if {$target_rate <= 0.0} {
         set target_rate .001;
     }
 
     set target_interval [expr  (0.5 / $target_rate) + (rand() * (0.5 / $target_rate))];
 
     set tdiff [expr ($now - $last_time_click_) / 1000.0];
 
     if {$tdiff < $target_interval} {
         set update_status 0;
     } elseif {$fire_count_ == $ctoken_count_} {
         set update_status 1;
         set last_time_click_ $now
     } else {
         set update_status 1;
 #       set last_time_click_ [expr $last_time_click_ + int(($target_interval * 1000.0))];
         set last_time_click_ $now
     }
 
     set s "";
     if {$update_status} {
         if {[llength $ctoken_subgraph_q_] > 0} {
             set s [lindex $ctoken_subgraph_q_ 0];
             set ctoken_subgraph_q_ [lreplace $ctoken_subgraph_q_ 0 0];
         } else {
             set s [lindex $next_subgraph_ 0];
             set next_subgraph_ [lreplace $next_subgraph_ 0 0];
             lappend next_subgraph_ $s;
         }
 
         # Build and send trigger vector
         $self instvar tvector_;
         set tvector_ "";
         foreach i $input_id_list_ {
             set selector $input_info_($i,selector);
             if {$selector != ""} {
                 set ts [$selector get_current_ts];
                 lappend tvector_ [list $i $ts];
             }
         }
 #puts "Trigger: $tvector_"
         $subgraph_info_($s,comm_obj) send_trigger_vector $tvector_;
         $self handle_fire_count;
     }
     foreach i $input_id_list_ {
         set selector $input_info_($i,selector);
         if {$selector != ""} {
             $selector update_subgraph $s
         }
     }
 }
 
 TemporalSelector instproc set_input_spec {in_id spec} {
     $self instvar input_info_;
     $self instvar vagent_array_;
     $self instvar subgraph_list_;
     $self instvar subgraph_info_;
 
     if {$input_info_($in_id,spec) == $spec} {
         return;
     }
 
     # If input already associated with a spec, delete selector no longer
     # needed.
 
     if {$input_info_($in_id,spec) != ""} {
         set selector $input_info_($in_id,selector);
         if {$selector != ""} {
             set vagent [$selector set vagent_];
 
             set src [[$selector get_decoder] set src_];
             $src proc trigger_sr {args} {};
 
             $vagent delete_decoder [$selector get_decoder];
             delete $selector;
             set input_info_($id,selector) "";
         }
         set input_info_($in_id,spec) "";
     }
 
     set spec_split [split $spec "/"];
 
     set addr [lindex $spec_split 0];
     set port [lindex $spec_split 1];
     set srcid [lindex $spec_split 2];
 
     if {![info exists vagent_array_($addr,$port)]} {
         set vagent_array_($addr,$port) [new PsvpVideoAgent $addr/$port];
     }
     set vagent $vagent_array_($addr,$port);
 
     set src [$vagent get_source_by_id $srcid];
 
     if {$src == ""} {
         $vagent set_create_decoder_callback $srcid "$self set_input_spec_cb $in_id $spec"
     } else {
         set fmt_name [$vagent classmap [$src format_name]];
 
         set selector [new TemporalSelectorInput/${fmt_name} $self $in_id]
 
         if {$selector == ""} {
             set selector [new TemporalSelectorInput/Null $self $in_id];
         }
         if {$input_info_($in_id,trigger) != 0} {
             $selector set_callback "$self trigger; # ";
         }
         foreach s $subgraph_list_ {
             $selector add_subgraph $s;
         }
         $vagent set_src_decoder $src [$selector get_decoder];
 
         $selector set vagent_ $vagent;
 
         set input_info_($in_id,selector) $selector;
 
         # Major hack to get sender report triggers to work
         $src proc trigger_sr {args} "catch {$selector trigger_sr $src}";
 
     }
     set input_info_($in_id,spec) $spec;
 }
 
 TemporalSelector instproc set_input_spec_cb {id spec src} {
     $self instvar input_info_
     $self instvar vagent_array_
     $self instvar subgraph_info_
     $self instvar subgraph_list_
 
     if {$input_info_($id,spec) != $spec} {
         puts "$input_info_($id,spec) != $spec !!!";
         return;
     }
 
     if {$input_info_($id,selector) != ""} {
         puts "$input_info_($id,selector) != {} !!!";
         return;
     }
 
     # Find videoagent and source
 
     set spec_split [split $spec "/"];
 
     set addr [lindex $spec_split 0];
     set port [lindex $spec_split 1];
     set srcid [lindex $spec_split 2];
 
     set vagent $vagent_array_($addr,$port);
 
     # Setup decoder.
 
     set fmt_name [$vagent classmap [$src format_name]];
 
     set selector [new TemporalSelectorInput/${fmt_name} $self $id];
 
     if {$selector == ""} {
         # No such selector. Create a NULL decoder and associate that.
         set selector [new TemporalSelectorInput/Null $self $id];
     } else {
         if {$input_info_($id,trigger) != 0} {
             $selector set_callback "$self trigger; #";
         }
         foreach s $subgraph_list_ {
             $selector add_subgraph $s;
         }
     }
     # Update input info array
 
     $selector set vagent_ $vagent;
 
     set input_info_($id,selector) $selector;
 
     # Major hack to get sender report triggers to work
     $src proc trigger_sr {args} "catch {$selector trigger_sr $src}";
 
     return [$selector get_decoder];
 }
 
 TemporalSelector instproc set_subgraph_input_spec {sid in_id spec} {
     $self instvar subgraph_info_;
 
     $subgraph_info_($sid,comm_obj) set_input_spec $in_id $spec;
 }
 
 TemporalSelector instproc GenerateSpec {} {
     # OK, this is a REAL hack
 
     global spec_generator;
 
     if {![info exists spec_generator(init)]} {
         set gen_spec [split [$self get_option gen_spec] "."];
 
         set spec_generator(init) 1;
         set spec_generator(b1) [lindex $gen_spec 0];
         set spec_generator(b2) [lindex $gen_spec 1];
         set spec_generator(b3) [lindex $gen_spec 2];
         set spec_generator(b4) [lindex $gen_spec 3];
         set spec_generator(port) [expr (int(rand() * 5000)*2) + 10000]
     }
 
     incr spec_generator(b4);
 
     return "$spec_generator(b1).$spec_generator(b2).$spec_generator(b3).$spec_generator(b4)/$spec_generator(port)/16";
 }
 
 Class GraphComm/TemporalSelector -superclass GraphComm
 
 GraphComm/TemporalSelector instproc init {tselect id spec} {
     $self instvar tselect_;
 
     set tselect_ $tselect;
 
     set spec [split $spec "/"];
 
     set addr [lindex $spec 0];
     set port [lindex $spec 1];
     set ttl [lindex $spec 2];
 
     $self next $id $addr $port $ttl;
 
     $self instvar sess_map_ primary_sess_;
 
     set sess_map_($primary_sess_,inputs) 1;
     set sess_map_($primary_sess_,outputs) 0;
     set sess_map_($primary_sess_,parameters) 0;
     set sess_map_($primary_sess_,misc) 1;
     set sess_map_($primary_sess_,trigger_cmds) 1;
     set sess_map_($primary_sess_,map_cmds) 1;
 }
 
 GraphComm/TemporalSelector instproc recv_misc {data} {
     $self next $data;
 
     $self instvar tselect_;
 
     set cmd [lindex $data 0];
 
     switch -exact -- $cmd {
         add_subgraph {
             puts "In add_subgraph"; #debug
 
             $tselect_ instvar subgraph_list_ subgraph_info_ id_ sid_;
             $tselect_ instvar next_subgraph_;
 
             set new_subgraph [lindex $data 1];
 
             foreach sid $subgraph_list_ {
                 if {$subgraph_info_($sid,spec) == $new_subgraph} {
                     return;
                 }
             }
 
             incr sid_;
             lappend subgraph_list_ $sid_;
             lappend next_subgraph_ $sid_;
 
             puts "Creating subgraph comm"; # debug
             $self instvar primary_sess_;
 
             set subgraph_info_($sid_,comm_obj) [new GraphComm/TSToSubgraph $tselect_ $id_ $new_subgraph];
             $subgraph_info_($sid_,comm_obj) send_map_command [list map_parameters [$primary_sess_ set addr_] [$primary_sess_ set rport_] [$primary_sess_ set ttl_]];
             $self send_map_command [list map_parameters [[$subgraph_info_($sid_,comm_obj) set primary_sess_] set addr_] [[$subgraph_info_($sid_,comm_obj) set primary_sess_] set rport_] [[$subgraph_info_($sid_,comm_obj) set primary_sess_] set ttl_]];
 
             $subgraph_info_($sid_,comm_obj) set sid_ $sid_;
 
             set subgraph_info_($sid_,spec) $new_subgraph;
 
             $tselect_ instvar input_id_list_ input_info_;
 
             foreach i $input_id_list_ {
                 if {$input_info_($i,selector) != ""} {
                     $input_info_($i,selector) add_subgraph $sid_;
                 }
             }
         }
         del_subgraph {
             $tselect_ instvar subgraph_info_ subgraph_list_ next_subgraph_;
 
             set spec_to_del [lindex $data 1];
             set sid_to_del "";
             foreach s $subgraph_list_ {
                 if {$subgraph_info_($s,spec) == $spec_to_del} {
                     set sid_to_del $s;
                     break;
                 }
             }
             if {$sid_to_del == ""} {
                 return;
             }
             set idx [lindex $subgraph_list_ $sid_to_del];
             set subgraph_list_ [lreplace $subgraph_list_ $idx $idx];
 
             set idx [lindex $next_subgraph_ $sid_to_del];
             if {$idx != -1} {
                 set next_subgraph_ [lreplace $next_subgraph_ $idx $idx];
             }
 
             $tselect_ instvar input_id_list_ input_info_;
 
             foreach i $input_id_list_ {
                 set selector $input_info_($i,selector);
                 if {$selector != ""} {
                     $selector del_subgraph $sid_to_del;
                 }
             }
             delete $subgraph_info_($sid_to_del,comm_obj);
             unset subgraph_info_($sid_to_del,comm_obj);
             unset subgraph_info_($sid_to_del,spec);
 
             if {$subgraph_list_ == ""} {
                 # All the subgraphs are gone.
                 # FIXME Need to handle this case.
             }
         }
     }
     return;
 }
 
 GraphComm/TemporalSelector instproc recv_trigger_command {data} {
     $self next $data;
 
     $self instvar tselect_;
 
     $tselect_ instvar subgraph_list_;
 
     if {$subgraph_list_ == ""} {
         return;
     }
 
     set cmd [lindex $data 0];
 
     switch -exact -- $cmd {
         trigger {
             $tselect_ trigger;
         }
     }
     return;
 }
 
 GraphComm/TemporalSelector instproc update_input_attr_value {input_name attr value} {
     $self next $input_name $attr $value;
 
     $self instvar tselect_
     $tselect_ instvar input_id_list_;
 
     if {[lsearch $input_id_list_ $input_name] == -1} {
         return;
     }
 
     switch -exact -- $attr {
         spec {
             $tselect_ set_input_spec $input_name $value;
         }
         trigger {
             $tselect_ instvar input_info_;
 
             set type [lindex $value 0];
             if {$type == "auto"} {
                 set trigger_flag [lindex $value 1];
                 if {$input_info_($input_name,trigger) != $trigger_flag} {
                     set input_info_($input_name,trigger) $trigger_flag;
 
                     if {$input_info_($input_name,selector) != ""} {
                         if {$input_info_($input_name,trigger) != 0} {
                             $input_info_($input_name,selector) set_callback "$tselect_ trigger; # ";
                         } else {
                             $input_info_($input_name,selector) set_callback "";
                         }
                     }
                 }
             }
 
             set some_trigger 0;
             foreach in_id $input_id_list_ {
                 if {$input_info_($in_id,trigger) != 0} {
                     set some_trigger 1;
                     break;
                 }
             }
             if {$some_trigger == 0} {
                 $tselect_ instvar last_time_click_;
                 if {[info exists last_time_click_]} {
                     unset last_time_click_;
                 }
             }
         }
     }
 }
 
 Class GraphComm/TSToSubgraph -superclass GraphComm;
 
 GraphComm/TSToSubgraph instproc init {tselect id spec} {
     $self instvar tselect_;
 
     set tselect_ $tselect;
 
     set spec [split $spec "/"];
 
     set addr [lindex $spec 0];
     set port [lindex $spec 1];
     set ttl [lindex $spec 2];
 
     $self next $id $addr $port $ttl;
 
     $self instvar primary_sess_ sess_map_;
 
     set sess_map_($primary_sess_,outputs) 0;
     set sess_map_($primary_sess_,parameters) 0;
 }
 
 GraphComm/TSToSubgraph instproc new_input {new_input} {
     $self next $new_input;
 
     $self instvar tselect_;
 
     $tselect_ SetupInput $new_input;
 }
 
 GraphComm/TSToSubgraph instproc new_input_attribute {iname aname} {
     $self next $iname $aname;
 
     $self instvar tselect_;
 
     $tselect_ ReflectInputAttr $iname $aname
 }
 
 
 GraphComm/TSToSubgraph instproc set_input_spec {id value} {
     $self create_input $id;
     $self create_input_attr $id spec;
     $self set_input_attr $id spec $value;
 }
 
 GraphComm/TSToSubgraph instproc send_trigger_vector {vec} {
     $self send_trigger_command [list trigger_vector $vec];
 }
 
 GraphComm/TSToSubgraph instproc recv_trigger_command {data} {
     $self instvar sid_;
 
     set cmd [lindex $data 0];
 
     switch -exact -- $cmd {
         trigger_completion_token {
             $self instvar tselect_;
             $tselect_ instvar next_subgraph_;
             $tselect_ instvar ctoken_subgraph_q_;
             $tselect_ instvar subgraph_list_;
 
             $tselect_ instvar ctoken_count_ token_rate_period_;
 
             incr ctoken_count_ 1;
 #######
 #puts "CTokenCount = $ctoken_count_";
 #######
             after $token_rate_period_ "$tselect_ decr_ctoken_count";
 
             if {[lsearch $subgraph_list_ $sid_] != -1} {
                 lappend ctoken_subgraph_q_ $sid_;
             }
         }
     }
 }
 
 GraphComm/TSToSubgraph instproc recv_map_command {cmd} {
     set type [lindex $cmd 0];
     set addr [lindex $cmd 1];
     set port [lindex $cmd 2];
     set ttl [lindex $cmd 3];
 
     switch -exact -- $type {
         map_parameter -
         map_parameters {
             $self instvar tselect_;
             $tselect_ instvar comm_obj_;
 
             $comm_obj_ send_map_command $cmd;
         }
         default {
             $self next $cmd;
         }
     }
 }