DataMuseum.dk

top - metrics - download

    Length: 8448 (0x2100)
    Types: TextFileVerbose
    Names: »tiostream«

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

TextFileVerbose

job jaba 9 600 time 5 0 prio 100 perm disc 50 1

; file tiostream mini   project

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

scope user biostream

finis )

process iostreamtest( var sv : system_vector );

(* test of one or more streams of input with dummy output action *)


const
max_no_of_children = 25;

child_appetite = 300;

max_no_of_buffers = 50;

number_of_io_buffers = 1;

timer_constant = 16000; (* time out constant *)



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


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




var

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

children,turns,
step, step1, step2,
prio, start_level,
number_of_buffers  : integer;


buffers : pool max_no_of_buffers of opbuffer;

z_in, z_out : zone;

pool_in, pool_out : pool number_of_io_buffers of opbuffer;

finis_sem, mainsem  : semaphore;
return_sem : array ( 1 .. max_no_of_children ) of semaphore;

dummy_counter : long; (* number of dummy interrupts, level *)

bref : reference;

channel_repeat : boolean; (* channel .. repeat  or  repeat .. channel  *)

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;

outend( z_out );

end; (* write *)


procedure writeln( str : str_type ; number : integer );
begin
write( str );
if number <> -10 then
outnumber( 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 = ");
outnumber(z_out,number,10);
outchar(z_out,nl);
end;  (* error *)


process switch(var switchsem , finissem : semaphore;
turns , startlevel , bufno , priority : integer;
chrep : boolean);

type
long            = record
high , low : integer
end;

const
childappetite   = 200;
dummycountindex = 1021;
lastdummyindex  = 1020;

var
childname       : alfa := 'child_';
isem , osem     : semaphore;
sref            : reference;
ishadow,oshadow : shadow;
i , j           : integer;

procedure getregister(var v : integer; index : integer);
external;

process idriver(var isem : semaphore;
chnumber : integer;
chrep : boolean);
const
dummycountindex = 1021;
var
i          : integer;
waitsem    : semaphore;
iref , ch  : reference;

procedure clearlevel;
external;

procedure setregister(v , index : integer);
external;

begin
if reservech(ch,chnumber,-1) <> 0 then
i := i div (1-1)
else
begin
setregister(0,dummycountindex);
if chrep then
channel ch do
repeat
wait(iref,isem);
clearlevel;
return(iref)
until false
else
repeat
wait(iref,isem);
channel ch do
clearlevel;
return(iref);
until false
end
end; (* idriver *)


process odriver(var osem : semaphore;
chnumber : integer);
var
i         : integer;
oref , ch : reference;
begin
if reservech(ch,chnumber,-1) <> 0 then
i := i div(1-1)
else
channel ch do
repeat
wait(oref,osem);
return(oref)
until false
end; (* odriver *)

(****************************************)
(*                                      *)
(*    switch mainprogram                *)
(*                                      *)
(****************************************)
begin
childname(7) := 'i';
childname(8) := chr(startlevel div 10 + ord('0'));
if create(childname,idriver(isem,startlevel+1,chrep),
ishadow,childappetite) <> 0 then 
i := i div (1-1);
start(ishadow,priority);

childname(7) := 'o';
if create(childname,odriver(osem,startlevel),
oshadow,childappetite) <> 0 then
i := i div (1-1);
start(oshadow,priority);

for i := 1 to turns do
for j := 1 to 20000 do
begin
wait(sref,switchsem);
with sref^ do
begin
u1 := (1 + u1) mod 2;
if u1 = 1 then
signal(sref,isem)
else
signal(sref,osem)
end
end;

i := 0;
repeat
wait(sref,switchsem);
with sref^ do
begin
u1 := (1 + u1) mod 2;
if u1 = 1 then
begin
i := i + 1;
if i = bufno then
begin
lock sref as pip : long do
begin
getregister(pip.high,dummycountindex);
getregister(pip.low,lastdummyindex)
end;
signal(sref,finissem)
end
else
release(sref)
end
else
signal(sref,osem)
end
until i = bufno
end (* switch process *)
;





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

begin
child_name(7) := chr(index div 10 + ord("0"));
child_name(8) := chr(index mod 10 + ord("0"));

if create(child_name, switch(return_sem( index ), finis_sem,
turns, start_level, number_of_buffers, prio, channel_repeat ),
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 );

opin( z_in );

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



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

own.timer := 0;
definetimer(true);

repeat (* main loop *)




writeln(' number of streams ? #', -10 );
opwait( z_in, pool_in );
readinteger( z_in, children );
opin( z_in );


writeln( 'channel .. repeat ( 1 ) or repeat .. channel ( 0 )#', -10);
opwait( z_in, pool_in );
readinteger( z_in, step );
opin( z_in );
channel_repeat := step = 1;




writeln( 'priority of the switch processes ? #', -10 );
opwait( z_in, pool_in );
readinteger( z_in, prio );
opin(z_in);

outchar( z_out, nl );


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

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

opwait( z_in, pool_in );

readinteger( z_in, number_of_buffers );
opin( z_in );

if number_of_buffers * children > max_no_of_buffers then
number_of_buffers := max_no_of_buffers div children;

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

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

writeln('level for first input driver is outputlevel + 1#',-10);
writeln('startlevel for first outputdriver ?#',-10);
opwait(z_in,pool_in);
readinteger(z_in,start_level);
opin(z_in);



for step2 := 1 to children do
begin

(* prepare buffers *)

for step := 1 to number_of_buffers do
begin
alloc( bref, buffers, return_sem ( step2 ) );
bref ^ . u1 := 0;  (* buffer prepared for input *)
signal( bref, return_sem ( step2 ) );
end;


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


run( start_level,  prio (* the priority *) , step2 (* the index *) );
start_level := start_level + 2;

end;

own.timer := timer_constant;

wait( bref, finis_sem ); (* get number of dummy interrupts *)
lock bref as count_buffer : long do
dummy_counter := count_buffer;
release( bref );


for step := 2 to children do
begin
wait( bref, finis_sem );
release( bref );
end;



outchar(z_out,bel);
writeln("end of streams, seconds = #", timer_constant - own.timer);
writeln("input parameters :#",-10);
writeln("number of turns :#",turns);
writeln("number of buffers :#",number_of_buffers);
writeln("number of streams :#", children );
writeln("priority of the switch process(es)#", prio );
writeln("channel .. repeat ( 1 ) or repeat .. channel ( 0 )#",
ord(channel_repeat) );
with dummy_counter do
begin
writeln('number of dummy interrupts: # ', high );
if high <> 0 then
writeln(' level of last dummy interrupt: #', low );
end;


for step := 1 to children do 
remove( sh ( step ) );


until false;

end.
«eof»