⟦2d9ec74a6⟧

TextFileVerbose

job hj 2 200 time 11 0 area 10 size 100000
source = edit hdlctxt
m e
g b/reclev/port/
l t, p
l./hdlc/, d, i/
process alc (                (*  asynchr link control     *)
  var sem : !ts_pointer;     (*  main semaphore           *)
  var lamsem: !sempointer;   (*  lam driver sem           *)
  port : byte    );          (*  lam port used            *)
/,
l./testmax/,   r/127/3/,
l./field/,   d,   i/
commandfield = byte;
/,
l./status/,  r/packed//,
l./,ffo,/,  d2,  i/
 lambits, res : byte;
/,
l./field/,  r/commandfield/byte/,
l./*)/,   r/*)/*/,
l./flag/,   i/

bytes6 = array (0..5) of byte;
array6 = array (1..6) of integer;
array8 = array (0..7) of integer;

statistics = record                       (*  for statistics     *)
 na1, na2, na3 : integer;          (*  not used         *)
 recnu,    recs,                   (*     -    , received blocks   *)
 tranu,    trans,                  (*     -    , transmitted blocks *)
 skipnu,   skips,                  (*     -    , give ups           *)
 retrnu,  retrans : integer;       (*      -   , retransmissions    *)
 rec_rnr,                          (*  last received rec error      *)
 xmt_rnr,                          (*  last received xmt error status  *)
 rec_rej,                          (*  timeouts after enq          *)
 xmt_rej,                          (*  waits for xmt               *)
 ack_times,                        (*  timeouts after data          *)
 dsr, dcd, sqd,                    (*  lambit  12  11  10  off   *)
 ci :               integer;       (*  lam u4   lam u2        *)
 last_rec,                         (*  last opcode received       *)
 last_xmt : byte;                  (*  last opcode transmitted    *)
 xmterr, recerr :   integer;       (*  times when u2 <> 0 and 5  *)
 fut : array6;                     (*  counter(lam u2 div 8)      *)
end;

statetype = ( discon, connec, idle, wack, wrep );     (*  xstate   *)
inputtype = ( data, ackn, enqu, rese, nons );
arow = array (inputtype) of byte;
actiontabletype = array ( connec..wrep) of arow;
/,
l./const/,
l1,   d./z=8/,
i/
  maxinputs = 2;

  v24 = bytes6 ( 0, 32, 0, 32, 64, 96);
  zeroes = statistics (
   0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0,
   0,0,0,0,0, 0,0,0,0, array6(6***0) );

  timeru3 = 250;         (*  250,2 = 1000 = 1 sec   *)
  timeru4 = 2;

  send_ok = 0;
  down   = 1;
  trouble = 1+8;
  waiting = 10;
  nonsens = 26;
  discp = 99;

  enq    = 5;              (*  operation codes     *)
  reset  = 21;
  ack_0  = 19;
  ack_1  = ack_0+1;
  data_0 = 28;
  data_1 = data_0+1;
  codediff = data_0 - ack_0;

 actiontable =
 actiontabletype (
                    (*              data   ack   enq  reset  nons    *)
                    (*connec*) arow(  3,    2,    7,    1,    0 ),
                    (* idle *) arow(  3,    0,    7,    0,    0 ),
                    (* wack *) arow(  3,    4,    7,    0,    0 ),
                    (* wrep *) arow(  3,    5,    7,    6,    0 ));
/,
l./timer/,   r/1/6/,
l./recansw/,   r/2/read_it/,
l1,   r/3/write_it/,
l1,   r/4/create_it_ch/,
l./setfll/,   d3,
i/
 setspeedmess = 48;
/,
l./modemc/,
d15,  l./var/,
i/

\f



var
/,
l1, d2,  i/
retrans, auto : boolean:= false;
/,
l./dok/,   r/sendok,//,
l1, d,
l./xstate/,  r/xstate,//,   l1, d3,
l./xmtle/,   r/xmtlev,//,   r/,ovs,ovr,cns,aux//,   r/;/:= 0;/,
l1, d1,  i/
 st: status;
/,
l./flag/,   r/true/false/,
l./mx/,   r/b1,b2,//,   r/mw1,//,
r/cmdrbuf,recdev,xmtdev/ pending /,
l./op:/,  d,
l./dow/,  d,
r/rec,xmt,//,  r/asem,qs1,//,
r/,s:/,small:/,
l1, r/4/3+maxinputs/,
l1,  r/4/1+maxinputs/,
l./cmdr/, d,
l./8/,   r/8/7/,
l./priq:/,   d,
l./qs,/,   d7,   
i@

 xstate : statetype;    (*  process state          *)
 input  : inputtype;    (*  received from lam      *)

 alc_control: byte:= 4+24+96;     (*  1200 pbs is standard   *)
 alc_time : byte:= 5;

 lastack,               (*  save for enq   *)
 func,                  (*  returned u1           *)
 opk,                   (*  u3 to/from lam         *)
 action,                (*   selected action       *)
 modem_state,           (*   lambits div 8         *)
 result,                (*  for answer to router   *)
 block_no : byte:=0;    (*  last send data code    *)

 mr : array (0..maxinputs-1) of reference;
 vcodes : array (1..6) of byte;         (*  saved opcodes  *)

 stc : statistics := zeroes;   (*  stat counters         *)

\f



@,
l./asgn/,
l1,  d10,
d./ure resetact/,   d2
i@


procedure exception ( cause: integer);
forward;


procedure event ( cause: integer);
forward;


procedure asgnintset ( var d: integer;  s: status );
external;





procedure answ;           (*  return m with ok result   *)
begin
 m^.u2:= 0;
 m^.u3:= port;
 return ( m)
end;





procedure answer ( res: byte);      (*  return m with  res   *)
begin
 m^.u2:= res;
 m^.u3:= port;
 return ( m)
end;


\f



procedure readlam;
(*                 send input request to lam driver    *)
  var um: reference;

begin
 if (bstate < maxinputs) and (xstate > discon) then
 begin
  sensesem ( um, ique);       (*  get receive buffer if possible  *)
  if nil ( um) then
   if mstate then sensesem ( um, small);  (*  get small if legal  *)
  if not nil ( um) then
  begin
   push ( mr(bstate), um);
   bstate:= bstate+1;
   um^.u2:= port;
   um^.u3:= data_0;      (*  gives check of first, last in lam  *)
   signal ( um, lamsem^);
   (*q  trace ( bstate);   q*)
  end;
 end
end;





procedure create_channel;
begin
 if not nil ( mc) then
 begin
  lock mc as h: headbuf do 
   h.first:= alc_control*256+alc_time;
  mc^.u2:= port;
   (*q  trace ( port*256+alc_control);   q*)
  signal ( mc, lamsem^)
 end
end;


\f



procedure getresult;
begin
 st.res:= m^.u2;
 st.lambits:= m^.u4;
 modem_state:= v24((m^.u4 div 8) and 5);
 asgnintset ( stc.ci, st);
 i:= m^.u2 div 8;
 if i> 0 then count ( stc.fut(i));
 if modem_state < 96 then
 begin
 if modem_state mod 64 = 0 then count ( stc.dsr);
 if modem_state < 64 then count ( stc.dcd);
 if xstate >= idle then event ( 9);
 end
end;



\f


procedure release_buf;
begin
 pending^.u2:= result;
 pending^.u3:= port;
 return ( pending);
 result:= waiting;
 tn:= 0;
 time:= -1;
end;




procedure trans ( transcode : byte);
begin
 if nil ( mx) then
 begin
  count ( stc.xmt_rej);
  vi:= vi+1;
  if vi > 6 then         (*  lam in exception or stopped    *)
  begin
   event ( 10);
   vi:= 2;
  end;
  vcodes(vi):= transcode;
 end  else
 begin
  mx^.u2:= port;
  mx^.u3:= transcode;
  signal ( mx, lamsem^);
  (*q  trace ( transcode);   q*)
  stc.last_xmt:= transcode;
  time:= t2;
 end
end;   (*  of trans  *)
\f





procedure transdata;
begin
       (*  pending and mx is not nil    *)
 mx^.u2:= port;
 mx^.u3:= block_no;
 push ( mx, pending);
 signal ( pending, lamsem^);
 (*q  trace ( block_no);   q*)
 stc.last_xmt:= block_no;
 time:= t2;
 result:= waiting;
 xstate:= wack;
end;





procedure block_ok;
begin
 result:= send_ok;
 if nil ( pending) then
 begin
  (*   ack received before lam xmt finished    *)
  event ( 4);
 end  else
 begin
  (* count ( xmt_cnt );    *)
  xstate:= idle;
  release_buf; (* pending *)
 end
end;

\f



procedure give_up ( cause : byte);
begin
 result:= cause;
 (*q  trace ( cause);   q*)
 count ( stc.skips);
 if nil ( pending) then
 begin
 (*    lam xmt is dead, when i give up    *)
  event ( 3);
 end  else
  release_buf;
 time:= t2;

 if xstate > connec then
 if auto then                      (*  try to connect again   *)
 begin
  event ( 11);
  mstate:= true;
  xstate:= connec;
 end  else
 begin
  event ( 12);
  xstate:= discon;
 end
end;




procedure answer_stat;
begin
 lock m as buf: statistics do buf:= stc;
 answ;
end;


\f


@,
l./ure otest/,   r/commandfield/byte/,
l./*)/,   r/)//,
l./b:=bsta/,   r/xstate/ord(xstate)/,
l1,   r/send/nil(mx)/,
r/sendingiframe/nil(pending)/,
r/aborting/retrans/,
p
l./sensept/,  d7,
l./ure getres/,   d25,
l./ure event/,   l./if/,   i/
 (*q  trace ( cause);   q*)
/,
l./otest(8/,   l./sem/,   r/sem/sem.w^/,
l./u2:=3/,   r/3;/15*8+3;  u3:= port;/,
l./ure cmdrac/,  d9,
l./recp/,   d./until/,  d,
d./end;/
i/

\f



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

/,
l./trace/,
 r/trace(0);/(*  trace(29);      (*--------- version ---------*)/,
l./xmt/,   
p
d15,
i@
 lastack:= reset;
 block_no:= data_1;
 xstate:= discon;
 result:= waiting;
@,
l./setmodem/,   d5,
l./sem/,   r/sem/sem.s^/,
l1, d3,
i/
mc^.u1:= conansw;
/,
l./,s)/,   r/s/ priq1(-1)/,
l./-1))/,   r/;/;          (*  see 'xmt next block'  line 766    *)/,
l./frame/,   r/frame/head/,   r/sem/sem.s^/, 
l1, d2, i/
 mx^.u1:= xmtansw;
/,
p
l./alloc/,   d12,   i/
 for l:= 0 to maxinputs-1 do
 begin
  alloc ( mr(l), headpool, sem.s^);
  mr(l)^.u1:= recansw;
  alloc ( m, framepool, small);
  lock m as buf: headbuf do
  begin
   buf.first:= 6;
   buf.last:= 7;
  end;
  return ( m)
 end;
/,
l./sem/,   r/sem/sem.s^/,
l./u2/,   r/2/1/,   r/;/;  m^.u2:= m^.u1;/,
r/100/timeru3/,   r/4:=0/4:= timeru4/,
l2,  i/

\f



(*----------------------- main loop -----------------------------------*)
/,
l./sem/,   r/sem/sem.w^/,
l./case/,   d1,
i/
func:= m^.u1;
 if m^.u2 = message then
/,
l./rr/,   r/rr/opk/,
l./input/,   i@

sensemess:
 begin
  i:= ord(xstate);
  if i>2 then i:= 2;
  answer ( modem_state +i*8);
end;

@,
l./case bstate/,  d./3,4:/,   d3,
p
i/
begin
 signal ( m, ique);
 mstate:= false;      (*  dont use small buffers     *)
              (*  until next connect or auto-connect  *)
 (*q  trace ( 1);    q*)
readlam;
end;
/,
l./priq/,   r/iq(/iq1(/,
r/)^)/))/,
l./h.t1/,   r/t2:=h.t1; //,
l1,   i/
 t2:= (h.t1+9) div 10;
/,
l./.u2:=/,  d./rstate>2 *>/,
i/
answ;
mstate:= true;
if xstate < idle then
begin
 xstate:= connec;
 create_channel;
 time:= t2;
end;
/,
l./case rstate/,   d10,   i/
 xstate:= discon;
 event ( 1);
 answ;
 tn:= 0;
/,
l./testmess:/,   i/

\f


statmess:   answer_stat;

statclrmess:
 begin   answer_stat;   stc:= zeroes;   end;

setspeedmess:
 begin
  lock m as buf: record ctr, tim:byte  end do
  begin
   alc_control:= buf.ctr;
   alc_time:= buf.tim;
  end;
  answ;
 end;


linespeedmess:
 begin
  if xstate < idle then answer ( 0)
  else answer ( 56);                  (*  1200 bps  *)
 end;

modemmess:   answ;

\f



returnallmess,
returnunusedmess:
begin
 while open ( ique) do
 begin
  wait ( mw, ique);
  mw^.u2:= down;
  mw^.u3:= port;
  return ( mw)
 end;
 for i:= 7 downto 0 do
 while open ( priq1(i)) do
 begin
  wait ( mw, priq1(i));
  mw^.u2:= down;
  mw^.u3:= port;
  return ( mw);
 end;
 if m^.u1 = returnallmess then
 begin
  xstate:= discon;
  mstate:= true;
  event ( 1);
  tn:= t2;
 end;
 answ;
end;

/,
l./other/,  r/:=4;/:=4;  m^.u3:= port;/,
l./end; <* message/,   r/;//,
l1,
p
i@
 else

  case func of
@,
l2,   d./until false/,

i@
begin
 getresult;
opk:= nonsens;
if m^.u2 = 0 then  begin  opk:= m^.u3;  recerr:= 0  end  else
if m^.u2 = 5 then  recerr:= 0  else
begin
 count ( stc.recerr);
 stc.rec_rnr:= stc.ci;
 (*q  trace ( m^.u2);   q*)
 recerr:= recerr+1;
 if recerr >= n2 then
 begin
  recerr:= 0;
  event ( 13);
 end
end;
 bstate:= bstate-1;
 pop ( mr(bstate), m);
 readlam;
 stc.last_rec:= opk;

case opk of
enq:    input:= enqu;
ack_0,
ack_1:   input:= ackn;
reset:   input:= rese;
data_0,
data_1:  input:= data;
nonsens: input:= nons;
otherwise
 begin
  event ( 7);
  input:= nons;
 end
end;

 if xstate < connec then action:= 0  else
 action:= actiontable(xstate,input);
 if test then
 if testbit(12) then otest ( bstate, action, opk);
(*q   trace ( opk);        q*)

\f



 case action of

0:   ;  (*  do nothing   *)

1:      (*  reset received   *)
  begin
   xstate:= idle;
   event ( 0);
  end;


2:   (*  ack received when connecting   *)
 begin
  block_no:= opk+codediff;
  xstate:= idle;
  event ( 0);
 end;


3:   (*  data  received    *)
 begin
  m^.u2:= 0;
  m^.u3:= port;
  return ( m);
  lastack:= opk-codediff;
  trans ( lastack);
  count ( stc.recs);
end;


4:      (*  ack received    *)
   if opk+codediff = block_no then block_ok;


5:      (*  ack received after enq   *)
   if opk+codediff = block_no then block_ok
   else retrans:= true;


6:      (*  reset received after data    *)
 begin
   retrans:= true;
  event ( 0);
 end;

7:      (*  enq received   *)
 begin
  trans ( lastack);
  count ( stc.rec_rej);
  if xstate < idle then 
  begin
   xstate:= idle;
   event ( 0);
  end;
 end
end;  (*  case  *)

if input <> data then
if ownertest ( framepool, m ) then return ( m)  else
if (xstate=discon) and (mstate) then       (*  release input  *)
answer ( down)  else
 signal ( m, ique);
readlam;
end;  (*  receiver answer   *)

\f



xmtansw:
begin
 getresult;
 if test then
 if testbit(12) then otest ( 16, action, m^.u3 );
 if m^.u2 = 0 then
 begin
  xmterr:= 0;
  (*q  trace ( m^.u3);     q*)
 end  else
 begin
  count ( stc.xmterr);
  stc.xmt_rnr:= stc.ci;
  xmterr:= xmterr+1;
  if xmterr >= n2 then
  begin
   xmterr:= 0;
   event ( 14);
  end
 end;
 pop ( mx, m);
 if mx^.u3 >= data_0 then 
begin
 pending :=: m;
 if result <> waiting then release_buf;
end;
 readlam;
end;



conansw:
 begin
  mc:=: m;
  if mc^.u2 <> 0 then event ( 14);
 end;


\f


timeransw:
begin
 if time > 0 then time:= time-1;
 if time = 0 then
                    (*  timeout   *)
  case xstate of

connec:
 begin
  tn:= tn+1;
  if tn >= n2 then
  begin
   event ( 11);
   tn:= 1;
  end;
  trans ( enq);
 end;

wack:
 begin
  tn:= 1;
  trans ( enq);
  count ( stc.ack_times);
  xstate:= wrep;
 end;

wrep:
 begin
  tn:= tn+1;
  count ( stc.rec_rej);
  if tn >= n2 then give_up ( trouble)
  else trans ( enq);
 end

otherwise
 time:= -1;

end;  (*  timeout  *)

 m^.u3:= timeru3;   m^.u4:= timeru4;
 sendtimer ( m);
end;  (*  timer  *)

otherwise              (*  unknown answer    *)
 if st.lambits = func then  release ( m)
  else return ( m);
  st.lambits:= func;
  event ( 5);
end;   (*  handling of arriving message    *)
\f




(*   xmt  if requested     *)

if not nil ( mx) then
begin
 if vi > 0 then
 begin
  mx^.u2:= port;
  mx^.u3:= vcodes(1);
  signal ( mx, lamsem^);
  for i:= 2 to vi do vcodes(i-1):= vcodes(i);
  vi:= vi-1;
 end  else
 
if (retrans) and (not nil ( pending)) then
 begin
  transdata;
  count ( stc.retrans);
  retrans:= false;
 end  else

 if (nil ( pending)) and ( xstate < wack ) then    (*  xmt next block   *)
 begin
  i:= 7;
  while passive ( priq1(i)) do i:= i-1;
  if i> -1 then
  begin
   wait ( pending, priq1(i));
   if xstate = idle then        (*  xmit   *)
   begin
    block_no:= data_0 + data_1 - block_no;
    transdata;
    count ( stc.trans);
   end  else
    give_up ( down);               (*  if line down   *)
  end
 end
end   (*  mx unused    *)

until false

end .   (*  of alc  program   *)

@,
l1, d2,
f
if ok.no
finis
lst = set 1 disc1
lst = indent source mark lc
listc = cross lst
o errors
message  pascal
pascal80 spacing.500 codesize.9000 alarmenv source
o c
lst = copy listc errors
scope user lst
clear user pxalclst
rename lst.pxalclst
lookup pass6code
if ok.yes
 (
  pxalcbin = move pass6code
  finis output.no
)
convert errors
finis
«eof»
DataMuseum.dk

RC3500

⟦2d9ec74a6⟧ TextFileVerbose

Derivation

TextFileVerbose
