DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »tdistribute«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »tdistribute« 

TextFile

job bbl 8 600 size 92000 time 5 0 perm mini 50 1

; file tdistribute mini   project

( mode list.yes
bdistribute = set 0 mini
bdistribute = pascal80 codelist.no distrenvir ioenvir

scope user bdistribute

finis )

process distribution_test( var sv : system_vector );

(* cirkulation of buffers between a father and a number
of children  *)

const
max_no_of_children = 25;

child_appetite = 150;

max_no_of_buffers = 50;

number_of_io_buffers = 1;




type
(* the type long is defined in distrenvir
as:
long = record
high, low : integer;
end;
*)

count_list_type = array ( 1 .. max_no_of_buffers ) of long;

str_type = array ( 1 .. 80 ) of char;




var
class : array ( -3 .. 0 ) of integer;  (* number of children per priority class *)

sh : array ( 1 .. max_no_of_children ) of shadow;

children,turns,divi,
step, step1, step2,
number_of_buffers, list_index  : integer;

count_list : count_list_type;

buffers : pool max_no_of_buffers of opbuffer;

z_in, z_out : zone;

pool_in, pool_out : pool number_of_io_buffers of opbuffer;

mainsem ,
return_sem, send_sem  : semaphore;

bref : reference;


procedure write( str : str_type );
var
str_index : integer;
begin
str_index := 1;

while str( str_index ) <> '#' do
begin
outchar( z_out, str(str_index) );
str_index := str_index + 1;

end;


end; (* write *)


procedure writeln( str : str_type ; number : integer );
begin
write( str );
if number <> -10 then
outinteger( z_out, number, 1 );

outchar( z_out, nl );

outend( z_out );

end; (* writeln *)





procedure error(number : integer);

(*output error text and index of child not created succesfully *)

begin
write("error in createcall, child index = ");
outinteger(z_out,number,10);
outchar(z_out,nl);
outend(z_out);
end;  (* error *)

process child(var rsem,csem : semaphore; var count : long);
(* the process will wait for buffers on csem update count and
signal the buffer to rsem *)

var
cref : reference;

begin

repeat

wait(cref,csem);

if count.low = 9999 then
begin
count.high := count.high + 1;
count.low := 0;
end
else
count.low := count.low+1;

signal(cref,rsem);

until false;

end;   (* child process *)

procedure run(prio,index : integer);
(* the child with identification index is created and made run
   with priority prio *)
var
child_name : alfa := 'child_      ';

begin
child_name(7) := chr(index div 10 + ord("0"));
child_name(8) := chr(index mod 10 + ord("0"));
with count_list( index ) do
begin
high := 0;
low  := 0;
end;

if create(child_name, child(return_sem, send_sem,count_list(index)) ,
sh(index),child_appetite) <> 0 then
error(index)
else
start(sh(index),prio);
end;  (* run *)


begin (* main of father process  *)

(* initialize console communication *)
openopzone( z_in, sv( operatorsem ), ref( mainsem ),
number_of_io_buffers, pool_in, 1, 0, 0, 0 );

openopzone( z_out, sv( operatorsem ), ref( z_out.free ),
number_of_io_buffers, pool_out, 2, 0, 0, 0 );



writeln( 'Welcome to the distribution test program # ', -10 );


repeat (* main loop *)
children := 0;
writeln(' number of children ? #', -10 );

for step := -3 to 0 do
begin
writeln( 'priority #', step );
opin(z_in);
opwait( z_in, pool_in );
ininteger( z_in, class( step ) );
children := children + class ( step );

outchar( z_out, nl );

end;

if children > max_no_of_children then children := children div ( 1-1 ); (* exit *)

writeln('number of buffers ? #', -10);

opin(z_in);
opwait( z_in, pool_in );

ininteger( z_in, number_of_buffers );

if number_of_buffers > max_no_of_buffers then
number_of_buffers := max_no_of_buffers;

writeln( 'number of turns (* 10000) ? #', -10);

opin(z_in);
opwait( z_in, pool_in );
ininteger ( z_in, turns );

(* prepare buffers *)

for step := 1 to number_of_buffers do
begin
alloc( bref, buffers, return_sem );
signal( bref, return_sem );
end;

list_index := 0;

for step := -3 to 0 do
for step1 := 1 to class( step ) do
begin
list_index := list_index + 1;
run( step (* the priority *) , list_index (* the index *) );
end;

writeln( 'start #', -10);
outchar(z_out, bel );
outend(z_out);

for step := 1 to turns do
for step1 := 1 to 10000 do
begin
wait( bref, return_sem );
signal( bref, send_sem );
end;

(* wait until all buffers are returned *)
for step := 1 to number_of_buffers do
begin
wait( bref, return_sem );
release( bref );
end;

outchar(z_out,bel);
writeln("end of distribution#",-10);
writeln("input parameters :#",-10);
writeln("number of turns :#",turns);
writeln("number of buffers :#",number_of_buffers);
writeln("priority -3 processes :#",class(-3));
writeln("priority -2 processes :#",class(-2));
writeln("priority -1 processes :#",class(-1));
writeln("priority  0 processes :#",class(0));

list_index := 0;

for step := -3 to 0 do
begin

writeln("priority :#",step);

for step1 := 1 to class(step) do
begin
list_index := list_index+1;
outinteger(z_out,step1,3);

with count_list(list_index) do
begin
outinteger(z_out,high,6);
divi := 1000;

for step2 := 1 to 4 do
begin
outinteger(z_out,low div divi mod 10,1);
divi := divi div 10;
end;

outchar(z_out,nl);
end;

remove( sh ( list_index ) );

end;

end;

until false;

end.
▶EOF◀