-- Copyright (C) 1996 Morgan Kaufmann Publishers, Inc

-- This file is part of VESTs (Vhdl tESTs).

-- VESTs is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the
-- Free Software Foundation; either version 2 of the License, or (at
-- your option) any later version. 

-- VESTs is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-- for more details. 

-- You should have received a copy of the GNU General Public License
-- along with VESTs; if not, write to the Free Software Foundation,
-- Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 

-- ---------------------------------------------------------------------
--
-- $Id: ch_19_fork-b.vhd,v 1.2 2001-10-26 16:29:36 paw Exp $
-- $Revision: 1.2 $
--
-- ---------------------------------------------------------------------

architecture behavior of fork is

begin

  forker : process

    variable cumulative_probabilities : probability_vector(1 to probabilities'length);
    variable destination : positive range out_arc'range;
    variable probabilities_index : positive range probabilities'range;
    variable number_of_tokens_forked : natural := 0;
    type counter_array is array (positive range out_arc'range) of natural;
    variable number_forked_to_destination : counter_array := (others => 0);

    variable random_info : random_info_record;
    variable random_number : real;

    type transaction_vector is array (positive range <>) of boolean;
    variable out_arc_transaction_driving_value : transaction_vector(out_arc'range)
      := (others => false);

    use std.textio.all;
    file info_file : text;
    variable L : line;

    procedure write_summary is
    begin
      write(L, string'("Summary information for fork "));
      write(L, name);
      write(L, string'(" up to time "));
      write(L, now, unit => time_unit);
      writeline(info_file, L);
      write(L, string'("  Number of tokens forked = "));
      write(L, natural(number_of_tokens_forked));
      writeline(info_file, L);
      for destination in out_arc'range loop
        write(L, string'("    Number to output("));
        write(L, destination);
        write(L, string'(") = "));
        write(L, number_forked_to_destination(destination));
        write(L, string'(" ("));
        write(L, real(number_forked_to_destination(destination))
              / real(number_of_tokens_forked),
              digits => 4);
        write(L, ')');
        writeline(info_file, L);
      end loop;
      writeline(info_file, L);
    end write_summary;

    procedure write_trace is
    begin
      write(L, string'("Fork "));
      write(L, name);
      write(L, string'(": at "));
      write(L, now, unit => time_unit);
      write(L, string'(" forked to output "));
      write(L, destination);
      write(L, ' ');
      write(L, in_arc.token, time_unit);
      writeline(info_file, L);
    end write_trace;

  begin
    assert probabilities'length = out_arc'length - 1
      report "incorrent number of probabilities - should be "
      & integer'image(out_arc'length - 1) severity failure;
    cumulative_probabilities := probabilities;
    for index in 2 to cumulative_probabilities'length loop
      cumulative_probabilities(index) := cumulative_probabilities(index - 1)
					 + cumulative_probabilities(index);
    end loop;
    init_uniform( random_info,
                  lower_bound => 0.0, upper_bound => 1.0, seed => seed );
    file_open(info_file, info_file_name, write_mode);

    loop
      wait on info_detail'transaction, in_arc;
      if info_detail'active and info_detail = summary then
        write_summary;
      end if;
      if in_arc'event then
        generate_random(random_info, random_number);
        destination := out_arc'left;
        for index in 1 to cumulative_probabilities'length loop
          exit when random_number < cumulative_probabilities(index);
	  if out_arc'ascending then
	    destination := destination + 1;
	  else
	    destination := destination - 1;
	  end if;
        end loop;
        out_arc(destination) <= arc_type'( transaction => not out_arc_transaction_driving_value(destination),
					   token => in_arc.token );
	out_arc_transaction_driving_value(destination) := not out_arc_transaction_driving_value(destination);
        number_of_tokens_forked := number_of_tokens_forked + 1;
        number_forked_to_destination(destination)
          := number_forked_to_destination(destination) + 1;
        if info_detail = trace then
          write_trace;
        end if;
      end if;
    end loop;
  end process forker;

end behavior;