!**********************************************************
!*                                                        *
!*           PSS X-25 Level 3 Protocol Handler            *
!*                                                        *
!*                      GATEX                             *
!*                                                        *
!*                Version     9.31 15 Sep  1983           *
!*                                                        *
!**********************************************************
!*
%control 1
%begin
!************************************
!*                                  *
!*          Declarations            *  
!*                                  *
!************************************
!*
!****** Constintegers ******
!*
!*Link states
%constinteger established              = 0
%constinteger down                     = 1
%constinteger restarting               =  2
%constinteger gfi                      = x'10'
!*State values
%constinteger idle                     = 0 ;!Fixed
%constinteger wtaci                    = 1 ;!Fixed
%constinteger wtacn                    = 2 ;!Fixed
%constinteger estb                     = 3       ;!Fixed
%constinteger wait data                =  4 ;!Fixed
%constinteger wtdsi                    = 7
%constinteger wtdsn                    = 8
%constinteger wtdsn2                   =  9
%constinteger wdaci                    =10

!Tstate and Rstate values
%constinteger clear                    = 0
%constinteger set                      = 1
%constinteger ackpending               = 1

%constinteger wrstn                    =  1
%constinteger wrsti                    =  2

!Monitor calls
%constinteger ok                       =0
%constinteger line down                = 1
%constinteger line up                  = 2
%constinteger query                    = 3
%constinteger bad process              = 4
%constinteger bad outstate             = 5
!6-13 Used for Connect rejection monitoring
%constinteger mon process running      =  6
%constinteger mon bad param            =  7
%constinteger mon no free lcns         =  8
!14-21 Used for incoming call rejection monitoring
%constinteger bad fn                   = 22
%constinteger bad instate              = 23
%constinteger data outside connect     = 24
%constinteger mon no procs             = 25
%constinteger bad ack                  = 26
%constinteger mon to acct              = 27
%constinteger from up                  = 28
%constinteger to up                    = 29
%constinteger from low                 = 30
%constinteger to low                   = 31
%constinteger bad block                = 32
%constinteger mon call collision       = 33
%constinteger mon rej recd             = 34

#if m
#if h
%include "inc_configf"
#else
%include "inc_minconf"
#fi
#else
#if l
%include "inc_configlge"
#else
%include "INC_CONFIG"
#fi
#fi
%include "INC_VARIOUS"
%include "INC_XGTFNS"

!TS Functions
%constinteger ts connect               = 16
%constinteger ts accept                = 17
%constinteger ts disconnect            = 18
!*X25 Functions
%constinteger incoming call            = 11  ;!From DCE
%constinteger call request             = 11  ;!To   DCE
%constinteger call connected           = 15  ;!From DCE
%constinteger call accepted            = 15  ;!To   DCE
%constinteger clear indication         = 19  ;!From DCE
%constinteger clear request            = 19  ;!To   DCE
%constinteger clear confirmation       = 23  ;!Covers DTE & DCE
!Data and interrupt
%constinteger dce data                 =  0  ;!From DCE
%constinteger dte data                 = 0   ;!To   DCE
%constinteger interrupt                = 35  ;!Both ways
%constinteger interrupt confirmation   = 39  ;!Both ways
!Flow control and reset
%constinteger rr                       =  1  ;!Both ways
%constinteger rnr                      =  5  ;!Both ways
%constinteger rej                      =  9  ;!To   DCE
%constinteger reset indication         = 27  ;!From DCE
%constinteger reset request            = 27  ;!To   DCE
%constinteger reset confirmation       = 31  ;!Covers DCE & DTE
!Restart
%constinteger restart indication       =251  ;!From DCE
%constinteger restart request          =251  ;!To   DCE
%constinteger restart confirmation     =255  ;!Covers DCE & DTE

%constinteger fast select bit          =128
%constinteger restricted response bit  = 64
%constinteger ww set                   =  4
%constinteger ps set                   =  2
%constinteger reverse charge bit       =  1
!*
!Commands to and from lower level
%constinteger line input               = 1
%constinteger line output              = 2

%include "INC_DISCQUALS"
%include "INC_SERS"

!*Various consts
!Note LCN = 255 is used as a flag
%constinteger critical long            =  6
%constinteger critical short           =  2
%constinteger max writes               = 24
%constinteger dte                      =  0
%constinteger dce                      =  1
%constinteger txc                      =  6
%constinteger tx                       =  7
%constinteger rx                       =  3
%constinteger fast                     =  1
%constinteger not negotiable           = -9
%constinteger xprot hello              =  2

!*
!****** End of constintegers ******
!*
!****** Recordformats ******
%include "INC_FORMATS"
%recordformat timef(%bytearray a(0:3))
%recordformat factabf(%string(7) facility, %integer ser)

%recordformat linef(%record (qf) %name link, %c
%byte procno, state, writes left, lcgn, ser, dcedte, time, %c
%record (qf) call q, %integer line no, %bytearray lcntab(0:no of lcns - 1))

%recordformat scvf((%byte l, (%byte reason, cause, diags) %or %bytearray a(0:3)) %or %string (3) s)
%recordformat procf(%record (qf) %name link,  %c
%byte procno, state, task id, task port, fac, quiettime, istate, tsflag, %c
%record (linef) %name linelink,%record (qf) outq, %integer acks, %record (mef) %name clrbuff, discbuff, %c
%byte lcgn,lcn,aaa,eee,ttt,ccc,tstate,rstate,substate,ww in,ww out,ps in,ps out,
#if m
%record (scvf) cv)
#else
%record (timef) time, %record (cvf) cv)
#fi
!* substate *******************************************************
!*                                                                *
!* Bit 0:
!* Bit 1:
!* Bit 2:
!* Bit 3:
!* Bit 4:  If set indicates that an RR or RNR is being deferred   *
!* Bit 5:  If set indicates that we have sent RNR                 *
!*                                                                *
!******************************************************************

#if ~f
!*
!****** Monitoring information ******
!*
%constinteger maxmon = 34
%constbyteintegerarray monaction(0:maxmon)= %c
 2, 2, 2, 2, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 
 1, 1, 1, 1, 1, 1, 3, 3, 2, 2,1, 1, 1, 1, 1, 1,
 3, 2, 2
%ownbyteinteger monbyte = 3 ;!all messages to disc.
%owninteger monchan = 0 ;!all channels
%ownintegerarray moncount(0:maxmon) = 0(maxmon+1)
%owninteger datarx, rrrx, rnrrx, rejrx, callrx, accrx, clrrx, clrcrx, intrx, intcrx, resrx, rescrx, rstrx, rstcrx, derrrx, d1 = 0
%owninteger datatx, rrtx, rnrtx, rejtx, calltx, acctx, clrtx, clrctx, inttx, intctx, restx, resctx, rsttx, rstctx = 0
#fi

%ownbyteinteger dcedte = 0
%owninteger shutters up                =  0
!****** Integers ******
!*
   !No. of writes we have left out of WRITEMAX (currently 24)
%owninteger i,r,s,m,index = 0
%owninteger mon cons, buffers held = 0
%owninteger default line = -1
%ownstring(1) nullstr = ""
%ownstring(2) fac = "**"
%ownbytearray protb(0:14) = 4, 127, 255, 255, 255, 4, 1, 0, 0, 0, 4, 204, 0, 0, 0
%ownstring (4) %name tsprotb
%ownstring (4) %name xxxprotb
!*
!Upper level refers to Protocol conversion modules. Lower refers to level 2
!protocol handlers and Buffer Manager.
%constrecord (qf) %name null == 0
%ownrecord (linef) %name line
%ownrecord (procf) %name process
%ownrecord (pf) p
!****** Records and Recordarrays ******
%ownrecord (qf) busy q, free lq, free pq, short q = 0
%constinteger facmax                   = 16
#if ~m
%ownrecord (timef) curtime = 0
#fi
%ownrecord (linef) %array linetab(1:no of x25 nets)
%owninteger factot                     =  0
%ownrecord (factabf) %array faclist(0:facmax-1)
%ownrecord (procf) %array proctab(1:no of procs)
!*
!****** Routine Specs ******
!*
%routine push(%record (qf) %name q,new)
   q_count = q_count + 1
   %if q_link == null %start
      q_link == new
      new_link == new
   %else
      new_link == q_link_link
      q_link_link == new
      q_link == new
   %finish
%end

%record (qf) %map pop(%record (qf) %name q)
   %record (qf) %name old
   %if q_link == null %then old == null %elsestart
      %if q_link_link == q_link %start ;!One element only on Q
         old == q_link
         q_link == null
      %else
         old == q_link_link
         q_link_link == old_link
      %finish
      q_count = q_count - 1
   %finish
   %result == old
%end
%include "INC_EXTS"
%routinespec increment(%integer txrx, length)
%externalstring (15) %fnspec itos(%integer no, width)
%integerfnspec next free lcn(%integer dcedte)
%integerfnspec acknowledge(%byte seqno)
%routinespec get buffer(%byte fn, length)
%routinespec maybe send rr(%record (mef) %name mes)
%routinespec move(%integer len, from, to)
%routinespec cbuff
%routinespec cpon(%record (pf) %name p)
%routinespec pull(%record (qf) %name q,item)
%routinespec query processes
%routinespec reject call(%integer qualifier)
%routinespec reject connect(%integer fn, qualifier)
%routinespec release process
%string (255) %fnspec sub string(%record (mef) %name mes, %integer no)
#if ~m
%routinespec subtract times
#fi
%routinespec buffer arrived
%string (15) %fnspec form facilities(%integer flags)
%routinespec free buffer(%record (mef) %name mes)
%routinespec handle ts packet
%routinespec handle clock tick
%routinespec handle outq
%routinespec handle line input
%routinespec handle line output
%integerfnspec interpret facilities(%integer fn, %bytearrayname f)
%routinespec monitor(%record (pf) %name p, %integer type)
%routinespec pack bcd string(%string(255) s,%bytearrayname a, %integername index)
%routinespec packchar(%byte char, %record (mef) %name mes)
%integerfnspec packetlength(%integer fn)
%routinespec pack string(%string(255)%name s,%record (mef) %name mes)
%routinespec pack ts string(%string(255) s, %string (255) %name t)
%routinespec restart processes
%integerfnspec stoi(%string (15) s)
%routinespec stop(%integer reason)
%routinespec to account(%record (mef) %name mes, %integer fn)
%routinespec to lower(%record (mef) %name mes, %integer fn, datal)
%routinespec to upper(%record (mef) %name mes, %integer fn)
%string (63) %fnspec ts substring(%record (mef) %name mes, %integer ptr, no)
%string (15) %fnspec unpack bcd string(%bytearrayname a,%integer no)
%routinespec unravel ts(%string (63) %name ts addr, ts params, %integername line)
%integerfnspec wp to facs(%string (31) facs, %string (31) %name pssfacs)


!***************************************
!*                                     *
!*           Main  Program             *
!*                                     *
!***************************************

linkin(from xprot);!dentify ourself to DEIMOS for receiving messages
change out zero = t3 ser ;!Use buffered console I/O
map virt(buffer manager,5,4) ;!Get access to buffer pool
map virt(buffer manager,6,5)

printstring("GATX Running") ;newline
charno(fac, 1) = 1
tsprotb == string(addr(protb(0)))
xxxprotb == string(addr(protb(5)))

%for i = 1, 1, no of x25 nets %cycle
   linetab(i)_procno = i
   push(free lq, linetab(i))
%repeat

%for i=1,1,no of procs %cycle ;!Initialise our main tables
   proctab(i)_procno = i ;!Give each process a process no.
   push(free pq,proctab(i))
%repeat

poff(p) ;!Wait for configuration message from loader
dcedte = p_fn ;!Are we a DCE or a DTE?
linkin(gatex ser)
#if ~f
monbyte = p_process ;!Set monitoring level
#fi
shutters up = p_c2 ;!This enables us to come up refusing connections

!Grab a spare buffer for double-buffering buffer requests
p_ser = buffer manager ;p_reply = id
p_fn = request buffer ;p_len = short
ponoff(p)
push(short q, p_m)


alarm(100) ;!Set off a 2-second clock tick

%cycle ;!We never leave this loop
   
   p_ser = 0 ;!Accept anything
   poff(p)   ;!Wait for a message

   %if p_ser = gatex ser %start ;!A message from the higher levels (PCMs)
      handle ts packet

   %elseif p_reply = 0 ;!Clock tick message
      handle clock tick

   %elseif p_reply = buffer manager ;!A buffer request has been granted
      cbuff
      buffer arrived

   %elseif p_fn = line input ;!Something from the comms line handler
      cbuff
      handle line input

   %finishelse handle line output

%repeat



!****************************************
!*                                      *
!*            Routines                  *
!*                                      *
!****************************************
!*


%integerfn acknowledge(%byte seqno)
   !Update AAA from incoming N(R) unless we have a bad ack
   %byte acks

   acks = (seqno - process_aaa) & 7
   %result = bad ack %unless acks <= (process_ttt - process_aaa) & 7

   process_aaa = seqno
   !Right. process_acks counts the number of immediate acks that were
   !done. If this is positive, we reduce the no. of acks we send up.
   process_acks = process_acks - acks
   %if process_acks < 0 %start
      p_s1 = -process_acks
      process_acks = 0
      to upper(null, ack)
   %finish

   %result = 0
%end ;!of Acknowledge



%routine get buffer(%byte reason, length)
   !This routine pulls a buffer off its private queue if its got one and fires
   ! off a buffer request to Buffer Manager if it hasn't
   
   p_process = process_procno
   p_c2 = reason
   !Check on reason prevents recursive calls
   %if short q_count = 0 %or reason = 0 %or length = long %start
      p_ser = buffer manager ;p_reply = id
      p_fn = request buffer 
      p_len = length
      pon(p)
   %else
      p_m == pop(short q)
      buffer arrived
      get buffer(0, short)
   %finish
   
%end ;!of get buffer


%routine buffer arrived
   !A previously issued buffer request has been granted.
   !P_C2 was set up in get buffer and tells us why we
   !asked for it.
   %integer l
   %string (63) s
   %record (mef) %name mes
   %bytename state

   mes == p_m
   mes_l = 0
   process == proctab(p_process)
   state == process_state
   line == process_linelink

   %if p_c2 = rr %and 3 <= state <= 4 %start ;!Value 1
      maybe send rr(mes)

   %elseif p_c2 = restart indication ;!Value 251
      !Note PROCESS points to LINE process
      line == linetab(p_process)
      %if line_state = restarting %then to lower(mes, restart indication, -1) %c
      %else free buffer(mes)

   %elseif p_c2 = clear request ;!Value 19
      free buffer(pop(process_outq)) %while process_outq_count # 0
      %if state = estb %or state = wait data %or state = wtacn %start
         to lower(mes, clear request, 0) ;clrtx = clrtx + 1
         state = wtdsn2 ;process_quiettime = 6

      %elseif state = wtaci
         to lower(mes, clear request, 0) ;clrtx = clrtx + 1
         state = wtdsn

      %else
         free buffer(mes)
      %finish

   %elseif (p_c2 = interrupt%or p_c2 = reset request %or p_c2 = reset confirmation) %c
   %and 3 <= state <= 4 ;!Values 35, 27, 31
      to lower(mes, p_c2, 0)

   %elseif p_c2 = disconnect ;!Value 3
      process_substate = process_substate & (\2)
#if ~m
      subtract times
#fi
      packstring(process_cv_s, mes)
      %unless process_clrbuff == null %start
         !We held onto the clear packet so we could extract its parameters
         !We stuck the user data length in clrbuff_fn to save us recalculating it

         l = process_clrbuff_l - process_clrbuff_fn - 3;!points to start of UD
         s = ts substring(process_clrbuff, l, 1)
         packstring(s, mes)
         s = ts substring(process_clrbuff, l, 2)
         packstring(s, mes)

         !OK we've finished with the clear - send it off as a clear conf. & 
         !decouple LCN

         to lower(process_clrbuff, clear confirmation, 0) ;clrctx = clrctx + 1 ;process_clrbuff == null
         line_lcntab(process_lcn) = 0 ;process_lcn = 255
      %finish

      p_s1 = process_cv_reason
      %if state = estb %or state = wtaci %or state = wdaci %start
!         P_S1 = 1 ;!Bound to be a Disconnect in response to a received Disconnect
         to upper(mes, disconnect)
         state = wtdsi

      %elseif state = wtacn %or state = wtdsn2 %or state = wait data
         to upper(mes, disconnect)
         release process

      %elseif state = wtdsn
         to upper(mes, disconnect)
         process_taskport = 0 ;!Decouple process from higher level

      %else
         free buffer(mes)
      %finish

#if ~m
   %elseif p_c2 = checkpoint %and 3 <= state <= 4 ;!Value 45
      subtract times
      mes_s = process_cv_s
      to account(mes, checkpoint)

#fi
   %elseif p_c2 = call accepted ;!Value 15
      accrx = accrx + 1
      process_substate = process_substate & (\1)
      mes_data(0) = 0 ;!Address lengths (=0)
      mes_data(1) = 0
      mes_l = 2
      to lower(mes, call accepted, -1) ;acctx = acctx + 1
      %if process_tsflag = 0 %start
         process_substate = process_substate ! 4 ;get buffer(ts accept, short)
      %finishelse handle outq

   %elseif p_c2 = ts accept ;!Value 17
      process_substate = process_substate & (\4)
      !OK. We've sent the TS accept - tell ACKNOWLEDGE to swallow the first Ack.
      process_acks = process_acks + 1
      mes_l = 1 ;mes_fn = x'80'
      mes_data(0) = ts accept
      to lower(mes, dce data, 0) ;datatx = datatx + 1
      process_ttt = (process_ttt + 1)&7
      handle outq

   %else ;!Only expected one is Value 0
      %if short q_count = 0 %then push(short q, mes) %else free buffer(mes)
   %finish

%end ;!of Buffer Arrived

%routine cbuff
   %unless p_m == null %start
      !Buffer type bits not 0 or 64 constitutes a disaster
      stop(98) %if 0 # p_m_type # 64
      !Buffer pointer should be in range k'100000' - k'137777' and should be a
      !multiple of k'100'.   Look at top 2 bits and bottom 6.
      stop(96) %unless p_b & k'140077' = k'100000'
      buffers held = buffers held + 1
   %finish
%end

%routine cpon(%record (pf) %name p)
   !As PON, but a) check buffer is valid first and b) decrement count
   %unless p_m == null %start
      stop(99) %if 0 # p_m_type # 64
      stop(97) %unless p_b & k'140077' = k'100000'
      buffers held = buffers held - 1
   %finish
   pon(p)
%end

%string (15) %fn form facilities(%integer flags)
   %string (15) facs
   !Takes two sets of information: 1) The current facilities
   !values and 2) which of these are to be passed on.
   !It then creates a facilities field of the form "W=m/n,P=m/n"

   facs = ""

   %if flags & ww set # 0 %start ;!We want to specify a window size
      facs = "W=".itos(process_ww in, -1)."/".itos(process_ww out, -1)
      facs = facs."," %if flags & ps set # 0
   %finish

   %if flags & ps set # 0 %start ;!Specify packet size
      !Note PSS transfers packet size as n, where 2**n = size
      facs = facs."P=".itos(1<<process_ps in, -1)."/".itos(1<<process_ps out, -1)
   %finish

   %result = facs
%end ;!of Form Facilities

%routine free buffer(%record (mef) %name mes)
   %record (pf) p
   %unless mes == null %start
      !There really is a buffer
      %if mes_type = short %and short q_count < critical short %start
         push(short q, mes)

      %else
         !Tell Buffer Manager it can have its buffer back.
         p_ser = buffer manager ;p_reply = id
         p_fn = release buffer
         p_m == mes
         cpon(p)
      %finish
   %finish
%end ;!of Free Buffer

%routine handle clock tick
   %record (mef) %name mes
   %integer i,j

#if ~m
   !Maintain time-since-IPL timer
   curtime_a(3) = curtime_a(3) + 2
   %if curtime_a(3) = 60 %start ;!Seconds wrap-round
      curtime_a(3) = 0
      curtime_a(2) = curtime_a(2) + 1
      %if curtime_a(2) = 60 %start ;!Minutes wrap-around
         curtime_a(2) = 0
         curtime_a(1) = curtime_a(1) + 1
         %if curtime_a(1) = 24 %start ;!Hours wrap-around
            curtime_a(1) = 0
            curtime_a(0) = curtime_a(0) + 1
         %finish
      %finish
   %finish
#fi

   !1) Time out stuck calls
   !2) Checkpoint
   !3) Poll restarts at link startup
   !4) release any RNR condition still up
   %if busy q_count # 0 %start
      line == busy q
      %for i = 1,1,busy q_count %cycle
         line == line_link
         %if line_call q_count # 0 %start
            process == line_call q
            %for j = 1,1,line_call q_count %cycle
               %if line_state = established %start
                  process == process_link
   
   #if ~m
                  %if curtime_a(3) = 0 %and curtime_a(2)&3 = 0 %then get buffer(checkpoint, short)
                  !Checkpoint on every 4th minute
   #fi
   
                  %if process_state = estb %and process_substate & 48 # 0 %start
                     maybe send rr(null)
   
                  %elseif process_state = wait data
                     process_quiettime = process_quiettime - 1
                     %if process_quiettime = 0 %then get buffer(clear request, short)
   
                  %elseif process_state = wtdsn2 ;!We'll lose stats record.
                     process_quiettime = process_quiettime - 1
                     %if process_quiettime = 0 %start
                        %if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long) 
                        process_state = wtdsn
                     %finish
   
                  %finish
               %elseif line_state = restarting
                  line_time = line_time + 1
                  %if line_time & 3 = 0 %then process == line %and get buffer(restart indication, short)

               %finish
            %repeat
         %finish
      %repeat
   %finish

   %if int & x'DF' = 'D' %start
      shutters up = 1 - shutters up

   %elseif int & x'DF' = 'C'
      mon cons = 1 - mon cons

   %elseif int = 'V'
      printstring("GATX Running") ;newline

#if ~f
   %elseif int = 'N'
      selectoutput(1)
      close output ;!Close current trace file (Selectoutput 1) and start another
#fi

   %elseif int = '?'
      query processes
      monitor(null,query) ;!Display process variables

#if ~f
   %elseif '0' <= int <= '9'
      monbyte = int - '0' ;!Change monitoring level
#fi

   %finish
   int = 0
   alarm(100)
   
%end ;!of HANDLE CLOCK TICK


%routine handle line input
   %string(63) caller, called, caller params, called params, exptext, s, t
   %string (23) facs
   %string(4) protb
   !Lengths:  Packets come in with the full level 3 data length
  !(Packet header + data)
   %string(2) subaddr
   %bytearrayname data
   %record (mef) %name mes
   %bytename state
   %byte nr,ns,fn,x,cudfl,facl,lcgn,dtel
   %integer i,j, rc
   monitor(p, from low)
   %if p_m == null %then monitor(p, bad block) %and %return
   mes == p_m ;data == mes_data
   fn = mes_fn
   
   !Identify which line it came in on

   %if busy q_count # 0 %start
      line == busy q_link
   
      %for i = 1, 1, busy q_count %cycle
         -> found line %if p_process = line_lineno
         line == line_link
      %repeat
   %finish
   
   monitor(p, bad process)
   free buffer(mes)
   %return

found line:
   lcgn = mes_octet1&15;!Received LCGN
   %if fn = incoming call %start
      !Can occur in any state but only IDLE accepted
      
      %if line_state = established %start
         !Set up a process if one is available and does not exist already
         %if line_call q_count # 0 %start
            process == line_call q
            %for i = 1, 1, line_call q_count %cycle
               process == process_link
               %if process_lcgn = lcgn %and process_lcn = mes_lcn %start ;!LCGN and LCN clash - Call collision
                  !PSS X-25 Call collision: DCE accepts the Call Request
                  !and a)  forgets about its Incoming Call then b) rejects the CONNECT
                  !which generated it. Ultimately it will retry on another LCN
                  !DTE just ditches the Incoming Call as it knows the DCE
                  !will handle it.
   
                  !If the other process is not waiting for a call accepted
                  !(Call connected) then it is an error and should be ditched
                  monitor(p, mon call collision)
                  %if line_dcedte = dte %or process_state # wtacn %start
                     free buffer(mes)
                     %return
                  %else
                     p_s1 = call collision
                     to upper(null, disconnect)
                     release process
                     %exit ;!Should not be TWO active processes with the same LCN
                  %finish
               %finish
            %repeat
         %finish
         
         %if line_lcntab(mes_lcn) = 0 %start ;!Make sure he isnt using a busy stream
            process == pop(free pq)
            %unless process == null %start ;!There is a process available
            
               !Zero the entire process but save its process number
               i = process_procno ;process=0 ;process_procno = i
               push(line_call q,process) ;!Queue it on busy process q
               state == process_state ;process_lcgn = lcgn
#if m
               process_cv_l = 3
#else
               process_cv_l = 15 ;!Set up call statistics record
#fi
               process_lcn = mes_lcn ;line_lcntab(mes_lcn) = 1
               process_linelink == line
               %if shortnetname(line_line no) = "S" %then process_ww in = 1 %else process_ww in = 2
               process_ww out = process_ww in
#if ~m
               process_time = curtime
#fi
               !TSTATE = Clear, OUTQ == NULL implicitly
               !Extract DCE & DTE addresses, facilities and Call User Data field
               !From Incoming call packet
               caller = unpack bcd string(data,1)
               called = unpack bcd string(data, 0)
      
               %if shutters up # true %start
                  !strip off subaddress if present and put its value in rc
                  %if length(called) = 14 %then rc = (data(7)>>4)*10+data(7)&15 %else rc = 0
                  dtel = (data(0)>>4 + data(0)&15 + 1)>>1 ;!Length of DTE addresses
                  facl = data(dtel+1) ;!Length of facilities field
                  i = interpret facilities(incoming call, data)
                  %if i >= 0 %and factot > 0 %start
                     cudfl = mes_l - facl - dtel - 5
                     process_fac = i
                     !Three bytes header + Length of DTE/DCE addresses + Facilities length = 5
                     increment(rx, cudfl)
                     facs = form facilities(i)
                     %if cudfl >= 4 %then length(protb) = 4 %else length(protb) = cudfl
                     move(length(protb), addr(data(dtel+facl+2)), addr(protb)+1)
                     !It's only true T.S. if Protocol bytes are 127-255-255-255
                     process_tsflag = 1 %if protb # tsprotb
                     %if no of x25 nets > 1 %and line_lineno # default line %then caller = shortnetname(line_lineno).".".caller
                     !Try and unscramble addresses TS-style.
                     called params = ts substring(mes, dtel+facl+6, 1)
                     !Strip any accrediting info. off the front, discard it and leave residue in t.
                     t = called params %unless called params -> ("(").s %and s -> s.(").").t
                     !t now contains <dest>.<facility>.<residue) or <facility>
                     s = t %unless t -> t.(".").s
                     !s now contains <facility> if address is valid
                     process_task id = 0
                     %for i = 0,1,factot-1 %cycle
                        %if s -> (faclist(i)_facility).s %then process_task id = faclist(i)_ser
                     %repeat

                     !All unknown non-TS traffic -> XXX enabler if there is one.
                     %if process_task id = 0 %and process_tsflag # 0 %start
                        %for i = 0, 1, factot-1 %cycle
                           %if faclist(i)_facility = "XXX" %then process_task id = faclist(i)_ser %and %exit
                        %repeat
                     %finish

                     %if process_task id # 0 %start
                  
                        caller params = ts substring(mes, dtel+facl+6, 2)
                        caller = caller.".".caller params %unless caller params = ""
                        exptext = ts substring(mes, dtel+facl+6, 4)

                        %if mon cons # 0 %start
                           printstring("GATX In Call:") ;printstring(caller)
                           printstring("->") ;printstring(called)
                           printsymbol('.') ;printstring(called params)
                           newline ;printstring(" F:") ;printstring(facs)
                           printstring(" E:") ;printstring(exptext)
                           printstring(" fails") %if j < 0
                           newline
                        %finish

                        mes_l = 0
                        packstring(called params, mes) ;!Called
                        packstring(caller,mes) ;!Caller
                        packstring(facs, mes) ;!Facilities/Quality
                        packstring(exptext, mes) ;!Explanatory Text
                       %if process_tsflag # 0 %then packstring(protb, mes)
                        p_s1 = process_tsflag
                        to upper(mes, connect)
                        process_state = wtaci

                     %else
                        process_state = wtdsn
                        mes_data(1) = prot not supported
                        to lower(mes, clear request, 0) ;clrtx = clrtx + 1
                     %finish
                  %else
                     process_state = wtdsn
                     mes_data(1) = ts incompatible facilities
                     to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
                  %finish
               %else
                  process_state = wtdsn
                   mes_data(1) = ts going out of service
                  to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
               %finish
            %else ;!No free processes
               !Note: a clear confirmation will come back with no process
               reject call(ts number busy)
            %finish
         %finishelse reject call(lcn conflict)
      %finishelse free buffer(mes) ;!Ignore Calls while restarting or down

   %elseif fn = restart indication
      !Clear down Network side (all processes) completely and 
      !Interface (upper) side tidily.
      rstrx = rstrx + 1
      %if line_state = restarting %start
         p_len = 0
         to account(null, hello) ;!Tell Account line is up
         line_state = established
         free buffer(mes)
      %else
         mes_fn = restart confirmation
         !Dont use TO LOWER as we dont have a process
         i = p_ser ;p_ser = p_reply ;p_reply = i ;!Send it back whence it came
         p_fn = line output
         !P_M == MES already
         p_len = 3
         rstctx = rstctx + 1
         pon(p)
         restart processes
      %finish

   %elseif fn = restart confirmation
      rstcrx = rstcrx + 1
      %if line_state = restarting %start
         p_len = 0
         to account(null, hello) ;!Tell Account line is up
         line_state = established
      %finish
      free buffer(mes)
   %else

      !There ought to be a process for this message on the circular
      !List queued off LINE_CALL Q
      %if line_call q_count # 0 %start
         process == line_call q
         %for i = 1,1,line_call q_count %cycle
            process == process_link
            %if process_lcgn = lcgn %and process_lcn = mes_lcn %then -> found it ;!Correct LCGN and LCN
         %repeat
      %finish
   
      %if fn = clear request %start
         !He thinks the call is up - we don't.   Let's put him out of his misery
         !By confirming his clear.
         reject call(spurious clear req)

      %else
         %if fn # clear confirmation %then monitor(p,bad instate)
         !Should have been a process if it wasnt an incoming call
         free buffer(mes)
   
      %finish
      %return
   
found it:

      state == process_state
      %if fn&3 #3 %start ;!Data,RR,RNR, (REJ)
         nr = fn>>5 ;fn = fn&x'1F' ;!Remove R: Next block expected
      %finish

      %if fn = rr %start
         !Level 3 RR
         process_tstate = clear ;!Clear remote RNR if set against us.
         rrrx = rrrx + 1
         ->end1

      %elseif fn & 1 = 0
         !Level 3 data block.
         ns = (fn>>1)&7 ;!Block sequence no.
         m = fn&x'10'
         increment(rx, mes_l-3) ;!Increment will catch case where mes_l-3 < 0
         %if 3 <= state <= 4 %and process_rstate = clear %start
            rc = acknowledge(nr)
            %if rc # 0 %then -> chop
            %if ns = process_eee %start ;!Level 3 sequence OK
               datarx = datarx + 1
               process_eee = (process_eee + 1) & 7
               p_s1 = 1 - m >> 4 ;!Push it if asked to
               mes_l = mes_l - 3 ;!User data length only
         
               %if mes_octet1 < 128 %start ;!Ordinary data and Push
                  to upper(mes, input here)
         
               %elseif mes_l = 0 ;!Ignore any zero-length blocks we may receive
                  process_ccc = (process_ccc + 1) & 7
                  maybe send rr(mes)
         
               %elseif process_tsflag = 1 ;!Control data, not T.S.
                  to upper(mes, control input here)
         
               %else ;!Control data, T.S.
                  !We don't implement this yet so discard it (nasty isnt it)
                  process_ccc = (process_ccc + 1) & 7
                  maybe send rr(mes)
         
               %finish
         
               handle outq
            %else ;!Sequence error - shouldn't happen
               derrrx = derrrx + 1
               process_cv_reason = packet level error
               to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
               process_state = wdaci
            %finish
         %finishelse free buffer(mes)

      %elseif fn = rnr
         !Level 3 RNR
         process_tstate = set ;!Remote RNR set against us.
         rnrrx = rnrrx + 1
         ->end1

      %elseif fn = call connected
         %if process_fac & restricted response bit = 0 %start
            !Reply to call request to Network
            !Work out user data length for stats
            %if mes_l >= 5 %start
               dtel = (data(0)>>4 + data(0) & 15 + 1)>>1
               facl = data(dtel + 1)
               increment(rx, mes_l - dtel - facl - 5)
            %finish
            !Expect in states WTACN or WTDSN2
            %if state = wtacn %start ;!Call now successfully established.
               i = interpret facilities(call connected, data)
               state = estb
               facs = form facilities(i)
               mes_l = 0
               packchar(0, mes) ;!Recall Address
               %if length(facs) # 0 %then packstring(facs, mes) %else %c
               free buffer(mes) %and mes == null
               p_s1 = process_tsflag ;!For benefit of PCMs.
               to upper(mes, accept call)
               handle outq
            %finishelse free buffer(mes)
         %else
            to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
            process_state = wtdsn
            p_s1 = short call accepted
            to upper(null, disconnect)
         %finish
   
      %elseif fn = clear confirmation %or fn = clear indication
         %if fn = clear confirmation %start
            !Expect in states WTDSN,WTDSN2
            clrcrx = clrcrx + 1
         %else
            !Expect in any state
            clrrx = clrrx + 1
            process_cv_reason = call cleared ;process_cv_cause = data(0) ;process_cv_diags = data(1)
         %finish
         %if mes_l > 5 %start ;!Fastselect or extended formats may have user data
            !DCE Clear Confirmation doesnt have the Cause & Diags fields
            %if fn = clear confirmation %and line_dcedte = dte %then i = 0 %else i = 2
            dtel = (data(i)>>4 + data(i) & 15 + 1)>>1
            facl = data(dtel + 3)
            cudfl = mes_l - dtel - facl - i - 5
            increment(rx, cudfl)
         %finish
      
         i = interpret facilities(fn, data) ;!to get call stats if present
         free buffer(pop(process_outq)) %while process_outq_count # 0
      
         !We either reply immediately to a clear (in which case we
         !decouple ourselves from the LCN) or we hold on to it till we get
         !the disconnect buffer so we can write up the parameters
         %if state = wtdsn %start
            line_lcntab(process_lcn) = 0 ;process_lcn = 255 
            free buffer(mes)
            %if process_substate & 2 # 0 %start
               !We are in the process of disconnecting a call by timeout
               state = wtdsn2 ;process_quiettime = 6
            %finishelse release process
         %else
            %if 1 <= state <= 5 %start
               !Evidence is that this packet is charged for in advance by PSS
               process_clrbuff == mes ;mes_fn = cudfl
            %else
               free buffer(mes)
               line_lcntab(process_lcn) = 0 ;process_lcn = 255
            %finish
            process_substate = process_substate ! 2 ;get buffer(disconnect, long)
      
         %finish
   
      %elseif fn = interrupt
         !Action in state ESTB only
         intrx = intrx + 1
         increment(rx, 0)
         to lower(mes,interrupt confirmation, 0) ;intctx = intctx + 1
         %if state = estb %start
            %if mes_l > 3 %then x = data(0) %else x = 'A'
            !Interrupt user data (one byte only)
            p_s1 = x
            to upper(null,expedited data)
         %finish

      %elseif fn = interrupt confirmation
         intcrx = intcrx + 1
         increment(rx, 0)
         process_istate = 0 ;!Clear interrupt pending condition
         free buffer(mes)

      %elseif fn = reset indication
         increment(rx, 0)
         printstring("Reset") ;write(data(0), 1) ;printsymbol('/')
         write(data(1), 1) ;newline
         resrx = resrx + 1
         %if process_rstate = clear %or process_rstate = wrstn %start
            !Either out of the blue or we were expecting one from Network
            to upper(mes, reset)
            process_rstate = wrsti
         %finishelse free buffer(mes)

      %elseif fn = reset confirmation
         %if process_rstate = wrstn %start
            to upper(mes, reset)
            free buffer(pop(process_outq)) %while process_outq_count # 0
            process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0
            process_tstate = clear
            process_rstate = clear
         %finishelse free buffer(mes)

      %elseif fn = rej
         !Level 3 REJ. Shouldn't get this.
         rc = mon rej recd ;->chop

      %else
         monitor(p,bad fn)
         free buffer(mes)
      %finish
   %finish
   %return
   

end1:
   %if 3 <= state <= 4 %and process_rstate = clear %start
      rc = acknowledge(nr)
      %if rc # 0 %then -> chop
      handle outq
   %finish
   free buffer(mes)
   %return

chop:
   monitor(p, rc)
   process_cv_reason = packet level error
   to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
   process_state = wdaci
   %return


%end ;!of HANDLE LINE INPUT


%routine handle line output
   %integer i
   monitor(p, from low)
   %if p_len = xprot hello %start ;!Init message at Task startup (one only per task)
      line == pop(free lq) ;!Get a line process
      %unless line == null %start ;!Got one OK.
         i = line_procno ;line = 0 ;line_procno = i
         push(busy q, line)
         line_state = down
         line_ser = p_reply
         line_line no = p_process ;default line = line_lineno %if default line < 0
         line_dcedte = (dcedte>>line_lineno) & 1
         line_lcgn = 4
         line_writes left = max writes
      %finishelse stop(mon no procs)
   %else ;!Line Up/Down or write ack
   !XPROT hello is first thing XPROT sends so should always be at least
   !one line in queue by now.
   line == busy q_link
   %for i = 0, 1, busy q_count-1 %cycle
      -> found line %if line_line no = p_process
      line == line_link
   %repeat
   monitor(p, bad process)

found line:
      %if p_len = 1 %start  ;!Link down message
         to account(null, hello)
         monitor(null,line down)
         restart processes
         line_state = down
      %else
         %if line_state = down %start
            printstring(longnetname(line_lineno)) ;printstring(" Line Up") ;newline
            monitor(null,line up)
            process == line ;!For benefit of get buffer
            line_state = restarting
            get buffer(restart indication, short)
         %finish
      %finish
   %finish
%end ;!of HANDLE LINE OUTPUT



%routine handle outq
   !Send off what we can from the output queue
   %record (mef) %name mes
   %return %unless 3 <= process_state <= 4
   %return %if process_substate & 5 # 0
   %while process_tstate = clear %and process_outq_count # 0 %c
   %and (process_ttt - process_aaa)&7 < process_ww out %cycle
      mes == pop(process_outq)
      to lower(mes,dte data, mes_l) ;datatx = datatx + 1
      process_ttt = (process_ttt+1)&7
   %repeat

   %if process_state = wait data %and process_outq_count = 0 %then %c
   get buffer(clear request, short)
%end ;!of HANDLE OUTQ


%routine handle ts packet
   %string(63) caller, called, called params, cudf, exptext
   %string (31) facs
   %record (mef) %name mes
   %bytename state
   %byte r,s
   %integer flags
   %integer fn,lcn,lineno,l,i,j
   %string(7) ls
   
   mes == p_m ;fn = p_fn
   cbuff %unless fn = enable facility %or fn = disable facility
   monitor(p, from up)
   
   %if fn = connect %start
      called = substring(mes, 1)
      unravel ts(called, calledparams, lineno)
   
      %if busy q_count # 0 %start
         line == busy q
         %for i = 1, 1, busy q_count %cycle
            line == line_link
            %if line_lineno = lineno %and line_state = established %then -> ok
         %repeat
      %finish
      reject connect(fn, network down)
      %return
   ok:
      !Scan calls on this line to ensure this is not a duplicate request
      
      %if line_call q_count # 0 %start
         process == line_call q
         %for i = 1,1,line_call q_count %cycle
            process == process_link
            %if process_task id = p_reply %and process_task port = p_task port %start ;!Duplicate request
               monitor(null, mon process running)
               reject connect(fn, process running)
               %return
            %finish
         %repeat
      %finish
      
      lcn = next free lcn(line_dcedte)
      %if lcn >= 0 %start ;!Got a free LCN
         process == pop(free pq)
         %unless process == null %start ;!All OK.
            !Record the connection and send off a Call Request
      
            i = process_procno ;process=0 ;process_procno = i
            push(line_call q,process)
#if m
            process_cv_l = 3
#else
            process_cv_l = 15
#fi
            process_tsflag = p_s1
            !Tstate = Clear, OUTQ_COUNT = 0 implicitly
   
            %if shortnetname(line_lineno) = "S" %start
               !SERCNET has different defaults from other X25 networks
               process_ww in = 1
            %else
               process_ww in = 2
            %finish
            process_ww out = process_ww in
   
            process_linelink == line ;!Reverse link for speed
            process_task port = p_task port
            process_lcgn = line_lcgn
            process_lcn = lcn
            process_task id = p_reply
            caller = substring(mes, 2)
            facs = substring(mes, 3) ;!Facilities/Quality
            exptext = substring(mes, 4) ;!Call User Data/Explanatory Text
            %if mon cons # 0 %start
               printstring("GATX OutCall:") ;printstring(caller)
               printstring("->") ;printstring(called)
               printsymbol('.') ;printstring(called params)
               printstring(" Q:") ;printstring(facs)
               printstring(" E:") ;printstring(exptext)
               newline
            %finish
            i = wp to facs(facs, facs)
            !1st "facs" passed by value, 2nd by name. Not as nasty as it looks
            %if i >= 0 %start ;!All OK
         
               mes_data(0) = length(called)&15
               index = 2 ;!Index counts in quartets not bytes
               pack bcd string(called, mes_data, index)

               !last field is explanatory text for TS calls and verbatim CUDF
               !otherwise. Null CUDF in a non-TS call will be assumed to be XXX
               !and will set protocol bytes 1-0-0-0 and TS called and caller strings


               %if process_tsflag = 0 %or exptext = "" %start
                  !If T.S. protocol bytes must be 127-255-255-255.
                  !If not, assume XXX (1-0-0-0). SERC-ITP must set CUDF explicitly.
                  %if process_tsflag = 0 %then cudf = tsprotb %else cudf = xxxprotb
                  pack ts string(called params, cudf)
                  pack ts string(caller, cudf)
                  %if process_tsflag = 0 %start ;!TS only
                     pack ts string(nullstr, cudf)
                     pack ts string(exptext, cudf)
                  %finish
               %finishelse cudf = exptext
               %if length(cudf) > 16 %then process_fac = process_fac ! fast select bit
               %if process_fac # 0 %start
                  charno(fac, 2) = process_fac ;facs = facs.fac
               %finish
   
               string(addr(mes_data(index>>1))) = facs
               index = index + length(facs)<<1 + 2
               move(length(cudf), addr(cudf)+1, addr(mes_data(index>>1)))
               index = index + length(cudf)<<1
               mes_l = index>>1 ;!Length of data + header (Used by TO LOWER)
               i = interpret facilities(call request, mes_data)
#if ~m
               process_time = curtime
#fi
               to lower(mes,call request, length(cudf)) ;calltx = calltx + 1
      
               !Connect may be specified to be a datagram by using "C=S"
                process_state = wtacn
            %else
               monitor(null, mon bad param)
               line_lcntab(lcn) = 0
               reject connect(fn, bad param)
               release process
            %finish
         %else
            line_lcntab(lcn) = 0
            reject connect(fn, gateway full)
         %finish
      %else
         monitor(null, mon no free lcns)
         reject connect(fn, no free lcns)
      %finish

   %elseif fn = enable facility %or fn = disable facility
      !First get facility string from P or P_M (According to P_S1)
      %if p_s1 = 0 %start
         facs = p_facility
      %else
         facs = mes_s
         free buffer(mes)
      %finish
   
      !Note that once assigned the facility has a table entry for ever
      !Next, look throught table and see if we know about this one
   
      %if factot # 0 %start
         %for i = 0, 1, factot-1 %cycle
            %if faclist(i)_facility = facs %then -> assigned already
         %repeat
      %finish
   
      !Never heard of it. Make a new table entry if we can.
      i = factot
      %return %if factot = facmax
      factot = factot + 1
      faclist(i)_facility = facs

assigned already:
      !Non-zero SER indicates is is enabled. Zero SER = disabled
      %if fn = enable facility %then faclist(i)_ser = p_reply %else faclist(i)_ser = 0

#if m
   %elseif fn = prod
      monchan = p_s1

   %elseif fn = poke
      p_s1 = 0
      %if p_c2 = 0 %start
         p_c1 =no of procs - free lq_count - free pq_count ;p_c2 = buffers held

      %elseif p_c2 = 1
         p_c = addr(datarx)

      %elseif p_c2 = 2
         p_c = addr(factot)

      %elseif p_c2 = 3
         p_c = addr(busy q)

      %finish
      i = p_ser ;p_ser = p_reply ;p_reply = i
      cpon(p)
      %return
#fi

   %else
      !Process numbers: Processes are identified by two process numbers,
      !but usually GATE PORT. In the case of CONNECT or DISCONNECT before
      !ACCEPT CALL this is not known, so GATE PORT is 0 and the process is
      !identified by the sender's process TASK PORT
      %if 1 <= p_gate port <= no of procs %start
         !He correctly specified one of our processes
         process == proctab(p_gate port)
         ->found it
      %else
         %if busyq_count # 0 %or p_gate port # 0 %start
         !He specified his process only and there are processes active
            line ==    busy q
            %for i = 1, 1, busy q_count %cycle
               line == line_link
               %if line_call q_count # 0 %start
                  process == line_call q
                  %for j = 1, 1, line_call q_count %cycle
                     process == process_link
                     %if process_task port=p_task port %then ->found it
                  %repeat
               %finish
            %repeat
         %finish
      %finish
      !Failed to find a process corresponding to specified proc.no
      monitor(p,bad process)
      free buffer(mes)
      %return
      
   found it: state == process_state
   
      line == process_linelink
      %if fn = put output %or fn = put control output %start
         !Control data (for transmission with QBIT = 1 is flagged by a x'80'
         %if fn = put output %then mes_fn = 0 %else mes_fn = x'80'
         %if line_state # down %and state = estb %and process_rstate = clear %start ;!Data only valid in established call
            push(process_outq,mes)
            !We ignore the PUSH bit in P_S1 since all data is acknowleged
            !end-to-end anyway
            !MES_L contains length of Level 3 user data
            handle outq ;!See if we can send anything.
            %if process_outq_count + (process_ttt - process_aaa) & 7 < process_ww out %start
               !If queued buffers + buffers in transit is less than window, ack
               !immediately and count the no. of times we do so.
               process_acks = process_acks + 1
               p_s1 = 1
               to upper(null, ack)
            %finish
            !Allow upper  level to transmit ahead up to window limit. After that he
            !will get one ack up for each rr received.
         %else
            monitor(p, data outside connect)
            !Line down
            free buffer(mes)
         %finish

      %elseif fn = ack
         %if process_state = estb %and process_rstate = clear %start
            process_ccc = (process_ccc + p_s1) & 7
            maybe send rr(null)
         %finish

      %elseif fn = expedited data
         %if process_istate = 0 %start
            get buffer(interrupt, short)
            process_istate = 1 ;!Block further interrupts or we may get reset
         %finish

      %elseif fn = reset
      
         %if process_rstate = clear %start ;!Out of the blue
            get buffer(reset request, short)
            process_rstate = wrstn
      
         %elseif process_rstate = wrsti
            !Its a confirmation to a reset we issued
            get buffer(reset confirmation, short)
            free buffer(pop(process_outq)) %while process_outq_count # 0
            process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0
            process_tstate = clear
            process_rstate = clear
      
         %finish

      %elseif fn = disconnect
         process_discbuff == mes
         process_cv_reason = p_s1 %if process_cv_reason = 0
         %if state = estb %and process_outq_count # 0 %start
            state = wait data ;process_quiettime = 6
         %else
            %if state=estb %or state=wtacn %or state=wtaci %then %c
            get buffer(clear request, short) %elsestart
               free buffer(pop(process_outq)) %while process_outq_count # 0
               %if state = wtdsi %then release process %else state = wtdsn2 %and process_quiettime = 6
            %finish
         %finish

      %elseif fn = accept call
         !States WTACI, WDACI
         %if state = wtaci %start
            !Connection now fully established. Log his process number and
            process_state = estb
            process_task port = p_task port
            %if mes == null %start
               process_substate = process_substate ! 1 ;get buffer(call accepted, short)
            %else
               i = wp to facs(substring(mes, 2), facs)
               mes_data(0) = 0
               %if i >= 0 %and process_fac & restricted response bit = 0 %start
                  string(addr(mes_data(1))) = facs
                  mes_l = length(facs) + 2
                  to lower(mes, call accepted, -1) ;acctx = acctx + 1
                  %if process_tsflag = 0 %start
                     process_substate = process_substate ! 4 ;get buffer(ts accept, short)
                  %finish
               %else
                  !We didn't like the facilities in the Accept
                  mes_data(1) = bad interface params
                  to lower(mes, clear request, 0) ;clrtx = clrtx + 1
                  process_state = wdaci
               %finish
            %finish
         %finishelse free buffer(mes) ;!Otherwise just ignore it (WDACI, WTDSI) 

      %else
         stop(bad fn)

      %finish
   %finish
   

   %return
   
%end ;!of handle ts


%routine increment(%integer txrx, length)
   %integer i,segs
   !Inefficient but it'll do for now
   !Increment segment count. PSS counts 0-64 bytes = 1 segment
   !65-128 bytes = 2 segments etc. (Obviously not devised by
   !a programmer)

   %if length > 0 %start
      segs = (length-1) >> 6 + 1
   %elseif length = 0
      segs = 1
   %else
      segs = 0
      monitor(p, 64)
   %finish

   !We dont expect SEGS to exceed about 4. Algorithm breaks down
   !for segs >= 255.

#if ~m
   i = process_cv_our segs(txrx) + segs ;!Add on segs
   process_cv_our segs(txrx) = i ;!Jam bottom 8 bits into Our Segs
   %if i > 255 %start ;!There was an overflow (can only be 1 bit)
      %for i = txrx-1, -1, txrx-3 %cycle
         process_cv_our segs(i) = process_cv_our segs(i) + 1 ;!Add to next more significant byte
         %exit %if process_cv_our segs(i) & 255 # 0 ;!Stupid compiler
         !Carry on if we overflowed again
      %repeat
   %finish
#fi
%end ;!of Increment

%integerfn interpret facilities(%integer fn, %bytearrayname f)
   !Integerfn interprets facilities field of incoming packets
   !Note - if it sees one it doesn't recognise or wants to ignore
   !it assumes it occupies 2 bytes.
   %integer i,p,dtel

   %if fn = clear indication %then dtel = 2 %else dtel = 0
   dtel = dtel + (f(dtel)>>4 + f(dtel)&15 + 1)>>1

   i = 0
   p = dtel+2

   %while p < f(dtel+1) + dtel + 2 %cycle
      %if f(p) = x'43' %start
         process_ww in = f(p+1)
         process_ww out = f(p+2)
         i = i ! ww set
         p = p + 1 ;!i.e. one more than basic 2 bytes

      %elseif f(p) = x'42'
         !Not our problem
         process_ps in = f(p+1)
         process_ps out = f(p+2)
         i = i ! ps set
         p = p + 1

      %elseif f(p) = x'C1'
         !Duration always comes before stats
#if m
         p = p + 12
#else
         move(4, addr(f(p+2)), addr(process_cv_pss ct(0)))
         p = p + 4
         move(8, addr(f(p+2)), addr(process_cv_pss segs(0)))
         p = p + 8
         process_cv_l =27
#fi

      %elseif f(p) = 1 ;!Rev. Charging & Fast Select (+/- Rest. Resp.)
         process_fac = f(p+1)
         %if f(p+1) & 1 # 0 %start ;!Reverse charging
            %result = not negotiable

         %elseif f(p+1) & x'C0' = x'C0' ;!Fast Select - Restricted Response
            i = i ! fast select bit ! restricted response bit

         %elseif f(p+1) & x'80' # 0 ;!Fast Select
            i = i ! fast select bit

         %finish
      %finish

      p = p + 2
   %repeat
   %result = i
%end ;!of Interpret Facilities


%routine maybe send rr(%record (mef) %name mes)
   !Send a level 3 RR if we absolutely have to. Defer it otherwise till the next tick

   %if mes == null %then get buffer(rr, short) %and %return

  !The complex condition: Send an RR or RNR if...
   !Cond. 1: We have got a deferred RR or RNR outstanding already
   !Cond. 2: We don't have any buffers queued and he is out of window,
   !Cond. 3: We have buffers queued and he has RNR up against us.
   !Cond: 4: buffers are low

!!   %if process_substate & 48 # 0 %or %c
!!   (process_outq_count = 0 %and (process_ccc - process_aaa) & 7 >= process_ww in) %or %c
!!   (process_outq_count # 0 %and process_tstate = set) %or %c
!!   no of buff < critical long %start

      %if no of buff > critical long %start
         to lower(mes, rr, 0) ;rrtx = rrtx + 1 ;process_substate = process_substate & (\48)
      %else
         to lower(mes, rnr, 0) ;rnrtx = rnrtx + 1 ;process_substate = process_substate ! 32
      %finish
!!   %else
!!      process_substate = process_substate ! 16
!!      !Defer sending anything till next block or timer
!!      free buffer(mes)
!!   %finish
%end ;!of Maybe send rr


%routine monitor(%record (pf) %name p,%integer type)
#if ~f
   %recordformat pfa(%bytearray a(0:27))
   %record (pfa) %name pa
   %integer i,j,k
   
   moncount(type) = moncount(type) + 1
   k = monaction(type)

   %if k = 0 %start
      %return

   %elseif k = 1
      i = monbyte & 2 ;j = 0

   %elseif k = 2
      i = 1 ;j = monbyte & 1

   %else
      i = 1 ;j = 1

   %finish

   %if j # 0 %start ;!Log to .TT
      printstring("*GATX") ;write(type,1) ;newline
   %finish


   %if i # 0 %start
      selectoutput(1)
      %if p == null %start
         printsymbol(2) ;printsymbol(gatex ser) ;printsymbol(type)
      %else
         !Monbyte bit 2**2 set indicates we dont want data monitored
         pa == p ;printsymbol(10) ;printsymbol(gatex ser) ;printsymbol(type)
         %for i = 0,1,7 %cycle
            printsymbol(pa_a(i))
         %repeat
         %unless p_m == null %or p_fn = enable facility %or p_fn = disable facility %start
            pa == p_m
            j = p_m_l + 12
            j = 28 %unless 1 <= j <= 28
            printsymbol(j)
            %for i = 0,1,j-1 %cycle
               printsymbol(pa_a(i))
            %repeat
         %finish
         end:
      %finish
      selectoutput(0)
   %finish
   %return
#fi
%end ;!of MONITOR



%routine move(%integer len, from, to)
!
! 'Assembler Routine' to emulate EMAS MOVE.
! Note: 1. No action if LEN<=0
!       2. Registers 1,2 and 3 used.
!
%label loop, return
!
      *mov_len,1          ;! Load the length
      *ble_return         ;! Return if less than or equal to zero
      *mov_from,2         ;! Load the FROM address
      *mov_to,3           ;! Load the TO address
!
!     Loop to move LEN bytes FROM -> TO
!
loop: *movb_(2)+,(3)+     ;! Move the byte
      *dec_1              ;! Decrement length count
      *bne_loop           ;! Continue if length not exhausted       
return:
      %return
%end


%integerfn next free lcn(%integer dcedte)
   !Find the next free LCN. Test is done inside loop to save code.
   !Remember that DTEs go from top down and DCEs from 0 up
   %integer i, j
   %for i = no of lcns-1, -1, 0 %cycle
      %if dcedte = dte %then j = i %else j = no of lcns - i
      %if line_lcntab(j) = 0 %then line_lcntab(j) = 1 %and %result = j
   %repeat
   %result = -1
%end ;!of Next free LCN

%routine pack bcd string(%string(255) s,%bytearrayname a, %c
   %integername index)
   !This routine takes a decimal number as a character string and packs it into A
   !in packed BCD (two digits per byte) starting
   ! at A(INDEX) and updating INDEX as it goes. INDEX is a global
   !variable used for this purpose. Trailing quartets are set to zero.
   !This routine is intended primarily for packing X-25 addresses
   %routinespec pack bcd char(%byte no)
   %integer i
   
   %if length(s) > 0 %start
      %for i=1,1,length(s) %cycle
         pack bcd char(charno(s,i) - '0')
      %repeat
   %finish
   
   index=(index+1)&x'FE' ;!Rounds INDEX up to the nearest byte boundary
   %return

   %routine pack bcd char(%byte no)
      
      %integer p
      p=index>>1
      %if index&1=0 %then a(p)=no<<4 %else a(p) = a(p)+no&15
      index = index + 1
      
   %end ;!of PACK BCD CHAR
%end ;!of PACK BCD STRING

%routine packchar(%byte char, %record (mef) %name mes)
   mes_a(mes_l) = char
   mes_l = mes_l + 1
%end ;!of Pack Char

%integerfn packetlength(%integer fn)
   !Returns the length of the control fields in an X-25 packet.
   !Call request, Data are not catered for
   %if fn = 19 %or fn = 27 %or fn = 251 %thenresult = 2 ;!Clear & conf, Reset & conf, Restart & conf.
   %if fn = 35 %then %result = 1 ;!Interrupt
   %result = 0
%end ;!of PACKETLENGTH


%routine pack string(%string (255) %name s,%record (mef) %name mes)
   !Add string S as a substring to MES_A, taking the end of MES_A
   !From a length supplied in MES_L
   
   string(addr(mes_a(mes_l))) = s

   mes_l = mes_l + length(s) + 1
   
%end ;!of PACKSTRING

%routine pack ts string(%string (255) s, %string (255) %name t)
   !Add s as a TS substring to t.

   length(t) = length(t) + 1
   charno(t, length(t)) = length(s) ! 128
   t = t.s
%end

%routine pull(%record (qf) %name q,item)
   !Pulls the specified item off a circular queue with header at Q
   %record (qf) %name p

   %if q_link == null %then %return ;!No elements (Why??)
   q_count = q_count - 1
   %if q_link_link == q_link %then q_link == null %and %return ;!One element on Q

   p == q
   %cycle
      p == p_link
   %repeatuntil p_link == item
   p_link == p_link_link
   %if q_link == item %then q_link == p ;!If we removed Q head, reposition it
%end




%routine query processes
#if ~s
   %integer i,j,k
   %record (linef) %name ln
   %record (procf) %name pr
   printstring("BH=") ;write(buffers held, 1)
#if ~m
   printstring(" CT=") ;%for i = 0,1,3 %cycle ;write(curtime_a(i), 1) ;%repeat
#fi
   newline
   %if busy q_count # 0 %start
      ln == busy q
      %for i = 1,1,busy q_count %cycle
         ln == ln_link
         write(ln_procno,1) ;printsymbol('/')
         %if ln_dcedte = dce %then printstring(" DCE") %else printstring(" DTE")
         printstring(" S,ID,L,LG") ;write(ln_state, 1)
         write(ln_ser, 1) ;write(ln_lineno, 1) ;write(ln_lcgn, 1)
         newline
         %if ln_call q_count # 0 %start
            pr == ln_callq
            %for j = 1,1,ln_call q_count %cycle
               pr == pr_link
               spaces(3)
               write(pr_procno, -1) ;printsymbol('/')
               printstring(" ST=") ;write(pr_state,-1) ;printsymbol('/')
               write(pr_substate, -1) ;write(pr_tstate, -1) ;write(pr_rstate, 1)
               printstring(" ID=") ;write(pr_task id,-1)
               printsymbol('.') ;write(pr_task port, -1)
               printstring(" LC=") ;write(pr_lcgn,-1)
               printsymbol('.') ;write(pr_lcn, -1)
               printstring(" TS,QU,OQ:") ;write(pr_tsflag, -1)
               write(pr_quiettime, 1) ;write(pr_outq_count, 1)
               printstring(" WI,WO,PI,PO:")
               write(pr_ww in, -1) ;write(pr_ww out, 1) ;write(pr_ps in, 1) ;write(pr_ps out, 1)
               printstring(" AETC:") ;write(pr_aaa, -1)
               write(pr_eee,-1) ;write(pr_ttt,-1) ;write(pr_ccc,-1)
               printstring("
   CV")
               %if pr_cv_l > 0 %and pr_cv_l <= 27 %start
                  %for k = 0,1,pr_cv_l %cycle ;write(pr_cv_a(k),1) ;%repeat
               %finish
               newline
            %repeat
         %finish
      %repeat
   %finish
#fi
%end ;!of Query Processes

%routine reject connect(%integer fn, qualifier)
   !Reject CONNECT outright
   %byte ser
   ser = p_ser ;p_ser = p_reply ;p_reply = ser ;!Send it back whence it came
   p_fn = disconnect
   free buffer(p_m)
   p_m == null
   p_s1 = qualifier
   monitor(p, to up)
   pon(p)
%end

%routine reject call(%integer qualifier)
   !Reject incoming call outright
   !Dont use TO LOWER as we dont have a process
   %byte ser
   p_m_fn = clear request %unless qualifier = spurious clear req
   p_m_data(0) = 0 ;!Clearing cause = DTE Clearing
   p_m_data(1) = qualifier ;!Diagnostics
   ser = p_ser ;p_ser = p_reply ;p_reply = ser
   p_fn = line output
   p_len = 5
   monitor(p, to low)
   cpon(p)
%end ;!of REJECT CALL

%string (255) %fn sub string(%record (mef) %name mes, %integer no)
   %integer i,l
   %unless mes == null %start
      l=0
      %while no > 1 %cycle
         l=l+mes_a(l)+1
         %result = "" %if l >= mes_l
         no = no - 1
      %repeat
   
      %if mes_a(l) > 63 %then %result = "Err/Too Long" %else %result = string(addr(mes_a(l)))
   %finishelse %result = ""
%end ;!of SUB STRING


#if ~m
%routine subtract times
   %integer i,j
   %bytearrayname t,st
   %byte borrow
   t == process_cv_our ct
   st == process_time_a
   !Calculate call duration.


   t(3) = (curtime_a(3) - st(3)) & 255 ;!Stupid compiler
   %if t(3)&255 < 60 %then borrow = 0 %else t(3) = t(3) + 60 %and borrow = 1  
   t(2) = (curtime_a(2) - st(2) - borrow) & 255 ;!Stupid compiler
   %if t(2)&255 < 60 %then borrow = 0 %else t(2) = t(2) + 60 %and borrow = 1 
   t(1) = (curtime_a(1) - st(1) - borrow) & 255 ;!Stupid compiler
   %if t(1)&255 < 24 %then borrow = 0 %else t(1) = t(1) + 24 %and borrow = 1  
   t(0) = curtime_a(0) - st(0) - borrow

   %for i = 0,1,3 %cycle
      j = t(i)//10
      t(i) = j<<4 + (t(i)-j*10)
   %repeat

%end ;!of Subtract times
#fi

%routine release process
   %integer i
   !Tidy up process.
   !Clear out-bound data queue
   free buffer(pop(process_outq)) %while process_outq_count # 0
   free buffer(process_discbuff)

   pull(line_call q,process) ;push(free pq,process)
      
%end ;!of RELEASE PROCESS


%routine restart processes
   %integer i
   %bytename state
   %record (mef) %name mes
   %record (procf) %name pr
   %if line_call q_count # 0 %start
      process == line_call q_link
      %for i = 1,1,line_call q_count %cycle
         pr == process_link
         state == process_state
         process_cv_reason = call restarted
         %if state = wtdsn %then release process %elsestart
            %if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long) 
            
         %finish
         line_lcntab(process_lcn) = 0 ;!Free off LCN
         process_lcn = 255 ;!Decouple process from LCN/LCGN
         process == pr
      %repeat
   %finish
   
%end ;!of RESTART PROCESSES


%integerfn stoi(%string (15) s)
   %integer n,i
   n=0
   %if length(s) > 0 %start
      %for i = 1,1,length(s) %cycle
         n = n*10 + charno(s,i)-'0'
      %repeat
   %finish
   %result = n
%end ;!of Stoi

%routine stop(%integer reason)
   printstring("*GATX Disaster ") ;write(reason, 1) ;newline
   monitor(null, query)
   %cycle
   %repeat
%end ;!of Stop

%routine to account(%record (mef) %name mes, %integer fn)
   p_ser = account ser
   p_reply = gatex ser
   p_fn = fn
   p_m == mes
#if ~m
   cbuff
   %if fn = hello %start
#fi
      p_s1 = gatex ser
      p_c2 = line_lineno
#if ~m
   %else
      p_gate port = process_task id ;p_task port = process_task port
   %finish
#fi
   monitor(p, mon to acct)
   pon(p)
%end ;!of To Account


%routine to lower(%record (mef) %name mes, %integer fn, datal)
   !datal is the length used to calculate no. of segments transmitted,
   !using the PSS algorithm. Datal is sometimes supplied as 0 (= 1 segment)
   !when the data field is known to be less than 63 bytes to avoid unnecessary
   !calculation.    A supplied value of -1 means "don't count this one"
   %record (pf) p
   !Find the length of the Packet. For most packets this is fixed
   !but for Data,interrupt and connect packets it must be supplied. Length
   !supplied is Level 3 data length + 3 bytes control
   mes_l = packetlength(fn) %unless fn = dte data %or fn = call request %or fn = call accepted

   %if fn < 250 %start ;!Not Restarts or Restart Confirmations
      mes_octet1 = gfi + process_lcgn
      %if fn = dce data %then mes_octet1 = mes_octet1 ! (MES_FN & X'80')
      !Q-bit buried in bit 2**7 of MES_FN
      mes_lcn = process_lcn ;!Bottom byte only

      %if fn&3 # 3 %start ;!Data, RR, RNR, REJ
         fn = fn ! PROCESS_CCC<<5
         %if fn&1 = 0 %then fn = fn ! PROCESS_TTT<<1 
         !We dont use the M bit
      %finish
   %else
      mes_octet1 = gfi
      mes_lcn = 0
   %finish

   %if datal > 0 %then increment(tx, datal)
   %if fn = clear request %or fn >= 250 %start
      mes_a(0) = 9; !Allow for cause and diags bytes
      %unless fn # clear request %or process_discbuff == null %start
         mes_a(0) = mes_a(0) + 2; !Fast select. 
         !These are DTE/DCE address lengths and facilities length.
         mes_data(2) = 0; mes_data(3) = 0
         pack ts string(substring(process_discbuff, 2), mes_s)
         pack ts string(substring(process_discbuff, 3), mes_s)
         mes_l = length(mes_s) - 4
         free buffer(process_discbuff); process_discbuff == null
      %finish
      mes_data(0) = 0; !Cause is always zero from us
   %finish

   process_substate = process_substate & (\16)

   mes_fn = fn
   p_ser = line_ser
   p_reply = gatex ser
   p_fn = line output
   p_process = line_line no
   p_m == mes
   p_len = mes_l + 3
   monitor(p, to low)
   cpon(p)

%end ;!of To Lower


%routine to upper(%record (mef) %name mes, %integer fn)
   p_ser = process_task id
   p_reply = gatex ser
   p_fn = fn
   p_gate port = process_procno
   p_task port = process_task port
   p_m == mes
   monitor(p, to up)
   cpon(p)
%end ;!of TO UPPER


%string (63) %fn ts substring(%record (mef) %name mes, %integer ptr, no)
   !Routine to unpack Transport service substrings.
   !NO contains the substring number to go looking for
   !%result = "Err" if the TS substring was invalid
   !%result = "" if the substring is not there.
   !Note that currently a split substring will be rejected.
   !Note also that ptr is referenced to mes_data(0) but that mes_l includes
   !the x25 3-byte packet header

   %string (63) t
   %integer c

   %cycle
      %result = "" %if ptr >= mes_l-3 ;!TS substring not present

      c = mes_data(ptr)
      %result = "Err" %if c & 64 # 0
      no = no - 1
      %exit %if no <= 0
      ptr = ptr + c & 63 + 1
   %repeat

   !If TS substring overflows end of block it is invalid
   %result = "Err" %if ptr + c & 63 > mes_l-3
   move((c & 63) + 1, addr(mes_data(ptr)), addr(t))
   length(t) = length(t) & 63
   %result = t
%end ;!of TS Substring


%routine unravel ts(%string (63) %name ts addr, ts params, %integername line)
   !Routine takes a TS address of the general form <Net>.<NUA>.<residue>
   !and splits it up into those components, making allowance for defaults.
   %integerfnspec getnet(%string (63) %name s)
   %string (63) ls
   %if ts addr -> ls.(".").ts addr %start
      !Not just a bare NUA. Possible formats are <Net>.<NUA>.<residue>
      !or <NUA>.<residue>       Remember <residue> may contain dots.
      line = getnet(ls)
      %if line >= 0 %start
         !It was <Net>....
         ts params = "" %unless ts addr -> ts addr.(".").ts params

      %else
         !It was <NUA>...  Our address and params strings are in the wrong place.
         line = default line ;ts params = ts addr ;ts addr = ls

      %finish

   %else
      !It was just <NUA>.   Return defaults. ts addr should be unaltered
      line = default line ;ts params = ""

   %finish

   %integerfn getnet(%string (63) %name s)
      !Find out if s is a valid network name and if so what line its on
      %integer i
      %for i = 0, 1, no of x25 nets - 1 %cycle
         %result = i %if s = shortnetname(i) %or s = longnetname(i)
      %repeat
      %result = -1
   %end ;!of getnet (in unravel ts


%end ;!of Unravel TS


%string (15) %fn unpack bcd string(%bytearrayname a, %integer no)
   !Retrieves X-25 addresses. These are presented as:
   !Length(caller),Length(called),called,caller. Lengths are 1 
   !quartet each.  NO=1 gives us the length and contents of caller
   !               NO=0   "    "  "     "    "     "      " called
   %bytefnspec next bcd char
   %integer i,l,index
   %string(255) s
   l=(a(0)>>(no*4))&15 ;!Assumes >>0 is valid.
   index = (a(0)&15)*no + 2
   
   %if l>0 %start
      %for i=1, 1, l %cycle
         charno(s,i) = next bcd char + '0'
      %repeat
   
      length(s) = l
      %result = s
   %finishelseresult = ""
   
   %bytefn next bcd char
      %byte b
      %if index&1 = 0 %then b = a(index>>1)>>4 %else b = a(index>>1)&15
      index = index + 1
      %result = b
   %end ;!of NEXT BCD CHAR
%end ;!of UNPACK BCD STRING

%integerfn wp to facs(%string (31) facs, %string (31) %name pssfacs)
   !Take a facilities field presented as "W=m/n,P=m/n" and
   !1) validate it, 2) pull out facilities values, and 3) set flags
   !to indicate which were specified.  Thi function is essentially
   !the opposite of Form Facilities
   %bytefnspec shift(%integer n)

   %string (15) m,n
   %integer im, in, l, flags

   l = 0 ;flags = 0 ;pssfacs = ""

   %result = -8 %if length(facs) > 21 ;!Max = "W=7/7,P=256/256,C=RFS" (21 chars)

   %if facs -> facs.("C=").m %start ;!Strip connection controls off
      length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off the comma
      process_fac = process_fac ! reverse charge bit %if m -> ("R").m
      process_fac = process_fac ! fast select bit %if m -> ("F").m
      process_fac = process_fac ! fast select bit ! restricted response bit %if m -> ("S").m
   %finish

   %if facs -> facs.("P=").m %start ;!Strip packet size indication
      length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off comma
      %result = -6 %unless m -> m.("/").n
      im = stoi(m) ;in = stoi(n)
      im = shift(im) ;in = shift(in)
      %result = -7 %unless im # 0 %and in # 0
      process_ps in = im ;process_ps out = in
      charno(pssfacs, l+1) = x'42' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in
      l = l + 3
   %finish

   %if facs -> ("W=").m %start ;!Window size indication
      %result = -4 %unless m -> m.("/").n
      im = stoi(m) ;in = stoi(n)
      %result = -5 %unless 0 <= im <= 7 %and 0 <= in <= 7
      process_ww in = im ;process_ww out = in
      charno(pssfacs, l+1) = x'43' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in
      l = l + 3
   %finish


   length(pssfacs) = l
   %result = 0

   %bytefn shift(%integer n)
      !Function to convert from an integer packet size to form n
      !where 2**n = packet size. Function just shifts right till either
      !we get bored or we are left with the topmost bit. I'm sure there
      !is a clever way to do this in assembler.

      %integer i

      %for i = 0,1,15 %cycle ;!Its a 16-bit integer
         %result = i %if n = 1 ;!Gotcha
         n = n >> 1
      %repeat

      %result = 0 ;!Signifies invalid packet size. (NB: size=1 does also)
   %end ;!of Shift (in WP to Facs)
%end ;!of WP to Facs
%endofprogram
!
!Version Hierarchy:
!m (Min) Minimal system - chops out checkpointing and stats reporting to ACCT
!f (Fast) Fast version - chops out monitoring.
!s (short) Chops out e.g. Query processes code if space is at a premium
!p (Pre-ack) operates on a "read for data - data arrived" basis rather than
!  "data arrived - acknowledge" to comply with the BACG/JHB spec.