⟦69e2ffefb⟧

TextFileVerbose

process tsconnector(
tsconname: alfa;
semvector: system_vector;
var inputsem, tsssem, dcsem, lamsem, timeoutsem,
commandsem, listensem, outsem, dcoutsem, lamoutsem, timeoutanswer
: semaphore);
 
(********************************************************
*
*  function: this module establishes a connection between
*            two RC3502 machines in the demonstration
*            model
*
*  externals: process dc_module
*
*  var params: none
*
*  semaphores: the module receives messages on inputsem,
*              and sends messages aimed at:
*              timeoutmodule on timeoutsem,
*              lamdriver on lamsem,
*              dcmodule on dcsem
*
*  programmed june 1980 by stb and wib
*
*********************************************************)

const
version = "vers  1.17 /";


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

const
 
ts1name = "tsconnector " ;
ts2name = "ts2connector" ;
ts1port = 0;
ts2port = 0;

ownname  = ts1name;          (*  or ts2name  *)
tsc_port = ts1port;          (*  or ts2port  *)

\f




const
tsdatasize=16 (* no of bytes in data part of buffer from tss *);
tsbufsize= 32 (* no of bytes in buffer from tss *);
logsize= 64;  (* no of bytes in log-message *)
lambufsize= 80 (* no of bytes in buffer to lamdriver *);
con_lam_time= 2;
no_of_lamlis= 3;
no_of_dcbuf= 3; (* 3 of each type *)
idle= -5;
wd  = -4;
wrtr= -3;
wt  = -2;
wack= -1;
 

type
statetype= idle..wack;
inputtype= (enq, data, out, here, rnr, nak, ack, rtr, lto, tto, nons);
 
alloctype= array (1..64) of byte;

messagetype= (* message to/from tss *)
record
allabel: alarmlabel;
data: array (1..tsdatasize) of byte;
end;
 
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;
 
addresstype= (* format of 11.0-message *)
record
allabel: alarmlabel;
address: array (1..3) of macroaddr;
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  here rnr  nak  ack  rtr  lto  tto  nons *)
(*idle*)staterow(wd  ,idle,wrtr,idle,idle,idle,idle,idle,idle,idle,idle),
(*wd  *)staterow(wd  ,idle,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ,wd  ),
(*wrtr*)staterow(wt  ,wrtr,wrtr,wrtr,wt  ,wrtr,wrtr,wack,wrtr,wrtr,wrtr),
(*wt  *)staterow(wd  ,wt  ,wt  ,wt  ,wt  ,wt  ,wt  ,wt  ,wt  ,wrtr,wt  ),
(*wack*)staterow(wack,wack,wack,wack,wack,wack,idle,wack,wack,wack,wack));
 
actiontable=
actiontabletype(
(*                enq  data out  here rnr  nak  ack  rtr  lto  tto  nons *)
(*idle*)actionrow(  1,  10,   2,  14,  11,  11,  11,  11,   0,  15,  11),
(*wd  *)actionrow(  1,   3,   4,  14,  11,  11,  11,  11,  11,  15,   9),
(*wrtr*)actionrow(  7,  12,   4,  14,   5,  12,  12,   6,  12,  15,  12),
(*wt  *)actionrow(  1,  11,   4,  14,   0,  11,  11,  11,   0,  16,  11),
(*wack*)actionrow( 13,  13,   4,  14,  13,  13,   8,  13,  13,  15,  13));
 
tick1= 1; (* timeoutinterval for ts1 i.e. dcts *)
tick2= 5; (* timeoutinterval for ts2 *)
 
(* operation codes in protocol between tsconnectors *)
enqop= 0;
dataop= 1;
rtrop= 2;
rnrop= 3;
ackop= 4;
nakop= 5;
 

var
(*pools*)
dcpool:     pool (2*no_of_dcbuf) of alloctype (* messagetype *);
lampool:    pool (2+no_of_lamlis) of lambuftype;
updatepool: pool 1 of alloctype (* updates *);
timerpool:  pool 1 of timers (* messbuftype cf. testmodule*);
 
(*references*)
commandref,
crref,
dataref,
dcref,
lamref,
listenref,
msg,
tim: reference;
 
(*shadow variables*)
dcshadow: shadow;
 
(*zones*)
z: zone;
 
(*integers*)
action,
checklamlisten, (* how many listenbuffers to be checked after
recreation of lamchannel caused by output or input status error *)
dccreatevalue, (* result of createcall *)
i,
outputtec, (* transmission error count for lam output *)
tec (* transmission error count *): integer;
 
(*booleans*)
testboo,
todc: boolean;
 
(*other variables*)
state: statetype;
input: inputtype;
 
owntsmacro,
dcts_macro: macroaddr:= macroaddr(0,0,0);
 
(*external*)
process dc_module
(
dc_name: alfa;
semvector: system_vector;
var dcoutsem: semaphore
);
external;

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

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

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

 
function decodeinput (var ref: reference): inputtype;
(* decodes the inputtype of the buffer pointed to by "ref" *)
begin
case ref^.u3 of
 
tim_route: (* buffer from timeout *)
decodeinput:= tto;

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

0: lock ref 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:", ref^.u2);
decodeinput:= nons;
end
end (* case ref^.u2 *);
 
dc_route: (*buffer from dc_module*)
begin
if ref^.u4= 176 (* 11.0 *) then
 
lock ref as addr: addresstype do
with addr do
if address(1)= address(3) then
begin (* addr for this dcts *)
owntsmacro:= address(1);
dcts_macro:= address(1);
decodeinput:= here;
end
else (* addr to other ts *)
decodeinput:= out
 
else (* u4 <> 11.0 *)
 
lock ref as mess: messagetype do
begin
if (mess.allabel.rec.macro=owntsmacro)
then decodeinput:= here (*to own tss*)
else
begin
decodeinput:= out;
ref^.u4:= mess.allabel.op_code;
end;
end
end;
 
otherwise (* buffer from tssupervisor*)
if owntsmacro <> dcts_macro
then decodeinput:= out
else
lock ref as mess: messagetype do
if (mess.allabel.rec.macro.nc_addr= 0) 
or (mess.allabel.rec.macro=owntsmacro)
then decodeinput:= here (*to own dc_module*)
else decodeinput:= out;
 
end (* case ref^.u3 *)
end;
\f

 
procedure getcommand;
(* gets the next commandbuffer. Listen buffers arriving in the
meantime are sent to listensem *)
(* equivalent to getlisten *)
begin


while not open (commandsem) do
getinputbuf;
wait (commandref, commandsem)
end;
 
\f

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

begin
 

repeat
statuserror:= false;

if (state= idle) and open (outsem) then
begin
wait (commandref, outsem);
getinput:= out
end
else
begin
getcommand;
getinput:= decodeinput (commandref)
end;
 
if commandref^.u3= lam_route then
begin (* listenbuffer 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 (commandref^.u2=1) or (commandref^.u2=3) then
begin (* listenbuffer returned by createchannel *)
statuserror:= true;
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
end
end (* checklamlisten *)

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

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

statuserror:= true;
if (commandref^.u2=1) or (commandref^.u2=3) then
(* lamchannel recreated caused by listenbuffer -
outputbuffer and other listenbuffers are to be checked *)
begin
wait (lamref, lamoutsem);
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: *)
commandref^.u2:= tsc_port;
signal (commandref, lamsem)
end (* status error in lamlistenbuffer *)

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

\f

\f

 
procedure getinputbuf;
(* gets a buffer from the inputsem and sends it to either
commandsem or listensem *)
var inputref: reference;
begin


wait (inputref, inputsem);
if (inputref^.u3= netc_route1) and
(inputref^.u4= 197 (*listenbuffer*))
then signal (inputref, listensem)
else signal (inputref, commandsem)
end;
\f

 
procedure getlisten;
(* waits until a listenbuffer arrives. Other buffertypes arriving
in the meantime are sent to the commandsem *)
begin
while not open (listensem) do
getinputbuf;
wait (listenref, listensem)
end;
\f

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

begin


wait (lamref, lamoutsem);
 
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);
wait (lamref, lamoutsem)
end (* while status error *);
 
(* now construct lambuffer *)
if opcode= dataop
then
(* copy commandbuffer onto lambuffer *)
lock lamref as lambuf: lambuftype do

if (dataref^.u4=0) and (dataref^.u3<>dc_route) 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,"            ",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(9):= 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,"            ",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(9):= 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):= opcode;
data(1):= ord (etx);
end;

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

if not nil (commandref) then
case commandref^.u3 of
tim_route: ;
lam_route:
begin
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
end;
dc_route:
begin
commandref^.u4:=0;
signal (commandref, dcsem);
end;
otherwise return (commandref);
end;
end;
\f

 
procedure sendtotss;
(* copies listenbuffer from lamdriver onto listenbuffer from tss
and returns tss listenbuffer *)

begin
getlisten;

(* copy lambuffer onto listenbuffer from tss *)
lock listenref as mess: tsbuftype do
lock commandref as lambuf: lambuftype 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);
listenref^.u2:= 1;
listenref^.u4:= data(9) (* op_code*);
end;
 
if listenref^.u4= 176 (* 11.0 *) then
begin
(* initialise ts macroaddresses *)
lock listenref as addr: addresstype do
with addr do
begin
owntsmacro:= address(1);
dcts_macro:= address(3);
allabel.rec:= alarmnetaddr (macroaddr (0,0,0), 0);
(* zero_address demanded from tss *)
end;
 
(* change lamtimeout period *)
wait (lamref, lamoutsem);
createchn (con_lam_time+1);
signal (lamref,lamoutsem);
checklamlisten:= no_of_lamlis;
 
end;

signal (listenref, tsssem);
commandref^.u2:= tsc_port;
signal (commandref, lamsem) (* listenbuffer to lam *)
end;
\f

 
procedure sendtodc;
(* copies listenbuffer from lamdriver onto dcoutputbuffer
and signals it to dc *)

begin
wait (dcref, dcoutsem);

(* copy lambuffer onto dcoutputbuffer *)
lock commandref as lambuf: lambuftype do
 
if lambuf.data(9)= 0 (* log-message *) 
then
lock dcref 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);
dcref^.u2:= 1;
dcref^.u4:= data(9) (* op_code *);
end
else 
lock dcref 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);
dcref^.u2:= 1;
dcref^.u4:= data(9) (*op_code*);
end;

signal (dcref, dcsem);
commandref^.u2:= tsc_port;
signal (commandref, lamsem) (*listenbuffer to lam*)
end;
\f


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

 
procedure to_tss_or_dc;
begin
if commandref^.u4= 176 (* 11.0 *)
then (* initialise macroaddresses *)
sendtotss
else
 
if owntsmacro<> dcts_macro
then sendtotss
else
begin
lock commandref as lambuf: lambuftype do
with lambuf do
if (data(1) = (dcts_macro.dc_addr * 16))
and (data(2) = 0)
(* i.e. if receiver = dc_module *)
then todc:= true
else todc:= false;
if todc
then sendtodc
else sendtotss
end;
end;
\f

 
procedure sendlocal;
begin
 
if (commandref^.u4=0) and (commandref^.u3<>dc_route)
(* log-message to dc *)
then
lock commandref as mess: logtype do
begin
wait (dcref, dcoutsem);
lock dcref as dcmess: logtype do
dcmess:= mess;
dcref^.u2:= 1;
dcref^.u4:= commandref^.u4;
signal (dcref, dcsem);
end
 
else

lock commandref as mess: messagetype do
if mess.allabel.rec.macro.nc_addr = 0
then (* send buffer to dc *)
begin
wait (dcref, dcoutsem);
lock dcref as dcmess: messagetype do
dcmess:= mess;
dcref^.u2:= 1;
dcref^.u4:= commandref^.u4;
signal (dcref, dcsem);
end

else
begin (*send buffer to tss*)
if nil (listenref) then getlisten;
lock listenref as tsmess: messagetype do
tsmess:= mess;
 
if commandref^.u4= 176 (* 11.0 *)
then (* receiver:= 0 *)
lock listenref as addr: addresstype do
addr.allabel.rec:= alarmnetaddr (macroaddr (0,0,0), 0);

listenref^.u2:= 1;
listenref^.u4:= mess.allabel.op_code;
signal (listenref, tsssem);
end;
 
if commandref^.u3=dc_route
then (* listenbuffer to dc *)
begin
commandref^.u4:= 0;
signal (commandref, dcsem)
end
else (* buffer from tss *)
return (commandref);
end (*sendlocal*);
\f

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

 
begin
testboo:= false;
state:= idle;
tec:= 0;
outputtec:= 0;
testopen (z, ownname, semvector(operatorsem));
testout(z,version,al_env_version);
 
 
(* create channel *)
alloc (crref, lampool, lamoutsem);
createchn (con_lam_time);

checklamlisten:= 0;
 
(* initialise lamlistenbuffers *)
for i:= 1 to no_of_lamlis do
begin
alloc (lamref, lampool, inputsem);
lamref^.u1:= read_it; (* input *)
lamref^.u2:= tsc_port;
lamref^.u3:= lam_route;
signal (lamref, lamsem);
end;
 
(* initialise lamoutputbuffer *)
alloc (lamref, lampool, lamoutsem);
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 (tim, timerpool, inputsem);
alloc (msg, updatepool, timeoutanswer);
msg^.u3:= tim_route;
timerbook (msg, tim, -1, netc_mic_addr, timeoutsem, timeoutanswer);
 
for i:= 1 to no_of_dcbuf do
begin
(* initialise dclistenbuffer *)
alloc (dcref, dcpool, inputsem);
dcref^.u1:= 1 (* read from dc *);
dcref^.u3:= dc_route;
dcref^.u4:= 0;
lock dcref as mess: messagetype do
mess.allabel.no_of_by:= 0;
signal (dcref, dcsem);
 
(* initialise dcoutputbuffer *)
alloc (dcref, dcpool, dcoutsem);
dcref^.u1:= 2 (* write *);
dcref^.u3:= dc_route;
return (dcref);
end;
 



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

 
repeat
 
(*//////////////////////////////////////////////////////////
case state of
idle: testwrite("idle        ",1);
wd:   testwrite("wd          ",1);
wrtr: testwrite("wrtr        ",1);
wt:   testwrite("wt          ",1);
wack: testwrite("wack        ",1)
end;
//////////////////////////////////////////////////////////*)

input:= getinput;
 
case input of
enq : testwrite("enq         ",state);
data: testwrite("data        ",state);
out : testwrite("out         ",state);
here: testwrite("here        ",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;
 
action:= actiontable(state, input);
 
case action of 

0: (*no action *)
begin
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
end;

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

2: (*send enq*)
begin
dataref:=: commandref;
sendop (enqop);
end;

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

4: (*output to outsem*)
signal (commandref, outsem);

5: (*send update to timer*)
begin
if owntsmacro= dcts_macro
then timerupdate (msg, tick1, timeoutsem, timeoutanswer)
else timerupdate (msg, tick2, timeoutsem, timeoutanswer);
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
end;

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

7: (*send rnr and update timer*)
begin
sendop (rnrop);
if owntsmacro= dcts_macro
then timerupdate (msg, tick1, timeoutsem, timeoutanswer)
else timerupdate (msg, tick2, timeoutsem, timeoutanswer)
end;

8: (*no action*)
begin
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
 
if dataref^.u3= dc_route
then (* listenbuffer from dc_module *)
begin
dataref^.u4:= 0;
signal (dataref, dcsem)
end
else (* outputbuffer from tss *)
return (dataref);
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
tec:= tec + 1;
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
end;

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

13: (*transm. error - send data*)
begin
tec:= tec + 1;
sendop (dataop);
end;
 
14: (*send data to local module*)
sendlocal;
 
15:
begin
tim:=: commandref;
timerbook (msg, tim, -1, netc_mic_addr, timeoutsem, timeoutanswer);
end;
 
16: (*timerbook and send enq*)
begin
tim:=: commandref;
timerbook (msg, tim, -1, netc_mic_addr, timeoutsem, timeoutanswer);
sendop (enqop);
end;
 
end (* case *);
 
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

⟦69e2ffefb⟧ TextFileVerbose

Derivation

TextFileVerbose
