DataMuseum.dk

top - metrics - download

    Length: 15360 (0x3c00)
    Types: TextFileVerbose
    Names: »ncsupjob«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »ncsupjob« 

TextFileVerbose

job hj 4 200 time 11 0 area 10 size 100000
( message   nc supervisor
  source = copy 25.1
  ncsuplst = set 1 disc1
  ncsuplst = indent source mark lc
  listc = cross ncsuplst
  o errors
  message    nc supervisor
  pascal80 spacing.800 codesize.800 alarmenv source
  o c
  lookup pass6code
  if ok.yes
  ( ncsupbin = set 1 disc1
    ncsupbin = move pass6code
    scope user ncsupbin
  )
  ncsuplst = copy listc errors
  scope user ncsuplst
  convert errors
 finis
)
\f



process ncsupervisor (
  opsem :         sempointer;        (*  operator              *)
  var main_sem : !ts_pointer;        (*  my input semaphore    *)
  var free_sem : !ts_pointer;        (*  nc buffer pool        *)
  var done :     !ts_pointer;        (*  answer from timeout   *)
  var net_sem,                       (*  netconnector          *)
  timeout_sem  : !sempointer         (*  timeout module        *)
);

const

 version = "vers  0.16 /";

\f



const


 no_nc_talk = 7;             (*  number of buffers for nc     *)
 last_node = 63;             (*  max number of ts addresses   *)
 max_node = last_node+1;
 dc = 0;

 copy_code   = #h10;
 refuse_code = #h12;
 dc_down     = #h20;
 dc_up       = #h21;
 nc_down     = #h22;
 nc_up       = #h23;
 ts_down     = #h24;
 ts_up       = #h25;
 tablerequest= #hae;
 var_code    = #hb0;
 var_answ    = #hb1;
 nodetest_code=#hc0;
 nodetest_answ=#hc1;
 connect_code= #hc8;
 connect_answ= #hc9;
 finis_code  = #hce;

 words = size_listen - 1 - ( label_size div 2);
 refuse_length = 2*label_size+2;
 bc_length = label_size + 4 + 2;
 ae_length = label_size + 4;
 test_length = label_size + 10;

 delay1 = 250;              (*  1 sec = 1000 m sec     *)
 delay2 = 2;
 margin = 5;                (*  timeout tolerance     *)
 read_clock = 2;
 writetimer = 6;

 write = 2;
\f



type

 status = ( down, starting, sleep, ready );

 node_range = 0..max_node;

 flawshape = packed record             (*  for 1.0 and 1.2   *)
  head,
  data: alarmlabel
 end;


 note = packed record                  (*  for 2.xx and 10.14      *)
  head: alarmlabel;
  comp: alarmnetaddr;
  cnt : integer
 end;


 form11= packed record                   (*  for 11.0 and 11.1      *)
  head: alarmlabel;
  address: macroaddr;
 end;


 testshape = packed record              (*  for 12.0, 12.1, 12.8, 12.9   *)
  head: alarmlabel;
  testno, peri : integer;
  data: array ( 3..words) of integer;
 end;



\f



var

tickmess : pool 1;                 (*  1 sec ticks                *)
clockpool: pool 1 of ts_time;      (*  timing                     *)
bufferpool: pool no_nc_talk of testshape;

clock_msg,
ms, msg : reference;

n, ts, nodes : node_range := 0;

 index : array ( node_range) of node_range;
addr: array ( node_range) of alarmnetaddr;
state: array ( node_range) of status;
tests: array ( node_range) of integer;

who,                                 (*  message receiver    *)
here : alarmnetaddr :=               (*  my addr             *)
       alarmnetaddr(macroaddr(0,0,0),0);

from : macroaddr;                    (*  message sender      *)

periode: integer:= 5*60;              (*  timeout periode     *)
rest_time : integer:= 5*60;           (*  rest # sec to timeout   *)

 loading: boolean:= true;              (*  nc-up not received yet     *)

 h : integer;
 cause : result_range;

console : zone;



procedure readram ( var w: byte; adr: integer);
external;


procedure writeram ( adr, w: integer);
external;

\f



function gettime : ts_time;

type
 clock_form = record  time: ts_time  end;

begin

 signal ( clock_msg, timeout_sem^);
 wait   ( clock_msg, done.w^);
 lock     clock_msg as buf: clock_form do
  gettime:= buf.time

end;



\f



procedure xmit ( var m: reference; u4val: byte );

begin
 m^.u1:= write;
 m^.u3:= nc_route;
 m^.u4:= u4val;
 signal ( m, net_sem^)
end;






procedure answer ( 
  var m : reference;
  cause : result_range;
  oper  : byte   );

begin
 lock m as head: alarmlabel do
 with head do
 begin
  rec:= send;
  send:= here;
  result:= cause;
  ts_add:= gettime;
 end;
 xmit ( m, oper);
end;


\f




procedure refuse ( var m : reference; cause : result_range );

begin

 lock m as buf : flawshape do
 with buf do
 begin
  data:= head;
  data.op_code:= m^.u4;
  head.no_of_by:= refuse_length;
  head.rec:= head.send;
  head.send:= here;
  head.result:= cause;
  head.ts_add:= gettime;

  sensesem ( ms, free_sem.w^);
  if not nil ( ms) then
  begin
  lock ms as new : flawshape do
  begin
   new:= buf;
   new.head.rec:= addr(dc);
  end;
  xmit ( ms, copy_code);
  end;

 end;
 xmit ( m, refuse_code);

end;


\f



procedure insert ( new: macroaddr; newstate: status );

var   t: node_range;
begin

 if ( new.dc_addr = here.macro.dc_addr ) and
    ( new.nc_addr = here.macro.nc_addr ) and
    ( new.ts_addr <> 0 )  then
 begin   (*  new is one of my ts   *)
  addr(nodes+1).macro:= new;
  t:= index(new.ts_addr);
  if t = max_node then
  begin
   t:= nodes+1;
   index(new.ts_addr):= t;
   nodes:= t;
  end;
  if msg^.u4 = ts_down then state(t):= down  else
  if msg^.u4 = ts_up then state(t):= ready  else
  state(t):= newstate;
 end;

end;


\f


procedure update ( var msg: reference);

begin    (*      11.0 from dc    *)

 lock msg as buf: form11 do
 with buf do
 begin
  insert ( address, starting);
  here:= buf.head.rec;
 end;
 answer ( msg, accepted, var_answ);

end;

\f




procedure first ( var m : reference );

var   res : byte;

begin

 lock m as buf : testshape do
 with buf, head do
 begin
  if ( m^.u4 = nodetest_code) and             (*  12.0   from dc *)
  ( rec.macro.ts_addr = 0 ) and
  ( send.macro.nc_addr = 0 ) and
  ( send.macro.ts_addr = 0 ) then
  begin
   here.macro:= rec.macro;
   periode:= abs ( peri);
   rest_time:= periode;
   addr(dc).macro.dc_addr:= here.macro.dc_addr;
   state(dc):= ready;
   cause:= not_ready;
   res:= nodetest_answ;
  end  else
  begin
   cause:= unknown_opcode;
   res:= refuse_code;
  end;
 end;
 
 answer ( m, cause, res);

end;


\f



procedure restart ( where: alarmnetaddr);

begin            (*  send 10.14 to dc     *)

 wait ( ms, free_sem.w^);
 lock ms as buf: note do
 with buf, head do
 begin
  no_of_by:= ae_length;
  rec:= addr(dc);
  send:= here;
  update:= insert_code;
  result:= accepted;
  ts_add:= gettime;
  comp:= where;
 end;
 xmit ( ms, tablerequest);

end;

\f




procedure broadcast (
  operation : byte;               (*  op code          *)
  who : alarmnetaddr;             (*  receiver         *)
  where : alarmnetaddr;           (*  component        *)
  c : integer                     (*  count            *)
);

begin

 wait ( ms, free_sem.w^);
 lock ms as buf : note do
 with buf, head do
 begin
  no_of_by:= bc_length;
  rec:= who;
  send:= here;
  update:= insert_code;
  ts_add:= gettime;
  comp:= where;
  cnt:= c
 end;

 xmit ( ms, operation)

end;



\f



procedure test_all;

begin                           (*  test all ts   *)

 for ts:= 1 to nodes do
 begin
  
  if state(ts) = sleep then         (*  answer missing   *)
  begin
   state(ts):= down;
   for n:= 0 to nodes do
    if n <> ts then
    broadcast ( ts_down, addr(n), addr(ts), 0);
  end;

   wait ( ms, free_sem.w^);
   lock ms as buf: testshape do
   with buf, head do
   begin
    no_of_by:= test_length;
    rec:= addr(ts);
    send:= here;
    update:= insert_code;
    ts_add:= gettime;
    count ( tests(ts));
    testno:= tests(ts);
    peri:= periode+margin;
   end;
   if state(ts) = ready then state(ts):= sleep;
   xmit ( ms, nodetest_code)

 end
end;


\f



(*--------------------- exception for nc-sup -------------------------*)

procedure exception ( cause : integer);

var  switch: byte;

begin
 trace ( cause);        (*  shows where I was   *)

 (*                 clear resources    *)
 if not nil ( msg) then refuse ( msg, breaked);
 if nil ( ms) then wait ( ms, free_sem.w^);

 lock ms as buf: testshape do
 with buf, head do
 begin
  no_of_by:= label_size + 2;
  send:= addr(dc);
  testno:= cause
 end;
 answer ( ms, breaked, finis_code);

 for h:= 1 to no_nc_talk do
 begin
  wait ( ms, free_sem.w^);
  release ( ms)
 end;

 (*                 exception loop   *)
 h:= 0;
 repeat
  wait ( msg, main_sem.w^);
  if ownertest ( tickmess, msg) then
   release ( msg)
  else
   refuse ( msg, breaked);
  h:= h+1;

 if h>2 then
 begin            (*     autoload       *)
readram ( switch, 10);
if switch div 16 = 6 then
begin
 writeram ( 6,0);   writeram ( 5,1);
 while true do ;
end
end;
until false

end;


\f


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

begin
 testopen ( console, own.incname, opsem);
 testout ( console, version, al_env_version);



 for ts:= 0 to max_node do
 begin
  index(ts):= max_node;
  addr(ts).macro:= macroaddr(0,0,0);
  addr(ts).micro:= tss_mic_addr;
  state(ts):= down;
  tests(ts):= 0
 end;
 addr(dc).micro:= dc_erh_mic_addr;

 for h:= 1 to no_nc_talk do
 begin
  alloc ( msg, bufferpool, free_sem.s^);
  msg^.u3:= nc_route;
  signal( msg, free_sem.s^)
 end;

 alloc ( clock_msg, clockpool, done.s^);
 clock_msg^.u1:= read_clock;
 clock_msg^.u3:= nc_route;

                              (*  wait for 12.00   *)
 repeat
  wait ( msg, main_sem.w^);
  case msg^.u3 of
   dummy_route:    return ( msg);
   netc_route1:    return ( msg);      (*  refused  *)
   netc_route:     first ( msg);
  otherwise        signal ( msg, net_sem^);
  end  (*  case  *)
 until state(dc) = ready;

 restart ( here);
 alloc ( msg, tickmess, main_sem.s^);
 msg^.u1:= writetimer;
 msg^.u3:= delay1;
 msg^.u4:= delay2;
 sendtimer ( msg);

 (*q   trace ( 370);    (*  only for debug   *)
\f



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

repeat

 wait ( msg, main_sem.w^);

 if ownertest ( tickmess, msg) then              (*  timer  *)
 begin
  rest_time:= rest_time - 1;
  msg^.u3:= delay1;
  msg^.u4:= delay2;
  sendtimer ( msg);

  if rest_time <= 0 then                      (*  timeout    *)
  begin
<*      skip until  dc makes nodetest ---------------------------- *>
   if state(dc) <> down then
   begin
    state(dc):= down;
    for ts:= 1 to nodes do
     broadcast ( dc_down, addr(ts), addr(dc), 0);
   end;
<* ----------------------------------------------------------------*>
   test_all;
   rest_time:= periode;

  end    (*  timeout  *)
 end     (* timer    *)
 else

 if msg^.u3 = dummy_route then
  return ( msg)
 else

\f



 begin                        (*  other messages   *)

  lock msg as head: alarmlabel do 
  begin
   who:= head.rec;
   from:= head.send.macro
  end;

  if who = here then             (*  for me    *)
  begin
  case msg^.u4 of

refuse_code:
  begin
   lock msg as buf: testshape do
   with buf do
    if state(index(peri mod 64)) >= sleep then
    begin
     testout ( console, "msg to      ", peri);
     testout ( console, "returned    ", data(6));
    end;
   return ( msg)
  end;

#h20..#h23,
#h26..#h29:    
  begin                              (*  broadcast    *)
   lock msg as buf: note do
   with buf do
   begin
    if from = addr(dc).macro then
    begin
     head.send.micro:= addr(dc).micro;
     if ( msg^.u4 = nc_up ) and
      ( comp = here ) then    loading:= false;
    end;
    for ts:= 0 to nodes do
    if head.send <> addr(ts) then
    broadcast ( msg^.u4, addr(ts), comp, cnt)
   end;
   return ( msg);
  end;

\f



ts_down,
ts_up  :
  begin                             (*  ts broadcast   *)
   lock msg as buf: note do
   with buf, head do
   begin

    insert ( comp.macro, ready);

    if from = addr(dc).macro then head.send.micro:= addr(dc).micro;
    for ts:= 0 to nodes do
     if head.send<> addr(ts) then
     broadcast ( msg^.u4, addr(ts), comp, cnt);
    end;
   return ( msg);

  end;

var_code:
 if from = addr(dc).macro then                      (*  11.0   *)
  update ( msg) else
  refuse ( msg, unknown_sender);

\f



nodetest_code:
 begin                                      (*  12.0    *)
  if from = addr(dc).macro then
  begin
   lock msg as buf: testshape do 
    periode:= abs ( buf.peri);
   rest_time:= periode;
   answer ( msg, accepted, nodetest_answ);
   if state(dc) = down then
   begin
    for ts:= 1 to nodes do
    broadcast ( dc_up, addr(ts), addr(dc), 0);
   end;
   if loading then restart ( here);
   state(dc):= ready;
   test_all;
   rest_time:= periode;
  end
  else
   refuse ( msg, unknown_sender)
 end;



<*  *>
(*-------------- only for debug of own exception ------------------*)

#h0b:                                               (*  0.11    *)
begin
 h:= h div msg^.u1;        (*  if u1 = 0   *)
 exception ( msg^.u2);     (*  or use u2   *)
end;

<*  *>


\f



nodetest_answ:                                 (*  12.1    *)
 begin
  lock msg as buf: testshape do
  with buf do
  begin
   ts:= index(head.send.macro.ts_addr);
   if ts <= nodes then     (*  found   *)
   begin
    if head.result = not_ready then
    begin
     restart ( head.send);
     if state(ts) >= sleep then              (*  ts autoloaded    *)
     for n:= 0 to nodes do
     if n <> ts then
      broadcast ( ts_down, addr(n), addr(ts), 0);
     state(ts):= starting;
    end  else
    begin
    if state(ts) = down then
    begin
     for n:= 0 to nodes do
      if n <> ts then
      broadcast ( ts_up, addr(n), addr(ts), 0)
    end;
    state(ts):= ready;
    end;
    if tests(ts) <> testno then
    begin
     testout ( console, "send no.    ", tests(ts));
     testout ( console, "received    ", testno);
    end;
          (*  look at data(2..8)    *)
   end
   else
   insert ( from, starting);
  end;
  return ( msg);
 end;

connect_code:                                    (*  12.8    *)
 begin
  answer ( msg, accepted, connect_answ)
 end

otherwise
 refuse ( msg, unknown_opcode)

end  (*  case  *)
end  (*  who = here   *)

\f



else

if ( msg^.u3 = netc_route1 ) then          (*  refused by netc    *)
 return ( msg)   else

if ( msg^.u3 = netc_route2 ) then         (*  answer from netc   *)
 signal ( msg, net_sem^)
else

if who.micro = netc_mic_addr then       (*  to netc     *)
begin
 msg^.u3:= netc_route1;
 signal ( msg, net_sem^);
end  else

if ( from = addr(dc).macro )
 and ( msg^.u4 = var_code)
 and ( who.micro = tss_mic_addr ) then
  update ( msg)
else
  refuse ( msg, unknown_receiver);
end

until  false;

end .      (*  of nc - supervisor   *)


«eof»