⟦98d5193c9⟧

TextFileVerbose

job jg 5 200 time 11 0 area 9 size 117248 perm disc1 1000 2
(
 source = copy 25.1
 tsvchlst = set 1 disc1
 tsvchlst = indent source mark lc  
 listc = cross tsvchlst
o errors
head 1
message tsvch program
pascal80 spacing.1024 codesize.1024  alarmenv source
o c
lookup pass6code
 if ok.yes
(
tsvchbin=set 1 disc1
tsvchbin=move pass6code
scope user tsvchbin
)
tsvchlst = copy listc errors
scope user tsvchlst
convert errors
finis
)
\f


process vc_handler(

  opsem : sempointer;
  var dc_addr,
  ts_addr :    !macroaddr;
  var sem : !ts_pointer_vector
);


const

version = "vers  3.91 /";
(*       ------------ *)
\f


(*
INTRODUCTION TO THE VC-HANDLER:


 
Abbreviation list for the VC-HANDLER prosess:

( the introduction of the alarmenvironment has made some inconsistenses in the list )

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

adr       address
at        alarm terminal
atc       at-connector
ath       at-handler
buf       buffer
dc        district center
del       delete
elm       element
in        input
incar     incarnation
ins       insert
mac       macro address
max       greatest
mes       message
mic       micro address
min       smallest
nb        number
pvc       primary vc
rec       receiver
sem       semaphore
sen       sender
sup       ts-supervisor
vc        alarm center
vcc       vc-connector
vct       vc-table
\f


  
Pseudo-code for the VC-HANDLER process:
--------------------------------------

( this pseudo_code will be updated regularly - last time was 81.02.06 )

PROCESS vc_handler("process_parameters");
  
CONST
. "process_constants, installation dependent" (may be moved to alarm-environment);

TYPE
. "message_format" (may be moved to alarm-environment);
 
VAR
. "vc_table, binary search";
 
. "addressing_data";
. "scheduling_data";
. "supervising_data";
. "vcc_incarnation_data";
. "error_handling_data";
    
. "input_semaphore";
. "wait_buffer_semaphore";
 
BEGIN
. "initialization";
 
. REPEAT
.   "wait a message on the input_semaphore, and
.   "handle the message in the buffer, corresponding to the
.    operation_code, and produce resulting messages";

.   "for each resulting message do addressing/indexing 
.    do supervising and signal each of the buffers to the
.    corresponding input_semaphore";
 
. until  forever

END;     *  of pseudo code    *

*)
\f



(*--------------------- process vch help -------------------------------*)

process vch_help (
  var vcc_inc : vcc_table;      (*  incarnation table         *)
  var main,                     (*  vch sem                   *)
  me,                           (*  vch help sem              *)
  free : !sempointer            (*  free buffers sem          *)
 );

type
 note = packed record       (*  for broadcast   *)
  head : alarmlabel;
  comp : alarmnetaddr;
  count : integer
 end;

const
 write = 2;
 
sleep = 1;
tested= 2;
down  = 4;

 connection_code = #hc8;

var
 msg, bm : reference;
 v : vc_range;
 handler: alarmnetaddr;

begin      (*------------ main help program ----------------*)
 repeat
  wait ( msg, me^);

if msg^.u4 div 16 = 2 then               (*  broadcast    *)
begin
 for v:= 1 to vc_l do
 if vcc_inc(v).state < down then             (*  send a broadcast   *)
 begin
  wait ( bm, free^);
  bm^.u1:= write;
  bm^.u3:= netc_route;
  bm^.u4:= msg^.u4;
  lock bm as buf: note do
  lock msg as mes: note do
  begin
   buf:= mes;
   buf.head.rec.micro:= vcc_inc(v).vc_mic
  end;

  signal ( bm, main^)
  end;
  return ( msg)
 end
 else
 if msg^.u4 = #hc0 then                   (*  node test      *)
 begin

  lock msg as head: alarmlabel do handler:= head.rec;

  for v:= 1 to vc_l do
  if vcc_inc(v).state = sleep then
  begin
   wait ( bm, free^);
   bm^.u1:= write;
   bm^.u3:= netc_route;
   bm^.u4:= connection_code;

   lock bm as head: alarmlabel do
   with head do
   begin
    no_of_by:= label_size;
    rec:= handler;
    rec.micro:= vcc_inc(v).vc_mic;
    send:= handler;
   end;
   signal ( bm, main^);
   vcc_inc(v).state:= tested;
  end;

  msg^.u3:= netc_route1;            (*  let vch make receipt   *)
  msg^.u4:= #hc1;
  signal ( msg, main^)
 end;      (*  node test     *)



 until false;
end;

\f



(*--------------------- vch ----------------------------------------*)

type

alarm_form70 = record (* used in 7.0 *)
head : alarmlabel;
tail : record
vcc_mic : integer;
vc_kind : byte; (* 0 means at- and 1 means it-kind *)
lam_nb : byte; (* index to the sem array *)
port_nb : byte; (*  channel number *)
end;
end;



alarm_form74 = record     (*  format in 7.4  *)
 head : alarmlabel;
 vcc_addr : integer
end;



const

ready = 0;              (*  vcc states     *)
sleep = 1;
tested= 2;
down  = 4;

refuse_code = #h12;       (*   opcode 1.2    *)

helpsize = 200;
helppri  = -1;
ok = 0;

\f


var

(*------------ incar-part ------------*)

shad : array ( vc_range) of shadow;
vct : vcc_table;          (*  incarnation table      *)
(* is used for administration of semaphores and shadow_variables
.  to all the vcc_incarnations 
*)

vct_index,
vct_max : vc_range := 0;


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

in_mes : reference;
where : macroaddr;             (*  receiver     *)
who   : integer;

result_code : result_range;

test : boolean := false; (* true means testmode *)

vcc_name : alfa;
vcc_nb, alfa_pos : integer;

z : zone;

 shadhelp : shadow;


\f


(*------------ procedures and functions ------------*)


(*------------ externals ------------*)


process vcc(
opsem : sempointer;
var messem : !ts_pointer;
var quesem : !ts_pointer;
var vchsem,
driversem,
timeoutsem,
comsem : !sempointer;
var dc_addr,
ts_addr:   !macroaddr;
micadr : integer;
canno : byte
);
external;

(*------------ forward declaration ------------*)


procedure receipt_mes(
var rec_mes : reference;
result_code : result_range
);
forward;


procedure refuse ( var msg : reference; cause : result_range);
forward;

\f


(*------------ vct_part ------------*)


procedure find_vct_elm(
mic : integer;
var result : result_range;
var index : vc_range
);
(*---------------------------------------------------------------
.  This procedure returns the index of the element with the given
.  micro-address. If not found, then the index is that of the
.  element in front of the place, where it ought to be.
.  The search strategi is binary search in an ordered list of 
.  elements. The smallest element has the index = 1.  
.  Error - will not appear.
----------------------------------------------------------------*)
VAR
low, mid, high : vc_range;

BEGIN
result:= not_found;

if vct_max = 0 then
index := 0 (* vct is empty *)
else (* we first check the lower bound *)
if mic < vct(1).vc_mic then index := 0 else
if mic = vct(1).vc_mic then  
begin
 index:= 1;
 result:= accepted
end
else
begin (* now the search is started *)
low := 1;
high := vct_max; (* >1 *)
mid := high;

repeat
with vct(mid) do
if mic = vc_mic then
begin
index := mid;
 result:= accepted
end
else
if mic < vc_mic then
high := mid
else low := mid; (* mic > vc_mic *)
(* end with *)
mid := (high - low) div 2 + low;
until (result = accepted) or ( high - low < 2 );

if result <> accepted then
index := low; (* mic ought to be placed between low and high *)
end (* search-part *);

(*q if test then 
if result = accepted then testout(z,"vct index  :",index)
else testout(z,"not in vct :",mic); q*)

end (* find_vct_el *);

\f



procedure move_vct_entry ( var rec, from : vc_incar_e );
begin
with from do
begin
rec.vc_mic:= vc_mic;
 rec.state:= state;
rec.in_sem:= in_sem;
rec.shix := shix
end
end;  (*  of move  *)

\f


procedure place_vct_elm(
vcc_mic : integer;
var result : result_range;
var index : vc_range
);
(*---------------------------------------------------------------------
.  This procedure makes place for an element in the vct, if room for it 
.  and initialize it.
.  Error => result := rejected.
---------------------------------------------------------------------*)
var
ix : vc_range;
work : vc_incar_e;

begin
find_vct_elm( vcc_mic, result, index );
if result = accepted then  result:= existing_entry  else
if vct_max >= vc_l then  result:= no_room  else
if (vcc_mic < vc_addr_limit) or (vcc_mic >= at_addr_limit) then
begin
(*q if test then testout(z,"place_err   ",vcc_mic); q*)
 result:= not_found
end
else
begin    (*  place the element  *)
move_vct_entry ( work, vct(vct_max+1));
for ix:= vct_max downto index+1 do
move_vct_entry ( vct(ix+1), vct(ix));
vct_max := vct_max + 1;
index := index + 1; (* that's the new place *)
move_vct_entry ( vct(index), work);
vct(index).vc_mic:= vcc_mic;
 vct(index).state:= sleep;
 result:= accepted
end;
end (* place_vct_elm *);

\f


procedure del_vct_elm(
del_mic : integer;
var result : result_range
);
(*-----------------------------------------------------------------------
.  This procedure delets an element in the vct, if found.
.  Error => dc
-----------------------------------------------------------------------*)
var
res : result_range;
index, ix : vc_range;
work : vc_incar_e;

begin
find_vct_elm(del_mic, res, index);
if res = accepted then

if not nil ( shad(vct(index).shix)) then
begin

vct(index).state:= down;
break ( shad(vct(index).shix), 47);
remove ( shad(vct(index).shix));

move_vct_entry ( work, vct(index));
for ix := index to vct_max - 1 do
move_vct_entry ( vct(ix), vct(ix+1));
move_vct_entry ( vct(vct_max), work);
vct_max := vct_max - 1;

end;
result:= res
end (* del_vct_elm *);
\f


(*------------ sup-part ------------*)


(*-------------------------------------------------------------------
.  this part will later include several procedures for handling
.  this modules supervision of vcc's and tss.
.  so far - you will meet the comment "supervision", where these
.  procedures are to be called,
.  and that takes place immediately after waits, and when signalling.
--------------------------------------------------------------------*)
\f


(*------------ signal-part ------------*)


procedure signal_to_vcc (
var msg : reference;
known_index : vc_range
);
(*----------------------------------------------------------------------
.  This procedure signals the message to the input_semaphore of the vcc,
.  and do the supervision. If known_index is zero, this procedure 
.  finds the vct-index itself.
.  No check on known_index.
.  Error => send receipt_mes.
-----------------------------------------------------------------------*)
var
result : result_range;
wanted : integer;
index : vc_range;

begin
lock msg as head : alarmlabel do wanted:= head.rec.micro;
if known_index <> 0 then    (*  check  *)
if vct(known_index).vc_mic <> wanted then known_index:= 0;

if known_index = 0 then
find_vct_elm( wanted, result, index )
else
index := known_index;

if vct(index).state = down then  result:= not_ready;
if result = accepted then
begin
signal ( msg, sem( vct(index).in_sem).s^ );
(* supervision - here we need the index for identification of the vcc *)
end
else
begin
(*-- reject --*)

refuse ( msg, result );

(*q if test then testout(z,"sgnl_vct_err",index); q*)
end;
end (* signal_to_vcc  *);
\f



procedure receipt_mes (

var rec_mes : reference;

result_code : result_range
);
(*------------------------------------------------------------------
.  This procedure signals receipt-messages to the sup with the 
.  correct u3, u4, address, no_of_by, and result_code.
--------------------------------------------------------------------*)
begin

with rec_mes^ do
begin

lock rec_mes as head : alarmlabel do
with head do
begin
 rec := send;
 send.macro:= ts_addr;
 send.micro:= vch_mic_addr;
 result := result_code;
end (* lock - with *);
u3:= vci_route;
u4:= (u4 div 2)*2 + 1;
end (* with *);

signal( rec_mes, sem(tssup_sem_no).s^ );

end (* receipt_mes *);

\f



procedure refuse ( 
  var msg : reference;           (*  message to refused      *)
  cause   : result_range         (*  result code             *)
    );

              (*  send 1.2  back to sender      *)

type

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

begin
 lock msg as buf : flawshape do
  with buf do
  begin
   data:= head;
   data.op_code:= msg^.u4;
   with head do
   begin
    no_of_by:= 2*label_size+2;
    rec:= send;
    send.macro:= ts_addr;
    send.micro:= vch_mic_addr;
    result:= cause;
   end
  end;
 
 msg^.u3:= vci_route;
 msg^.u4:= refuse_code;
 signal ( msg, sem(tssup_sem_no).s^)

end;


\f



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

(*------------ initialisation ------------*)

testopen ( z, own.incname, opsem);
testout(z,version,al_env_version);
result_code := create ( "vchhelp     ",
 vch_help ( vct,
   sem(vch_sem_no).s,
   sem(vch_int1).w,
   sem(com_pool).w
    ),
  shadhelp, helpsize  );

if result_code <> ok then
 testout ( z,"help create=", result_code)
else
 start ( shadhelp, helppri);
for vct_index:= 1 to vc_l do
with vct(vct_index) do
begin
 vc_mic:= at_addr_limit;
 state:= down;
 in_sem:= vcc_sem_no - 2 + 2 * vct_index;
 shix:= vct_index
end;

(*------------ main repeat_loop-part ------------*)

repeat (* until terminate situation *)

 result_code:= accepted;

(*q if test then testout(z,"wait in_sem ",0); q*)

wait( in_mes, sem( vch_sem_no ).w^ );
(* here it waits effectively, if no messages has been scheduled *)

(* if test then testout(z,"in_mes   u3:",in_mes^.u3);
if test then testout(z,"         u4:",in_mes^.u4); *)

(* first of all we group the messages, depending on from where it
.  does come.
*)

(*q if test then testout(z,"case     u3:",in_mes^.u3);
if test then testout(z,"         u4:",in_mes^.u4); q*)

case  in_mes^.u3  of

dummy_route :        return ( in_mes );

\f


<*   timer not used
tim_route, tim_route1 (* from timeout *) :
begin
(*q if test then testout(z,"from timeout",0); q*)


(* case on opcode *)

receipt_mes( in_mes, rejected );         (*     ??????  *)

end (* from timeout *);
*>
\f



vci_route, vci_route1,
vca_route, vca_route1 (* from a vcc - of kind at *) :

begin
(* signal to sup *)

(* No check here. But this block is planned used, when
.  the following opcodes are met:
.  
.  0.2  3.1  3.2  3.4  3.5  4.0  8.1  8.3  8.4  9.1  10.3  10.5
.  1.2
.
*)

(*q if test then testout(z,"from a vcc  ",0); q*)

(*  supervision     *)
lock in_mes as head : alarmlabel do
with head do
begin
 where:= rec.macro;
 who:= rec.micro;
 find_vct_elm ( send.micro, result_code, vct_index);
end;

with vct(vct_index) do
 if state < down then  state:= ready;

if ( where = ts_addr )
  and ( who = vch_mic_addr ) then        (*  for me    *)
begin
 return ( in_mes);
end
else
signal(in_mes,sem( tssup_sem_no).s^);


end (* from a vcc *);

\f



netc_route1:       (*  to vch itself    *)

begin


(*q if test then testout(z,"to vch      ",in_mes^.u4); q*)

case in_mes^.u4 (* operation code *) of

(* 1.2 *) #h12 :
 return ( in_mes);

(* 2.x  *)
 #h20..#h29,
 #hc0 :
 signal ( in_mes, sem(vch_int1).s^);

(* 12.1  from help  *)
 #hc1:    ;

(* 7.0 *) #h70 :
begin
(* creation of a vcc_incanation *)
(*** yet, creation is only allowed for vc's of kind at ***)
(*** later we must remember to test on vc_kind ***)

lock in_mes as mes : alarm_form70 do
with mes do
begin
(* update vct *)

if (head.send.macro <> dc_addr) then
begin
 result_code:= unknown_sender;
(*q if test then testout(z,"7.0 bad <> :",head.send.macro.dc_addr); q*)
end
else
place_vct_elm( tail.vcc_mic, result_code, vct_index );

if result_code = accepted then
begin

(* make an unambiguous vcc_name *)

vcc_name := "vccon__     ";
vcc_nb := tail.vcc_mic;
alfa_pos := 9;

repeat
(*q if test then testout(z,"vcc_nb-part:",vcc_nb);
if test then testout(z,"alfa_pos   :",alfa_pos); q*)

vcc_name( alfa_pos ) := chr( vcc_nb mod 10 + ord( "0" ) );
vcc_nb := vcc_nb div 10;
alfa_pos := alfa_pos - 1;;
until  alfa_pos = 6;

(*  create and start the vcc_incarnation *)

(*q if test then testout(z,"creating vcc",vct_index); q*)

if tail.vc_kind = vcat then          (*  create vc at connector  *)
begin

 result_code:= link ( "vcatc       ", vcc)
  ;
result_code := create(
vcc_name,
vcc(
opsem,
sem( vct(vct_index).in_sem),
sem( vct(vct_index).in_sem + 1 ),
sem( vch_sem_no ).s,
(* <<<sem( lam_sem_no + tail.lam_nb ).s,   >>> *)
sem(vas_sem_no).s,
sem( timeout_sem_no ).s,
sem(com_pool).w,
 dc_addr,
 ts_addr,
tail.vcc_mic,
tail.port_nb
),
shad(vct( vct_index ).shix),
vac_size)
end
else
if tail.vc_kind = vcit then         (*  create vc it connector    *)
begin

 result_code:= link ( "vcitc       ", vcc )
 ;
result_code:= create (
 vcc_name,
 vcc (
  opsem,
  sem( vct(vct_index).in_sem),
  sem( vct(vct_index).in_sem+1),
  sem( vch_sem_no).s,
    (*  <<< sem ( lam_sem_no + tail.lam_nb).s,   >>> *)
  sem( vis_sem_no).s,
  sem( timeout_sem_no ).s,
  sem( com_pool).w,
  dc_addr,
  ts_addr,
  tail.vcc_mic,
  tail.port_nb
 ),
 shad(vct(vct_index).shix),
 vic_size)
end
 else
  result_code:= out_of_range;

if result_code = accepted then
start ( shad(vct(vct_index).shix), vcc_pri)
else
del_vct_elm( tail.vcc_mic, result_code );


(*q if test then testout(z,"create value",c); q*)
end (* if  *);
end (* lock - with *);

end (* creation of a vcc_incarnation *);
\f



#h74:        (*  remove a vcc   *)
begin
 
lock in_mes as mes : alarm_form74 do
with mes, head do
 if send.macro <> dc_addr then
  result_code:= unknown_sender
 else
  del_vct_elm ( vcc_addr, result_code)

end;


\f



(* 12.8 *) #hc8:       ;

(* 12.14 *) #hce:
begin
     (*  state:= down   broadcast vcc down    *)
 refuse ( in_mes, not_ready);
end
otherwise
  refuse ( in_mes, unknown_opcode)

end;   (*  case  *)

if not nil ( in_mes) then
 receipt_mes ( in_mes, result_code);

end;  (*  for vch  *)
\f



netc_route:
begin     (*  for a vcc   *)

 (*q  if test then testout ( z, "to a vcc    ", in_mes^.u4);  q*)

 vct_index:= 0;
 signal_to_vcc ( in_mes, vct_index)

end (* to a vcc *);
\f



otherwise (* not implemented - now used for change of testmode *)
begin
(*q test := not test;

if test then testout(z,"starttestout",0);
if not test then testout(z,"stop testout",0); q*)

refuse ( in_mes, unknown_route)

end (* otherwise *);


end (* case - upon routings information *);


until  false   (*  never stop  *)

end .     (* main program *)

(* end of file *)


«eof»
DataMuseum.dk

RC3500

⟦98d5193c9⟧ TextFileVerbose

Derivation

TextFileVerbose
