Ada 95 :: x70_cc4.ada

with Ada.Text_io;
use  Ada.Text_io;
package Pack_types is
  type P_File_type is access all Ada.Text_io.File_type;
  EOT  : CONSTANT Character := Character'Val(0);
  CR   : CONSTANT Character := Character'Val(15);
  QUEUE_SIZE    : CONSTANT := 3;

  type    Queue_no    is new Integer   range 0 .. QUEUE_SIZE;
  type    Queue_index is mod QUEUE_SIZE;
  subtype Queue_range is Queue_index;
  type    Queue_array is array ( Queue_range ) of Character;
end Pack_types;

with Pack_types;
use  Pack_types;
package Pack_threads is
  protected type PT_buffer is         -- Task type specification
    entry put( ch:in Character; no_more:in Boolean );
    entry get( ch:in out Character; no_more:out Boolean);
  private
    elements    : Queue_array;              -- Array of elements
    head        : Queue_index := 0;         -- Index
    tail        : Queue_index := 0;         -- Index
    no_in_queue : Queue_no    := 0;         -- Number in queue
    fin         : Boolean     := FALSE;     -- Finish;
  end PT_buffer;

  type P_PT_buffer is access all PT_buffer;

  task type Task_read(p_buffer:P_PT_buffer; fd_in:P_File_type) is
    entry finish;
  end Task_read;

  task type Task_write(p_buffer:P_PT_buffer; fd_out:P_File_type) is
    entry finish;
  end Task_write;
end Pack_threads;

with Ada.Text_io;
use  Ada.Text_io;
package body Pack_threads is

  protected body PT_buffer is

    entry put( ch:in Character; no_more:in Boolean )
      when no_in_queue < QUEUE_SIZE  is
    begin
        if no_more then                    -- Last
          fin := TRUE;                     -- Set flag
        else
          elements( tail ) := ch;          -- Add to queue
          tail := tail+1;                  -- Next position
          no_in_queue := no_in_queue + 1;  --
        end if;
    end;

    entry get(ch:in out Character; no_more:out Boolean)
      when no_in_queue > 0 or else fin is
    begin
      if no_in_queue > 0 then             -- Item available
        ch := elements( head );           -- Get item
        head := head+1;                   -- Next position
        no_in_queue := no_in_queue - 1;   --
        no_more := FALSE;                 -- Not end
      else
        no_more := TRUE;                  -- End of items
      end if;
    end;

  end PT_buffer;

  task body Task_read is                  -- Task implementation
    ch      : Character;
  begin
    while not end_of_file( fd_in.all ) loop
      while not end_of_line( fd_in.all ) loop
        get( fd_in.all, ch);              -- Get character
        p_buffer.put( ch, FALSE );        -- Add to buffer
        --delay 0.00001;                  -- Cause task switch
      end loop;
      skip_line( fd_in.all );             -- Next line
      p_buffer.put( CR, FALSE );          -- New line
      --delay 0.00001;                    -- Cause task switch
    end loop;
    p_buffer.put( EOT, TRUE );            -- End of characters

    accept finish;
  exception
    when Tasking_error =>
      put("Exception in Task read"); new_line;
  end Task_read;

  task body Task_write is                 -- Task implementation
    last     : Boolean := FALSE;          -- No more data
    ch       : Character;                 -- Character read
  begin
    loop
      p_buffer.get( ch, last );           -- From buffer
      exit when last;                     -- No more characters
      if ch = CR then
        new_line( fd_out.all );           -- New line
      else
        put( fd_out.all, ch );            -- Character
      end if;
      --delay 0.00001;                    -- Cause task switch
    end loop;

    accept finish;                        -- Finished
  exception
    when Tasking_error =>
      put("Exception in Task write"); new_line;
  end Task_write;
end Pack_threads;

with Ada.Text_io, Pack_threads, Pack_types;
use  Ada.Text_io, Pack_threads, Pack_types;
procedure do_copy(from:in String; to:in String) is
  type State is ( OPEN_FILE, CREATE_FILE );
  fd_in   : P_File_Type := new Ada.Text_io.File_type;
  fd_out  : P_File_type := new Ada.Text_io.File_type;
  mode    : State := OPEN_FILE;
begin
  open(  File=>fd_in.all,  Mode=>IN_FILE,  Name=>from);
  mode := CREATE_FILE;
  create(File=>fd_out.all, Mode=>out_FILE, Name=>to);
  declare
    buffers : P_PT_buffer := new PT_buffer;
    reader  : Task_read( buffers, fd_in );
    writer  : Task_write( buffers, fd_out );
  begin
    reader.finish;  close( fd_in.all );   -- Finish reader task
    writer.finish;  close( fd_out.all );  -- Finish writer task
  end;
exception
  when Name_error =>
    case mode is
      when OPEN_FILE =>
        put("Problem opening file " & from ); new_line;
      when CREATE_FILE =>
        put("Problem creating file " & to ); new_line;
    end case;
  when Tasking_error =>
    put("Task error in main program"); new_line;
end do_copy;

with do_copy;
with Ada.Text_io, Ada.Command_line;
use  Ada.Text_io, Ada.Command_line;
procedure copy is
begin
  if argument_count = 2 then
    do_copy ( argument(1), argument(2) );
  else
    put("Usage: copy from to"); new_line;
  end if;
end copy;


© M.A.Smith University of Brighton. Created September 1995 last modified May 1997.
Comments, suggestions, etc. M.A.Smith@brighton.ac.uk * [Home page]