⟦1f8d93f5f⟧

TextFileVerbose

process ts2connect(
tsconname: alfa;
semvector: system_vector;
var inputsem, tsssem, dcsem, lamsem, timeoutsem
: 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.02 /";

\f




const
tsc_port = 1;
con_lam_time = 60;   (* overrules alarm_environment. to be removed ***)
tsdatasize=16(*egl.48*) (* no of bytes in data part of buffer from tss *);
tsbufsize= 32(*egl.64*) (* no of bytes in buffer from tss *);
lambufsize= 260 (* no of bytes in buffer to lamdriver *);
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);
 
messbuftype= array (1..16(*egl.50*)) of integer;

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;
 
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  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;
 
ts1_macro= macroaddr(7,9,13);
ts2_macro= macroaddr(7,9,14);
dcts_macro= macroaddr(7,9,13);


var
(*pools*)
dcpool:     pool 2 of messagetype (* messbuftype cf. testmodule*);
lampool:    pool 2 of lambuftype;
updatepool: pool 1 of updates (* messbuftype cf. testmodule*);
timerpool:  pool 1 of timers (* messbuftype cf. testmodule*);
 
(*semaphores*)
listensem,
commandsem,
dcoutsem,
lamoutsem,
outsem,
timeoutanswer: semaphore;
 
(*references*)
commandref,
dataref,
dcref,
lamref,
listenref,
msg,
tim: reference;
 
(*shadow variables*)
dcshadow: shadow;
 
(*zones*)
z: zone;
 
(*integers*)
action,
dccreatevalue, (* result of createcall *)
i,
outputtec, (* transmission error count for lam output *)
tec (* transmission error count *): integer;
 
(*booleans*)
testboo,
todc,
checklamlisten: boolean; (* in normal case false; becomes true
after recreation of lamchannel caused by output status error *)
 
(*other variables*)
state: statetype;
input: inputtype;
owntsmacro: macroaddr; (*initialised in start of main*)
 
(*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


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
owntsmacro:= dcts_macro;
lock ref as mess: messagetype do
begin
if (mess.allabel.rec.macro=owntsmacro)
then decodeinput:= here (*to own tss*)
else decodeinput:= out;
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 (not open (commandsem)) and open (outsem)
and (state= idle) 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 (* lamchannel recreated *) then
begin
checklamlisten:= false;
if 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= 3 then
(* lamchannel recreated - check if outputbuffer has been
returned by createchannel *)
begin
wait (lamref, lamoutsem);
if lamref^.u2 = 3
then (* outputbuffer returned *)
begin
lamref^.u2:= tsc_port;
signal (lamref, lamsem)
end
else return (lamref)
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

 
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: integer);
(* gets and fills in lamoutputbuffer, sends it to lamdriver *)

begin

case opcode of
0: testwrite("send enq    ",0);
1: testwrite("send data   ",0);
2: testwrite("send rtr    ",0);
3: testwrite("send rnr    ",0);
4: testwrite("send ack    ",0);
5: testwrite("send nak    ",0)
otherwise
testwrite("send op nr: ",opcode);
end (* case opcode *);


wait (lamref, lamoutsem);
 
while lamref^.u2> 0 (* status error *) do
begin
case lamref^.u2 of
3: (* channel recreated by driver *)
begin
testwrite ("lamch create", lamref^.u2);
checklamlisten:= true;
(* listenbuffer might have been returned upon recreation *)
end;
 
1,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
lock dataref as mess: tsbuftype do
with lambuf do
begin
bll:= (mess.bll+2) mod 256;
data(0) (*opc*):= dataop;
for i:= 1 to (mess.bll mod (tsbufsize-1)) do
data(i):= mess.data(i);
data(9):= dataref^.u4; (* op_code *)
data(mess.bll+1):= ord (etx);
data(mess.bll+2):= 0 (*crc*);
data(mess.bll+3):= 0 (*crc*);
end (* opcode=dataop *)
 
else
lock lamref as lambuf: lambuftype do
with lambuf do
begin
bll:= 2;
data(0):= opcode;
data(1):= ord (etx);
data(2):= 0 (*crc*);
data(3):= 0 (*crc*);
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:  signal (commandref, dcsem);
otherwise return (commandref);
end;
testwrite ("sendop finis",opcode);
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;

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 dcref 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);
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 owntsmacro<> dcts_macro
then sendtotss
else
begin
lock commandref as lambuf: lambuftype do
with lambuf do
if (data(1) mod 256)> 127
then todc:= false
else
if ((data(1)mod 256)*256 + (data(2)div 256)) = 28672
(* i.e. if receiver = dc_module *)
then todc:= true
else todc:= false;
if todc
then sendtodc
else sendtotss
end;
end;
\f

 
procedure sendlocal;
begin
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;
listenref^.u2:= 1;
listenref^.u4:= commandref^.u4;
signal (listenref, tsssem);
end;
 
if commandref^.u3=dc_route
then (* listenbuffer to dc *)
signal (commandref, dcsem)
else (* buffer from tss *)
return (commandref);
end (*sendlocal*);
\f

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

 
begin
platoninit;
testboo:= true;
state:= idle;
owntsmacro:= ts2_macro;
tec:= 0;
outputtec:= 0;
testopen (z,"ts2connector",semvector(operatorsem));
testout(z,version,al_env_version);
 

(* create channel *)
alloc (lamref, lampool, lamoutsem);

repeat
lamref^.u1:= create_it_ch;
lamref^.u2:= tsc_port;
lock lamref as lambuf: createchtype do
begin
lambuf.controlinfo:= ts_control;
lambuf.timeout:= con_lam_time
end;
signal (lamref, lamsem);
testwrite("wait lamouts",0);
wait (lamref, lamoutsem);
if lamref^.u2 <> 0
then (*error*)
testwrite ("createch u2:", lamref^.u2);
until lamref^.u2= 0;

release (lamref);
checklamlisten:= false;
 
(* initialise lamlistenbuffer *)
alloc (lamref, lampool, inputsem);
lamref^.u1:= read_it; (* input *)
lamref^.u2:= tsc_port;
lamref^.u3:= lam_route;
signal (lamref, lamsem);
 
(* 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 dclistenbuffer *)
alloc (dcref, dcpool, inputsem);
dcref^.u1:= 1 (* read from dc *);
dcref^.u3:= dc_route;
signal (dcref, dcsem);
 
(* initialise dcoutputbuffer *)
alloc (dcref, dcpool, dcoutsem);
dcref^.u1:= 2 (* write *);
dcref^.u3:= dc_route;
return (dcref);
 
(* initialise timeout *)
alloc (tim, timerpool, inputsem);
alloc (msg, updatepool, timeoutanswer);
(*/////////////////////////////////////////////////
timerbook (msg, tim, -1, netc_mic_addr);
/////////////////////////////////////////////////*)
 
(* create dc-module *)
link("dc_module   ",dc_module);
dccreatevalue:= create(
dc_module(
"dc_module   ",
semvector,
dcoutsem (*input to dc*)),
dcshadow,1000,0);
if dccreatevalue<>0 
then testwrite ("dccreateres:",dccreatevalue)
else
start (dcshadow,0);

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

input:= getinput;
 
case input of
enq : testwrite("enq         ",0);
data: testwrite("data        ",0);
out : testwrite("out         ",0);
here: testwrite("here        ",0);
rnr : testwrite("rnr         ",0);
nak : testwrite("nak         ",0);
ack : testwrite("ack         ",0);
rtr : testwrite("rtr         ",0);
lto : testwrite("lto         ",0);
tto : testwrite("tto         ",0);
nons: testwrite("nons        ",0)
end (*case input*);
 
action:= actiontable(state, input);

testwrite ("actionno.:  ",action);
 
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= ts1_macro
then timerupdate (msg, tick1)
else timerupdate (msg, tick2);
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= ts1_macro
then timerupdate (msg, tick1)
else timerupdate (msg, tick2)
end;

8: (*no action*)
begin
commandref^.u2:= tsc_port;
signal (commandref, lamsem);
if dataref^.u3= dc_route
then (* listenbuffer from dc_module *)
signal (dataref, dcsem)
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: timerbook (msg, tim, -1, netc_mic_addr);
 
16: (*timerbook and send enq*)
begin
timerbook (msg, tim, -1, netc_mic_addr);
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

⟦1f8d93f5f⟧ TextFileVerbose

Derivation

TextFileVerbose
