⟦4dc96fc2b⟧

TextFile

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
message  pascal
pascal80 alarmenv source
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               *)
 ncsem,                           (*  to nc    *)
lamsem,                          (*  to lam              *)
timeoutsem,                      (*  to timeout          *)
listensem :    !sempointer;      (*  buffer pool         *)
var mainsem,                     (*  my mainsem          *)
outsem,                          (*  transfer queue      *)
myfree,                          (*  my free buffers     *)
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
*             dec  1980 by hej
*
*********************************************************)

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

const
 
version = "vers  3.18 /";
ts1port = 0;
ts2port = 4;
tsc_port = ts1port;          (*  or ts2port  *)
\f



const

tsbufleng= size_listen*2 -2; (* no of bytes in buffer from tss *)
logleng= size_supp*2 -2;     (* no of bytes in log-message *)
lambufsize= 80;              (* no of bytes in buffer to lamdriver *)
con_lam_time= 20;             (*  lam driver timeout    *)
tick1= 5;      (*  timeout interval for ts with dc      *)
tick2= 6;      (*  timeout interval for ts              *)
no_of_lamlis= 3;
no_of_mybuf= 5;  (*  buffers in my pool  *)

tablesize = 4;      (*  entries in route tables  *)
extra = 4;          (*  extra bytes in lambuffer, stx+bll+opc+etx  *)
opco = 9;           (*  index in data  *)
logcode = #h00;     (*  opcode 0.0     *)
nb_code  = #h10;    (*  log of refuse message  *)
refuse_code=#h12;   (*  refuse message         *)
newaddr_code = #hb1;(*  opcode 11.1    *)
reading =  #hb2;    (*  opcode 11.2    *)
updatevar= #hbe;    (*  opcode 11.14   *)
nc_route = 13;


\f



type

statetype= ( discon, idle, wack, wrep );
inputtype= ( out, data, ackn, nack, bell, enqu, nons, tmo, lto );
 
modulref = ( sup, ncs, dcs, net);
tablerange = 1..tablesize;
macrotable = array ( tablerange) of macroaddr;
modultable = array ( tablerange) of modulref;
 
tsbuftype= (* message to/from tss *)
record
bytes: integer;
data: array (1..tsbufleng) of byte;
end;
 
logtype= 
record
bytes: integer;
data: array (1..logleng) of byte;
end;
 
lambuftype= (* message to/from lamdriver *)
packed record
stxt,
bll,
opc: byte;
text: array (1..lambufsize-extra+1) of byte; 
end;

note = record   (*  type 11.2  and 11.14   *)
head: alarmlabel;
data: array ( 1..8) of integer;
end;


flawshape = packed record            (*   mess  1.02    *)
   head : alarmlabel;
   data : alarmlabel
 end;


createchtype= (* message format in createchannel operation *)
record
controlinfo, timeout: byte;
end;
 
 
actionrow= array (inputtype) of integer;
actiontabletype= array (idle..wrep) of actionrow;
\f

 

const
 
actiontable=
actiontabletype(
(*                out  data ackn nack bell enqu nons tmo  lto  *)
(*idle*)actionrow(  1,   3,   0,   0,  12,   7,   0,  11,   0),
(*wack*)actionrow(  2,   3,   4,   6,   6,   7,   8,   9,   0),
(*wrep*)actionrow(  2,   3,   5,   6,   6,   7,   8,  10,   0));
 
(* operation codes in protocol between tsconnectors *)
(*  data1..ack2 must be consecutive values !!     *)
data1 = 17;   (*  ord(dc1)  *)
data2 = 18;   (*  ord(dc2)  *)
ack1  = 19;   (*  ord(dc3)  *)
ack2  = 20;   (*  ord(dc4)  *)
nakop = 21;   (*  ord(nak)  *)
enqop =  5;   (*  ord(enq)  *)
belop =  7;   (*  ord(bel)  *)
\f

 
var
(*pools*)
mypool:     pool (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;           (*  for timeout         *)
 
(*references*)
pending,
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,
sendcnt,  retrcnt,         (*  statistics counters      *)
givupcnt, reccnt,
nakcnt,   formcnt,
lamoutcnt, lamincnt,

ttc,            (*  transmission error count pr message  *)
tec : integer := 0;  (*  transmis. error count  *)

testlevel : integer:= 0;       (*  controls testoutput     *)
mytick : integer:= tick2;      (*  controls timeout        *)
ttcmax : integer:= 17;          (*  max errors pr message   *)
 
(*booleans*)
testboo : boolean;

reccode,            (*  opc in received block   *)
blockno,            (*  last send blockno  *)
lastack             (*  last send ackno    *)
       : byte;
 
state: statetype;
input: inputtype;
 




(*------------------------ routing --------------------------------*)

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



(*forward*)
 
procedure testwrite (level: integer; 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;





procedure book ( time: integer);
begin
  timerbook ( tmomes, msg, time, netc_mic_addr,
     timeoutsem^, timeoutanswer.w^)
end;




procedure moretime ( time: integer);
begin
  timerupdate ( tmomes, time, timeoutsem^, timeoutanswer.w^)
end;

\f


procedure createchn (timeoutper: integer);
(* creates lamchannel *)

begin

alloc ( lamref, lampool, lamoutsem.s^);

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

until lamref^.u2= 0;

release ( lamref);
 
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.
*)

 var   where : macroaddr;

begin
lock msg as head: alarmlabel do where:= head.rec.macro;
node(top):= where;
ix:= 1;
while node(ix) <> where do ix:= ix+1;
(*q  testwrite ( 32, "local to    ", ix);   q*)

msg^.u1:= 2;
case modul(ix) of
dcs:  signal ( msg, dcsem^);

ncs:  signal ( msg, ncsem^);

otherwise  signal ( msg, supsem^)
end

end;

\f


<*  
procedure writeblock ( var msg: reference);
  (*
  writes message as a lambuffer
  *)

var  i, top : integer;

begin
testout ( z,"u2:         ", msg^.u2);
lock msg as lambuf: lambuftype do
with lambuf do
begin
testout ( z,"  stx       ", stxt);
testout ( z,"  bll       ", bll);
testout ( z,"  opc       ", opc);
top:= bll;
if top > lambufsize-3 then top:= lambufsize-3;

for i:= 1 to top do
testout ( z, "    text    ", text(i));

end;
end;
  *>

\f



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

 var   where : macroaddr;

begin

repeat
tswait ( msg, mainsem.w);

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

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

0:
 lock msg as lambuf: lambuftype do 
with lambuf do
begin
reccode:= opc;
if (bll < extra) or (bll > lambufsize) then
begin
reccode:= ord(sub);
count ( formcnt);
testwrite ( 4, "blocklength ", bll);
end  else
if text(bll-extra+1) <> ord(etx) then
begin
reccode:= ord(sub);
count ( formcnt);
testwrite ( 4, "format error", bll-extra+1);
end;
case reccode of
data1,
data2 : decodeinput:= data;
ack1,
ack2  : decodeinput:= ackn;
nakop : decodeinput:= nack;
belop : decodeinput:= bell;
enqop : decodeinput:= enqu;
otherwise decodeinput:= nons
end (* case lambuf.opc *);
end;

1,3:   (*  after recreate    *)
  if checklamlisten > 0 then
  begin
   checklamlisten:= checklamlisten-1;
   decodeinput:= nons;
   sendlam
  end;
 
5: (* input timeout *)
decodeinput:= lto;

otherwise   (*  error  *)
begin
count ( lamincnt);
testwrite ( 2, "lamresultu2:", msg^.u2);
testwrite ( 2, "lamresultu4:", msg^.u4);
(*q   if ( testlevel mod 4) >= 2 then  writeblock ( msg);   q*)
decodeinput:= nons;
end
end (* case lammsg^.u2 *);
 
\f



otherwise           (*  from dc, nc 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    *)
  head.rec:= head.send;
  head.result:= accepted;
  modul(top):= dcs
end  else
if msg^.u3 = nc_route then modul(top):= ncs  else
begin
modul(top):= sup;
 here.macro:= head.send.macro;
end;

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

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

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

if who = here then
begin                 (*  msg for me  *)
if msg^.u4 = updatevar then               (*  11.14   *)
 lock msg as buf: note do
 with buf do
 begin
testlevel:= data(1);
mytick:= data(2);
ttcmax:= data(3);
head.result:= accepted;
head.rec:= head.send;
head.send:= here;
msg^.u4:= updatevar+1
end
else

if msg^.u4 = reading then           (*  11.02   *)
lock msg as buf: note do
with buf do
begin
data(1):= sendcnt;     sendcnt:= 0;
data(2):= retrcnt;     retrcnt:= 0;
data(3):= givupcnt;    givupcnt:= 0;
data(4):= reccnt;      reccnt:= 0;
data(5):= nakcnt;      nakcnt:= 0;
data(6):= formcnt;     formcnt:= 0;
data(7):= lamoutcnt;   lamoutcnt:= 0;
data(8):= lamincnt;    lamincnt:= 0;
head.result:= accepted;
head.rec:= head.send;
head.send:= here;
msg^.u4:= reading+1;
end   else

if msg^.u4 = refuse_code then  
else
begin                   (*  unknown op-code   *)
 lock msg as buf: flawshape do
 with buf do
 begin
  data:= head;
  data.op_code:= msg^.u4;
  head.rec:= head.send;
  head.send:= here;
  head.result:= unknown_opcode;
 end;
 msg^.u4:= refuse_code;
end
end;

lock msg as head: alarmlabel do 
begin
 where:= head.rec.macro;
 head.op_code:= msg^.u4
end;

modul(top):= net;
node(top):= where;
ix:= 1;
while node(ix) <> where do ix:= ix+1;
(*q  testout ( z,"found in    ", ix);   q*)

msg^.u3:= netc_route;
if msg^.u4 = refuse_code then return ( msg)
else
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 *)

begin
 
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 (msg^.u2<> 0) and (msg^.u2<> 5) then
(* status error in lamlistenbuffer *)
begin
count ( lamincnt);
testwrite( 2, "lam status: ",msg^.u2);
statuserror:= true;
(* lamchannel recreated caused by listenbuffer -
(* try again: *)
sendlam;
end (* status error in lamlistenbuffer *)
end (* listenbuffer from lamdriver *)
*>
 
end (* getinput *);
\f

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

var   errors: integer:= 0;

begin

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

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

if (pending^.u4 = logcode)  then
(* logmessage to dc *)
lock pending as mess: logtype do
with lambuf do
begin
if (mess.bytes < label_size) or (mess.bytes > logleng) then
begin
testout(z,"no_of_bytes:",mess.bytes);
testout(z,"u1:         ",pending^.u1);
testout(z,"u2:         ",pending^.u2);
testout(z,"u3:         ",pending^.u3);
testout(z,"u4:         ",pending^.u4);
for i:= 1 to 10 do 
testout(z,"   log      ",mess.data(i));
end;

if (mess.bytes < label_size) or ( mess.bytes > logleng) 
  then mess.bytes:= logleng;
bll:= mess.bytes+extra;
opc:= transcode;
for i:= 1 to bll-extra do
text(i):= mess.data(i);
text(bll-extra+1):= ord(etx);
end (* logmessage to dc *)
 
else (*  ts message  *)
lock pending as mess: tsbuftype do
with lambuf do
begin
if (mess.bytes < label_size) or (mess.bytes > tsbufleng) then
begin
testout(z,"no_of_bytes:",mess.bytes);
testout(z,"u3:         ",pending^.u3);
for i:= 1 to 10 do
testout(z,"   text     ",mess.data(i));
end;
 
if (mess.bytes < label_size) or (mess.bytes > tsbufleng ) then
  mess.bytes:= tsbufleng;
bll:= mess.bytes + extra;
opc:= transcode;
for i:= 1 to (bll-extra) do
text(i):= mess.data(i);
if text(opco) <> pending^.u4 then testwrite ( 4,"opcode      ", text(opco));
text(bll-extra+1):= ord(etx);
end (* opcode=dataop *)
 
else
lock lamref as lambuf: lambuftype do
with lambuf do
begin
bll:= extra;
opc:= transcode;
text(1):= ord(etx);
end;

(* now send lambuffer *)
lamref^.u2:= tsc_port;
(*
if testlevel > 48 then writeblock ( lamref);
*)
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_data;
(* copies listenbuffer from lamdriver onto ts-buffer
and signals it to dc or supervisor *)

var  reply: byte;

begin

(* copy lambuffer onto ts buffer *)
lock msg as lambuf: lambuftype do
 
if ( lambuf.text(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
bll:= bll-extra;
if bll < label_size then bll:= label_size  else
if bll > logleng then bll:= logleng;
mess.bytes:= bll;
for i:= 1 to bll do
mess.data(i):= text(i);
myref^.u4:= text(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
bll:= bll - extra;
if bll < label_size then bll:= label_size  else
if bll > tsbufleng then bll:= tsbufleng;
mess.bytes:= bll;
for i:= 1 to bll do
mess.data(i):= text(i);
myref^.u4:= text(opco) (*op_code*);
end
end;

if nil ( myref) then     (*  no free buffer for the received data  *)
begin
count ( nakcnt);
reply:= nakop
end
else
begin   (*  data is in myref,  send to dc, nc, or sup   *)
reply:= reccode+2;
lastack:= reply;
myref^.u3:= netc_route;
route_local ( myref);
count ( reccnt);
end;

trans ( reply)

end;  (*  of accept message  *)

\f



procedure block_ok;
begin
 return ( pending);
 moretime ( -1);
 tec:= tec + ttc;
 state:= idle
end;





procedure retransmit;
begin
 trans ( blockno);
 moretime ( mytick);
 ttc:= ttc+1;
 count ( retrcnt);
 state:= wack
end;

\f



procedure give_up ( var msg: reference);

var   code : byte;

begin

count ( givupcnt);
lock msg as head : alarmlabel do
 code:= head.op_code;
if ( code = nb_code) or ( code = refuse_code ) then
 return ( msg)
else
begin
 lock msg as buf : flawshape do
 with buf do
 begin
  data:= head;
  with head do
  begin
   no_of_by:= 2*label_size+2;
   rec:= send;
   send:= here;
   result:= no_connection
  end
 end;
msg^.u3:= netc_route;
msg^.u4:= refuse_code;               (*  1.2    *)
route_local ( msg)
end
end;



\f


procedure testwrite (level: integer; a:alfa; i:integer);
begin
if ( testlevel mod ( 2*level)) >= level then
testout (z,a,i)
end (* testwrite *);
\f

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

 
begin
testopen (z, own.incname, opsem);
testout(z,version,al_env_version);
blockno:= data2;
 
 
(* create channel *)
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 *)

for i:= 1 to 1 do
begin
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);
end;
 
(* initialise timeout *)
alloc (msg, timerpool, mainsem.s^);
alloc (tmomes, updatepool, timeoutanswer.s^);
tmomes^.u3:= tim_route;
book ( mytick);
 
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


repeat    (*  until forever  *)


(*--------------------- connect loop ----------------------------*)

state:= discon;
lastack:= nakop;

repeat

case getinput of

out:   give_up ( msg);

data:  begin  accept_data;  state:= idle   end;

bell,
enqu:  begin  trans ( lastack);   state:= idle   end;

nack:  begin   sendlam;   state:= idle   end;

tmo:   begin  book ( mytick);  trans ( belop)  end;

otherwise   sendlam
end;

until state=idle;

testout ( z,"connected   ", tsc_port);

\f



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

 
repeat

input:= getinput;
action:= actiontable(state, input);
 
(*--                                                 ----------
case state of
idle: testwrite ( 16, "idle        ", action);
wack: testwrite ( 16, "wack        ", action);
wrep: testwrite ( 16, "wrep        ", action)
end;
  --                                                 ----------*)
(*---------- ..
case input of
data: testwrite ( 16, "  data      ", ord(state));
out : testwrite ( 16, "out         ", ord(state));
ackn: testwrite (  8, "ackn        ", ord(state));
nack: testwrite (  8,"nack *      ", ord(state));
bell: testwrite (  8, "bell *      ", ord(state));
enqu: testwrite (  8, "  enqu      ", ord(state));
lto : if state <> idle then testwrite (  8, "lto         ", ord(state));
tmo : testwrite (  8, " tmo        ", ord(state));
nons: testwrite (  4, "** nons     ", ord(state))
end;
(*
if testlevel >= 4 then
if input = nons then writeblock ( msg);
..
(*  ----------*)
 
case action of 

0: (*no action *)
sendlam;

1: (*  send data block  *)
begin
blockno:= data1 + data2 - blockno;
pending :=: msg;
trans ( blockno);
moretime ( mytick);
ttc:= 0;      (*  1st try  *)
count ( sendcnt);
state:= wack
end;

2: (*  put block into queue  *)
signal ( msg, outsem.s^);

3: (*send ack to lam and data to tss or dc*)
accept_data;

4: (*  ack x  received  *)
begin
if reccode-2 = blockno then block_ok;
sendlam
end;

5: (*  repeated ack received  *)
begin
if reccode - 2 = blockno then     (*  ok  *)
begin
block_ok;
sendlam;
end  else
retransmit;
end;

6: (*  retransmit data  *)
retransmit;

7: (*  reply request  *)
   trans ( lastack);

8: (*  try enq again  *)
begin
trans ( enqop);
moretime ( mytick);
 ttc:= ttc+1;
 testwrite ( 8, "enq again   ", ttc);
state:= wrep;
end;

9: (*  timeout for ack for a block  *)
begin
book ( mytick);
trans ( enqop);
 ttc:= ttc+1;
 testwrite ( 8, "enq send    ", ttc);
state:= wrep;
end;

 
10: (*  timeout for enq  *)
begin
book ( mytick);
trans ( enqop);
ttc:= ttc+1;
testwrite ( 8, "enq timeout ", ttc);
end;
 
11: (*  a late timeout   *)
book ( -1);

12:  (*  bell received  *)
  trans ( nakop)

 
end (* case *);

if ttc > ttcmax then                    (*  give up   *)
begin
give_up ( pending);
tec:= tec+ttc;
ttc:= 0;
state:= idle;
end;
 
if tec >= 30000 then tec:= 100;

if tec mod 100 = 10 then
begin
testout ( z, "transm error",tec);
tec:= tec+1;
end;

until state = discon;

testout ( z,"disconnected", tsc_port);
testout ( z,"trans errors", tec);

until false;
 
end.

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦4dc96fc2b⟧ TextFile

Derivation

TextFile
