⟦10feb39e1⟧

TextFileVerbose

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


process tsconnector(
opsem : sempointer;              (*  operator sem        *)
var supsem,                      (*  ts supervisor sem   *)
dcsem,                           (*  to dc               *)
lamsem,                          (*  to lam              *)
timeoutsem,                      (*  to timeout          *)
listensem :    !sempointer;      (*  buffer pool         *)
var mainsem,                     (*  my mainsem          *)
outsem,                          (*  transfer queue      *)
myfree,                          (*  my free buffers     *)
unused,                           (*  may be removed      *)
lamoutsem,                       (*  from lam            *)
timeoutanswer : !ts_pointer );   (*  from timeout        *)

(********************************************************
*
*  function: this module establishes a connection between
*            two RC3502 machines in the demonstration
*            model
*
*  semaphores: the module receives messages on mainsem,
*              and sends messages aimed at:
*              timeoutmodule on timeoutsem,
*              lamdriver on lamsem,
*              supervisor on supsem
*              dcmodule on dcsem
*
*  programmed june 1980 by stb and wib
*
*********************************************************)

(*-------------------------- configuration ----------------------------*)

const
 
version = "vers  2.09 /";
ts1name = "tsconnector " ;
ts2name = "ts2connector" ;
ts1port = 0;
ts2port = 4;
ownname  = ts1name;          (*  or ts2name  *)
tsc_port = ts1port;          (*  or ts2port  *)
\f




const
tsdatasize=size_listen*2 - label_size - 2;  (*  no of bytes in data part of buffer from tss *)
tsbufsize= size_listen*2; (* no of bytes in buffer from tss *)
logsize= size_supp*2;  (* no of bytes in log-message *)
lambufsize= 80 (* no of bytes in buffer to lamdriver *);
con_lam_time= 20;
ttcmax = 7;    (*  max transmis. errors pr message      *)
no_of_lamlis= 3;
no_of_mybuf= 3; (* 3 of each type *)
idle= -5;
wd  = -4;
wrtr= -3;
wt  = -2;
wack= -1;

tablesize = 4;
opco = 9;           (*  index in data  *)
logcode = #h00;     (*  opcode 0.0     *)
newaddr_code = #hb1;(*  opcode 11.1    *)
nc_route = 13;

type
statetype= idle..wack;
inputtype= (enq, data, out, rnr, nak, ack, rtr, lto, tto, nons);
 
modulref = ( sup, ncs, dcs, net);
tablerange = 1..tablesize;
macrotable = array ( tablerange) of macroaddr;
modultable = array ( tablerange) of modulref;
 
tsbuftype= (* message to/from tss *)
record
bll: integer;
data: array (1..tsbufsize-2) of byte;
end;
 
logtype= 
record
bll: integer;
data: array (1..logsize-2) of byte;
end;
 
lambuftype= (* message to/from lamdriver *)
packed record
stxt,
bll: byte;
data: array (0..lambufsize-3) of byte; 
end;

createchtype= (* message format in createchannel operation *)
record
controlinfo, timeout: byte;
end;
 
staterow= array (inputtype) of statetype;
statetabletype= array (statetype) of staterow;
 
actionrow= array (inputtype) of integer;
actiontabletype= array (statetype) of actionrow;
 
const
statetable=
statetabletype(
(*               enq  data out  rnr  nak  ack  rtr  lto  tto  nons *)
(*idle*)staterow(wd  ,idle,wrtr,idle,idle,idle,idle,idle,idle,idle),
(*wd  *)staterow(wd  ,idle,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ),
(*wrtr*)staterow(wt  ,wrtr,wrtr,wt  ,wrtr,wrtr,wack,wrtr,wrtr,wrtr),
(*wt  *)staterow(wd  ,wt  ,wt  ,wt  ,wt  ,wt  ,wt  ,wt  ,wrtr,wt  ),
(*wack*)staterow(wack,wack,wack,wack,wack,idle,wack,wack,wack,wack));
 
actiontable=
actiontabletype(
(*                enq  data out  rnr  nak  ack  rtr  lto  tto  nons *)
(*idle*)actionrow(  1,  10,   2,  11,  11,  11,  11,   0,  15,  11),
(*wd  *)actionrow(  1,   3,   4,  11,  11,  11,  11,  11,  15,   9),
(*wrtr*)actionrow(  7,  12,   4,   5,  12,  12,   6,  12,  15,  12),
(*wt  *)actionrow(  1,  11,   4,   0,  11,  11,  11,   0,  16,  11),
(*wack*)actionrow( 13,  13,   4,  13,  13,   8,  13,  13,  15,  13));
 
tick1= 1; (* timeoutinterval for ts1 i.e. ts with dc *)
tick2= 5; (* timeoutinterval for ts2 *)
 
(* operation codes in protocol between tsconnectors *)
enqop= 0;
dataop= 1;
rtrop= 2;
rnrop= 3;
ackop= 4;
nakop= 5;
\f

 

var
(*pools*)
mypool:     pool (2*no_of_mybuf) of logtype (* messagetype *);
lampool:    pool (2+no_of_lamlis) of lambuftype;
updatepool: pool 1 of updates (* updates *);
timerpool:  pool 1 of timers (* messbuftype cf. testmodule*);
 
(*references*)
crref,
dataref,
myref,
lamref,
tmomes,
msg: reference;
 
z: zone;
 
(*integers*)
action,
checklamlisten, (* how many listenbuffers to be checked after
recreation of lamchannel caused by output or input status error *)
i,
outputtec,      (* transmission error count for lam output *)
ttc,            (*  transmission error count pr message  *)
tec : integer := 0;  (*  transmis. error count  *)

mytick: integer:= tick2;       (*  tick1 or tick2   *)
 
(*booleans*)
testboo : boolean;

reply : byte;
 
(*other variables*)
state: statetype;
input: inputtype;
 
(*------------------------ routing --------------------------------*)

ix, top : tablerange:= 1;
m: macroaddr;
node : macrotable := macrotable(tablesize***macroaddr(0,0,0));
modul: modultable := modultable(tablesize*** net );
 
\f


(*forward*)
 
procedure testwrite (a:alfa; i:integer);
forward;
\f

 
(*  wait, with return of dummy messages         *)

procedure tswait ( var msg: reference;  var sp: sempointer );

begin

wait ( msg, sp^);

while msg^.u3 = dummy_route do
begin
return ( msg);
wait ( msg, sp^)
end;

end;

\f


procedure createchn (timeoutper: integer);
(* creates lamchannel *)
begin
repeat
crref^.u1:= create_it_ch;
crref^.u2:= tsc_port;
crref^.u3:= lam_route;
lock crref as crbuf: createchtype do
begin
crbuf.controlinfo:= ts_control;
crbuf.timeout:= timeoutper;
end;
 
signal (crref, lamsem^);
tswait (crref, lamoutsem.w);
if crref^.u2 <> 0
then (* error *)
testwrite ("createch u2:", crref^.u2);

until crref^.u2= 0;
 
end; (* createchn *)
\f

 
procedure sendlam;

begin

msg^.u2:= tsc_port;
signal ( msg, lamsem^)

end;

\f


procedure route_local ( var msg : reference );
(*
    route message from other node
    or message not transmitted.
*)
begin
lock msg as head: alarmlabel do m:= head.rec.macro;
node(top):= m;
ix:= 1;
while node(ix) <> m do ix:= ix+1;
(*q  testout ( z, "local to    ", ix);   q*)

msg^.u1:= 2;
msg^.u3:= netc_route;
case modul(ix) of
dcs:  signal ( msg, dcsem^);
(*
ncs:  signal ( msg, ncsem^);
*)
otherwise  signal ( msg, supsem^)
end

end;

\f


function decodeinput : inputtype;
(*
   get buffer from mainsem;
   if ts-message to dc or sup then signal
   else decode inputtype
*)
begin

repeat
tswait ( msg, mainsem.w);

case msg^.u3 of
 
tim_route: (* buffer from timeout *)
decodeinput:= tto;

lam_route: (* buffer from lam_driver *)
case msg^.u2 of

0: lock msg as lambuf: lambuftype do
case lambuf.data(0) (*opc*) of
enqop : decodeinput:= enq;
dataop: decodeinput:= data;
rtrop : decodeinput:= rtr;
rnrop : decodeinput:= rnr;
ackop : decodeinput:= ack;
nakop : decodeinput:= nak;
otherwise decodeinput:= nons
end (* case lambuf.opc *);
 
5: (* input timeout *)
decodeinput:= lto;

otherwise
begin
(*error*)
testwrite ("lamresultu2:", msg^.u2);
decodeinput:= nons;
end
end (* case lammsg^.u2 *);
 
otherwise           (*  from dc or sup    *)
begin               (*  ts message        *)

if msg^.u4 = newaddr_code then     (*  change routetables    *)
lock msg as head: alarmlabel do
begin
if msg^.u3 = dc_route then
begin
mytick:= tick1;    (*  i have a dc    *)
modul(top):= dcs
end  else
if msg^.u3 = nc_route then modul(top):= ncs  else
modul(top):= sup;

ix:= 1;
while modul(ix) <> modul(top) do ix:= ix+1;

node(ix):= head.send.macro;
if ix = top then top:= top+1;
(*q  testout ( z,"change      ", ix);   q*)
end;  (*  opcode 11.1   *)

lock msg as head: alarmlabel do  m:= head.rec.macro;
modul(top):= net;
node(top):= m;
ix:= 1;
while node(ix) <> m do ix:= ix+1;
(*q  testout ( z,"found in    ", ix);   q*)

msg^.u3:= netc_route;
case modul(ix) of
sup:  signal ( msg, supsem^);
(*
ncs:  signal ( msg, ncsem^);
*)
dcs:  signal ( msg, dcsem^);

otherwise
decodeinput:= out
end

end   (*  ts message  *)
end   (*  case u3   *)

until  not nil (msg)

end;   (*  of decodeinput  *)
 
\f

 
function getinput: inputtype;
(* gets the next buffer to handle. The buffer is taken from either
mainsem or outsem depending on the state and the semaphores *)
var statuserror: boolean;

begin
 

repeat
statuserror:= false;

if (state= idle) and open (outsem.w^) then
begin
tswait (msg, outsem.w);
getinput:= out
end
else
getinput:= decodeinput;
 
if msg^.u3= lam_route then
begin (* listenbuffer with answer from lam_driver *)

if (checklamlisten>0) then
(* lamchannel recreated caused by outputbuffer or listenbuffer -
listenbuffers are to be checked while outputbuffer has been 
checked already *)
begin
checklamlisten:= checklamlisten-1;
if (msg^.u2=1) or (msg^.u2=3) then
begin (* listenbuffer returned by createchannel *)
statuserror:= true;
sendlam;
end
end (* checklamlisten *)

else
if not (msg^.u2 in (.0,5.)) then
(* status error in lamlistenbuffer *)
begin

testwrite("lam status: ",msg^.u2);

statuserror:= true;
if (msg^.u2=1) or (msg^.u2=3) then
(* lamchannel recreated caused by listenbuffer -
outputbuffer and other listenbuffers are to be checked *)
begin
wait (lamref, lamoutsem.w^);
if (lamref^.u2=1) or (lamref^.u2=3) 
then (* outputbuffer returned *)
begin
lamref^.u2:= tsc_port;
signal (lamref, lamsem^)
end
else return (lamref);
checklamlisten:= no_of_lamlis-1;
end;

(* try again: *)
sendlam;
end (* status error in lamlistenbuffer *)

end (* listenbuffer from lamdriver *)
 
until not statuserror;
 
end (* getinput *);
\f

 
procedure sendop (transcode: byte);
(* gets and fills in lamoutputbuffer, sends it to lamdriver *)

begin


tswait (lamref, lamoutsem.w);
 
while lamref^.u2> 0 (* status error *) do
begin
case lamref^.u2 of
1,3: (* channel recreated by driver *)
begin
testwrite ("lamch create", lamref^.u2);
checklamlisten:= no_of_lamlis;
(* listenbuffers might have been returned upon recreation *)
end;
 
4,5: testwrite ("lamresult:  ",lamref^.u2)

otherwise
begin
outputtec:= outputtec + 1;
if outputtec mod 10 = 0 then
testwrite ("lamerrorout:", outputtec);
if outputtec>10000 then outputtec:= 0;
end;
end (* case lamref^.u2 *);
 
(* try last output again: *)
lamref^.u2:= tsc_port;
signal (lamref, lamsem^);
tswait (lamref, lamoutsem.w)
end (* while status error *);
 
(* now compose lambuffer *)
if transcode= dataop
then
(* copy message onto lambuffer *)
lock lamref as lambuf: lambuftype do

if dataref^.u4 = logcode then
(* logmessage to dc *)
lock dataref as mess: logtype do
with lambuf do
begin
if (mess.bll<=0) or (mess.bll>logsize-2) then
begin
testout(z,"no_of_bytes:",mess.bll);
testout(z,"u1:         ",dataref^.u1);
testout(z,"u2:         ",dataref^.u2);
testout(z,"u3:         ",dataref^.u3);
testout(z,"u4:         ",dataref^.u4);
for i:= 1 to 10 do 
testout(z,"            ",mess.data(i));
end;

if (mess.bll<0) or (mess.bll>(logsize-2)) 
then bll:= logsize
else bll:= mess.bll+2;
data(0) (*opc*) := dataop;
for i:= 1 to (bll-2) do
data(i):= mess.data(i);
data(opco):= dataref^.u4; (* op_code *)
data(bll-1):= ord(etx);
end (* logmessage to dc *)
 
else (* message to dc *)
lock dataref as mess: tsbuftype do
with lambuf do
begin
if (mess.bll<=0) or (mess.bll>(tsbufsize-2)) then
begin
testout(z,"no_of_bytes:",mess.bll);
testout(z,"u3:         ",dataref^.u3);
for i:= 1 to 10 do
testout(z,"            ",mess.data(i));
end;
 
if (mess.bll<0) or (mess.bll>(tsbufsize-2)) 
then bll:= tsbufsize
else bll:= mess.bll+2;
data(0) (*opc*):= dataop;
for i:= 1 to (bll-2) do
data(i):= mess.data(i);
data(opco):= dataref^.u4; (* op_code *)
data(bll-1):= ord(etx);
end (* opcode=dataop *)
 
else
lock lamref as lambuf: lambuftype do
with lambuf do
begin
bll:= 2;
data(0):= transcode;
data(1):= ord (etx);
end;

(* now send lambuffer *)
lamref^.u2:= tsc_port;
signal (lamref, lamsem^);

if not nil (msg) then
case msg^.u3 of
tim_route:  ;

lam_route:  sendlam;

dc_route:
begin
testout ( z, "skip msg    ", msg^.u3);
testout ( z, "opcode      ", msg^.u4);
return ( msg);
end;

otherwise return (msg);
end;
end;
\f

 
procedure accept_message ( var reply: byte );
(* copies listenbuffer from lamdriver onto ts-buffer
and signals it to dc or supervisor *)

begin

(* copy lambuffer onto ts buffer *)
lock msg as lambuf: lambuftype do
 
if lambuf.data(opco)= logcode (* log-message *) 
then
begin
sensesem ( myref, myfree.w^);
if not nil ( myref) then
lock myref as mess: logtype do
with lambuf do
begin
mess.bll:= bll-2;
if mess.bll>logsize-2 
then mess.bll:= logsize-2;
if mess.bll<0
then mess.bll:= 0;
for i:= 1 to mess.bll do
mess.data(i):= data(i);
myref^.u4:= data(opco) (* op_code *);
end
end
else
begin
sensesem ( myref, listensem^);
if nil ( myref) then sensesem ( myref, myfree.w^);
if not nil ( myref) then
lock myref as mess: tsbuftype do
with lambuf do
begin
mess.bll:= bll - 2;
if mess.bll>tsbufsize-2
then mess.bll:= tsbufsize-2;
if mess.bll<0
then mess.bll:= 0;
for i:= 1 to mess.bll do
mess.data(i):= data(i);
myref^.u4:= data(opco) (*op_code*);
end
end;

if nil ( myref) then     (*  no free buffer for the received data  *)
reply:= nakop
else
begin   (*  data is in myref,  send to dc or sup   *)
reply:= ackop;
route_local ( myref);
end;

end;  (*  of accept message  *)

\f


procedure testwrite (a:alfa; i:integer);
begin
if testboo then
testout (z,a,i)
end (* testwrite *);
\f

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

 
begin
testboo:= false;
state:= idle;
testopen (z, own.incname, opsem);
testout(z,version,al_env_version);
 
(* create channel *)
alloc (crref, lampool, lamoutsem.s^);
createchn (con_lam_time);

(*  checklamlisten:= 0;   *)
 
(* initialise lamlistenbuffers *)
for i:= 1 to no_of_lamlis do
begin
alloc (lamref, lampool, mainsem.s^);
lamref^.u1:= read_it; (* input *)
lamref^.u2:= tsc_port;
lamref^.u3:= lam_route;
signal (lamref, lamsem^);
end;
 
(* initialise lamoutputbuffer *)
alloc (lamref, lampool, lamoutsem.s^);
lamref^.u1:= write_it; (* output *)
lamref^.u2:= 0;
lamref^.u3:= lam_route;
lock lamref as lambuf: lambuftype do
lambuf.stxt:= ord(stx);
return (lamref);
 
(* initialise timeout *)
alloc (msg, timerpool, mainsem.s^);
alloc (tmomes, updatepool, timeoutanswer.s^);
tmomes^.u3:= tim_route;
timerbook (tmomes, msg, -1, netc_mic_addr, timeoutsem^, timeoutanswer.w^);
 
for i:= 1 to no_of_mybuf do
begin
 
(* initialise myoutputbuffer *)
alloc (myref, mypool, myfree.s^);
myref^.u1:= 2 (* write *);
myref^.u3:= dc_route;
return (myref);
end;
 

\f



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

 
repeat

input:= getinput;
action:= actiontable(state, input);
 
(*//////////////////////////////////////////////////////////
case state of
idle: testwrite("idle        ", action);
wd:   testwrite("wd          ", action);
wrtr: testwrite("wrtr        ", action);
wt:   testwrite("wt          ", action);
wack: testwrite("wack        ", action)
end;
//////////////////////////////////////////////////////////*)
(*
case input of
enq : testwrite("enq         ",state);
data: testwrite("data        ",state);
out : testwrite("out         ",state);
rnr : testwrite("rnr         ",state);
nak : testwrite("nak         ",state);
ack : testwrite("ack         ",state);
rtr : testwrite("rtr         ",state);
lto : testwrite("lto         ",state);
tto : testwrite("tto         ",state);
nons: testwrite("nons        ",state)
end;
 
*)
 
case action of 

0: (*no action *)
sendlam;

1: (*send rtr*)
sendop (rtrop);

2: (*send enq*)
begin
dataref:=: msg;
sendop (enqop);
ttc:= 0;   (*  1st try  *)
end;

3: (*send ack to lam and data to tss or dc*)
begin
accept_message ( reply);
sendop ( reply);
end;

4: (*output to outsem*)
signal (msg, outsem.s^);

5: (*send update to timer*)
begin
timerupdate (tmomes, mytick, timeoutsem^, timeoutanswer.w^);
sendlam;
end;

6: (*send data*)
sendop (dataop);

7: (*send rnr and update timer*)
begin
sendop (rnrop);
timerupdate (tmomes, mytick, timeoutsem^, timeoutanswer.w^)
end;

8: (*  data acknogled  *)
begin
sendlam;
return (dataref);
ttc:= 0;
end;

9: (*send nak*)
begin
tec:= tec + 1;
sendop (nakop);
end;

10: (*send ack*)
begin
tec:= tec + 1;
sendop (ackop);
end;

11: (*transmission error*)
begin
ttc:= ttc+1;
tec:= tec + 1;
sendlam;
end;

12: (* transm. error - send enq *)
begin
ttc:= ttc + 1;
tec:= tec + 1;
sendop (enqop);
end;

13: (*transm. error - send data*)
begin
ttc:= ttc + 1;
tec:= tec + 1;
sendop (dataop);
end;
 
14: (*send data to local module*)
(*  done in decode input   *)   ;
 
15:
timerbook (tmomes, msg, -1, netc_mic_addr, timeoutsem^, timeoutanswer.w^);
 
16: (*timerbook and send enq*)
begin
timerbook (tmomes, msg, -1, netc_mic_addr, timeoutsem^, timeoutanswer.w^);
sendop (enqop);
end;
 
end (* case *);

if ttc > ttcmax then                    (*  give up   *)
begin
if not nil ( dataref) then
begin
lock dataref as head: alarmlabel do
with head do
begin
rec:= send;
result:= no_connection
end;
route_local ( dataref)
end;
ttc:= 0;
state:= idle
end
else
state:= statetable (state, input);
 
if outputtec>=10000 then outputtec:= 0;
if tec>= 100 then
begin
testwrite ("transm error",tec);
tec:= 0;
end;

until false;
 
end.
«eof»
DataMuseum.dk

RC3500

⟦10feb39e1⟧ TextFileVerbose

Derivation

TextFileVerbose
