::
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]