⟦464bc4f5d⟧

TextFile

job hj 2 200 time 11 0 area 10 size 100000
(
source = copy 25.1
lst = set 1 disc1
lst = indent source mark lc
listc = cross lst
o errors
message  pascal
pascal80 codesize.1600 alarmenv source
o c
lst = copy listc errors
scope user lst
lookup pass6code
if ok.yes
(
  mirrorbin = move pass6code
  finis output.no
)
convert errors
finis output.no
)
\f


process tssupervisor (
opsem : sempointer;
  var sem : !ts_pointer_vector);

(*------------------------------------------------------------------

.                         test alc 

---------------------------------------------------------------------

.               commands

.   u1   multi inputs
.   u2   7
.   u3   port
.   u4   test level   0: stop.  1: vis data. 
.                     2: vis antal.

.   data  (integers)
.
.   timeout periode in sec
.   max repeats
.   block length
.   statistics periode in minutes
.   priority

----------------------------------------------------------------------
*)

const

 vers = "mirror 12 / ";
 tansw = 2;
 ransw = 1;
 statcansw = 32;
 eventa = 40;
 maxread = 3;
 bufleng = 256;
 firstbuf = 6;
 lastbuf  = firstbuf-1+bufleng+10;
 main = tssup_sem_no;         (*   1  *)
 al = alc_sem_no;             (*  30  *)
 timeru3 = 250;
 timeru4 = 4;

\f



process stat ( var main, pol : semaphore; opsem : sempointer );
type

statistics = record
 a : array (1..11) of integer;
 b : array (1..4) of byte;
 c : array (1..6) of integer;
 d : array (1..4) of byte;
 e : array (1..8) of integer;
end;

var

 sum, min,
 port, h: integer;
 m: reference;
 t: statistics;
 z : zone;

begin

 testopen ( z, own.incname, opsem);

repeat
 wait ( m, main);
 port:= m^.u3 mod 16;
 min:= m^.u4;
 lock m as buf: statistics do t:= buf;
 signal ( m, pol);

 with t do
 begin
  testout ( z,"port--------", port);
  for h:= 2 to 5 do testout ( z,"blocks      ", a(2*h+1));
  sum:=0;
  for h:= 1 to 4 do if b(h)<>0 then sum:= 1;
  if sum <> 0 then
  for h:= 1 to 4 do testout ( z," last error ", b(h));
  for h:= 1 to 6 do testout ( z,"  rej       ", c(h));
  for h:= 1 to 4 do testout ( z," u and opk  ", d(h));

sum:= 0;
  for h:= 1 to 8 do if e(h)<> 0 then sum:= 1;
  if sum <> 0 then
  for h:= 1 to 8 do testout ( z," errs       ", e(h));
  testout ( z,"minutes-----", min);
 end

until false

end;



\f


process alc (
 var alcsem: !ts_pointer;
 var ls : !sempointer;
 port : byte );
external;

type

 blok = record        (*  driver message   *)
 first, last, next : integer;
 data: array ( firstbuf..lastbuf) of byte;
 end;

 command = record
  outsec, repe, leng, peri, pri : integer
 end;


 contype = record
 first, last, next : integer;
 auto: boolean;
 id, t1, n2, k : integer;
 end;

 vector = array (0..15) of integer;

statistics = record
 a : array (1..11) of integer;
 b : array (1..4) of byte;
 c : array (1..6) of integer;
 d : array (1..4) of byte;
 e : array (1..8) of integer;
 bi: array (0..7) of integer;
end;


\f



var

 error : boolean;

 byte_2: byte:= 0;
 byte_n: byte:= 3;
 prio: byte:= 1;
 oport, port : byte:= 17;

 state, tik,
 sends, recs, terrors, rerrors,
 used, multi : vector := vector(16***0);

 ss, minutes, periode,
 sec,
 rep, dataleng,
 top, cv, level,
 len, h, j : integer := 0;

 m, mt : reference;

 timerpool : pool 1;

 statsem,
 tpool, rpool : semaphore;

 mpool : pool 3*maxread+3+6 of blok;

 alc_name : alfa := "alc..       ";
 proc_alc : array (0..15) of shadow;
 proc_stat : shadow;

 z : zone;

\f


procedure printport;
begin
 if port <> oport then
 begin
  testout ( z,"port -------", port);
  oport:= port
 end
end;


\f



procedure connect;
begin
if open ( tpool ) then
 begin
 wait ( mt, tpool);
 mt^.u1:= 4;
 mt^.u2:= 7;
 lock mt as buf : contype do
 with buf do
 begin
  auto:= true;
  id:= 2;
  t1:= sec*10;
  n2:= rep;
  k:= 1;
 end;
 signal ( mt, sem(al+port).s^);
end
end;



procedure disconnect;
begin
 wait ( m, tpool);
 m^.u1:= 8;
 m^.u2:= 7;

 signal ( m, sem(al+port).s^);
end;

\f



procedure getstat;
begin
 wait ( mt, tpool);
 mt^.u1:= statcansw;
 mt^.u2:= 7;
 mt^.u4:= periode mod 256;
 signal ( mt, sem(al+port).s^);
end;


procedure trans ( port: byte);
var   h : integer;
begin
 if open ( tpool) then
 begin
 wait ( mt, tpool);
 lock mt as buf : blok do
 with buf do
 begin
  first:= 14;
  last:= first-1+dataleng;
  for h:= first to last do data(h):= (h-14) mod 256;
 data(first+1):= byte_2;
 data(last):= byte_n;
 end;
 mt^.u1:= tansw;
 mt^.u2:= 7;
 mt^.u3:= prio;
 signal ( mt, sem(al+port).s^);
 end
end;




\f


procedure read;
begin
if state(port) > 1 then
if used(port) < multi(port) then
begin
 wait ( m, rpool);
 m^.u2:= 7;
 signal ( m, sem(al+port).s^);
 used(port):= used(port) +1;
end
end;



procedure display;
begin
 lock m as buf : blok do
 with buf do
 begin
  testout ( z,"  first     ", first);
  testout ( z,"  last      ", last);
  testout ( z,"  next      ", next);
 if next > first+4 then top:= first+3;
  for j:= first to top do testout ( z,"    data    ", data(j));
  top:= next+2;
  if top > lastbuf then top:= lastbuf;
  for j:= next-3 to top do testout ( z,"     data   ", data(j));
 end
end;



\f



(*------------------------- main ---------------------------------*)

begin

testopen ( z, own.incname, opsem);
testout ( z, vers, al_env_version);

 cv:= link ( "alc         ", alc);

cv:= create ( "stat        ",
 stat ( statsem, tpool, opsem),
 proc_stat, 500);
 start ( proc_stat, -1);

 for h:= 1 to maxread*3 do
 begin
  alloc ( m, mpool, sem(main).s^);
  lock m as buf : blok do
  with buf do
  begin
   first:= 14;
   last:= lastbuf-10;
  end;
  m^.u1:= ransw;
  signal ( m, rpool)
end;

for h:= 1 to 6 do
begin
 alloc ( m, mpool, sem(main).s^);
 signal ( m, tpool)
end;

alloc ( m, timerpool, sem(main).s^);
m^.u1:= 6;
m^.u2:= 15;
m^.u3:= timeru3;   m^.u4:= timeru4;
sendtimer ( m);


\f



repeat
 wait ( m, sem(main).w^);
 port:= m^.u3;
if level = 1 then printport;

 if ( m^.u2 = 1 ) and ( m^.u1 = 6) then             (*  4 sec gone     *)
 begin
  ss:= ss-1;
  if ss <= 0 then
  begin                            (*  1 minute   *)
   ss:= 15;
   minutes:= minutes+1;
   if minutes >= periode then
   begin
    for port:= 0 to 15 do
    if state(port) > 1 then getstat;
    minutes:= 0;
  end;
  for port:= 0 to 15 do
  begin
   if state(port) > 1 then count ( tik(port));
   if tik(port) > 5 then trans ( port);
  end;
 end;
  m^.u3:= timeru3;   m^.u4:= timeru4;
  sendtimer ( m);
 end  else

 if m^.u2 = 7 then
begin
 multi(port):= m^.u1;
 if multi(port)>maxread then multi(port):= maxread;
 level:= m^.u4;
 lock m as buf: command do
 with buf do
 begin
  sec:= outsec;
  rep:= repe;
  dataleng:= leng;
  if dataleng > bufleng then dataleng:= bufleng;
  periode:= peri;
  minutes:= periode;
 prio:= pri mod 8;
 end;
 return ( m);
 if state(port) = 0 then         (*  start alc   *)
 begin
  alc_name(4):= chr(48+port div 10);
  cv:= port - 10*(port div 10);
  alc_name(5):= chr(48+cv);
  cv:= create ( alc_name,
  alc ( sem(al+port), sem(lam_sem_no).s, port),
  proc_alc(port), 2048);
  if cv <> 0 then testout (z, "create =    ", cv);
  start ( proc_alc(port), -1);
  alloc ( m, mpool, sem(main).s^);
  m^.u1:= eventa;
  m^.u2:= 7;
  signal ( m, sem(al+port).s^);
  state(port):= 2;
 end;
 connect;
 read;
 if level = 0 then disconnect;
end  else
\f



 (*---------- answer from alc ------------*)

 case m^.u1 of

4:  
 begin
  if level < 2 then testout ( z, "connect     ", m^.u2);
  signal ( m, tpool)
 end;

eventa:
 begin
  cv:= m^.u2 div 8;
  printport;
  testout ( z," event =    ", cv);
  m^.u2:= 7;
  if cv = 15 then         (*  alc exception    *)
  begin
   release ( m);
   state(port):= 1;
  end  else

begin
 signal ( m, sem(al+port).s^);
if cv = 0 then           (*  line up    *)
begin
 trans ( port);
end  else
 connect;

  if cv = 2 then
  begin
   testout ( z,"  sends     ", sends(port));
   testout ( z,"  rec.s     ", recs(port));
  end
 end
 end;

tansw:
 begin
  if m^.u2 = 0 then tik(port):= 0;
  if m^.u2 = 0 then count ( sends(port)) 
  else count ( terrors(port));
  if level = 1 then testout ( z, " t result   ", m^.u2);
  if ( level = 2) and ( m^.u2 <> 0 ) then
  begin
   printport;
   testout ( z,"t result    ", m^.u2);
  end;
  signal ( m, tpool);
 end;

\f



ransw:
 begin
  if m^.u2 = 0 then
  begin
   count ( recs(port));
   lock m as buf: blok do
   with buf do
   begin
    len:= next-first;
    error:= ( data(first+1) <> byte_2 ) or
       ( data(next-1) <> byte_n) ;
   end;
   if error then display;
   if level = 2 then
   begin
    printport;
    testout ( z,"received    ", len);
   end;
   if level = 1 then display;
  
   wait ( mt, tpool);
   lock mt as tbuf : blok do
   lock m  as  buf : blok do
   with tbuf do
   begin
    data:= buf.data;
    first:= buf.first;
    last := buf.next-1;
   if data(first) = 255 then data(first):= 0  else
   data(first):= data(first) +1;
   end;
   mt^.u1:= tansw;
   mt^.u2:= 7;
   mt^.u3:= prio;
   signal( mt, sem(al+port).s^);
  end  else
  begin
   count ( rerrors(port));
   printport;
   if level = 2 then testout ( z, "rec result  ", m^.u2);
   if level = 1 then display;
   if m^.u2 mod 8 = 3 then state(port):= 1;
  end;
  signal ( m, rpool);
  used(port):= used(port) -1;
  read;
 end;
\f


statcansw:
 begin
(*
  lock m as buf : statistics do
  with buf do
  begin
   for h:= 2 to 5 do testout ( z,"counts      ", a(2*h+1));
   for h:= 1 to 4 do testout ( z,"last error  ", b(h));
   for h:= 1 to 6 do testout ( z," c          ", c(h));
   for h:= 1 to 4 do testout ( z," u and opk  ", d(h));
   for h:= 1 to 8 do testout ( z,"  e         ", e(h));
   for h:= 0 to 7 do testout ( z,"bit 13-15   ", bi(h));
  end;
  signal ( m, tpool);
 *)
 signal ( m, statsem );
end;

otherwise
 begin
  printport;
  testout ( z,"answer      ", m^.u1);
  signal ( m, tpool);
 end
end;  (*  case*)

 for port:= 0 to 15 do
read

until false

end .   (*  of mirror    *)

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦464bc4f5d⟧ TextFile

Derivation

TextFile
