! file: x25_XPROTs
!
!*************************************************
!*                                               *
!*       PSS X-25 Level 2 Protocol Handler       *
!*                                               *
!*                   XPROT                       *
!*                                               *
!*        Version  9.30   11 Oct  1985           *
!*                                               *
!*************************************************
#options

#if p&q
   #report must have either p (dup11) or q (dqs11e) or neither (both)
#fi
#if ~p
   #report dqs11e code included
#fi
#if ~q
   #report dup11 code included
#fi
!*
!          NB: This handler now requires the later version of the Buffer Manager
!              that protects itself from double Q manipulation. (see ring version)
!
%constinteger big buffer length = 190;    ! NB: New Length ******************

%control 1
!*
!********************************
!*                              *
!*       Declarations           *
!*                              *
!********************************

%begin
!***** Configuration Information *****
!*
%include "ercm06.INC_CONFIGt"
#if ~y
%include "ercm06.INC_SERS"
#else
%include "ercm06.inc_tsers";   ! for second xgate
#fi

%owninteger dcedte                     =0 ;!DCE
!*
!***** Constintegers *****
!
!*State Values
%constinteger waiting for disc         =1  ;!DTE
%constinteger ua queued 1              =2   ;!DTE & DCE
%constinteger sabm queued              =3   ;!DTE & DCE
%constinteger waiting for ua           =4    ;!DTE & DCE
%constinteger waiting for sabm         =5  ;!DCE
%constinteger uaqueued 2               =6    ;!DCE
%constinteger disc queued              =7   ;!DTE & DCE
%constinteger link up                  =0       ;!DTE & DCE
%constinteger dce waiting for ua       =1  ;!DCE
%constinteger dte waiting for ua       =  8 ;!DTE
%constinteger dce sarm queued          =  9 ;!DCE - LAP-Compatibility code
!*Substate values (Values of RSTATE)
%constinteger rrsent = 0
%constinteger rrpending = 1
%constinteger rejsent = 2
%constinteger rejpending = 3
%constinteger rnrsent = 5
%constinteger rnrpending = 6
%constinteger rrdeferred               =  7

!*Monitor Calls
!*
%constinteger ok                       =0
%constinteger line down                =1
%constinteger line up                  =2
%constinteger query                    =3

%constinteger push error               = 4
%constinteger buffers low              = 5
%constinteger silo full                = 7
%constinteger bad fr                   = 8
%constinteger dms                      = 9

%constinteger init msg                 = 10
%constinteger mon clock tick           = 11
%constinteger bad addrs rx             = 12
%constinteger spurious uframe rx       = 13
%constinteger rrs rx                   = 16
%constinteger rejs rx                  = 17
%constinteger rnrs rx                  = 18
%constinteger iframes rx               = 19
%constinteger iseqerss rx              = 20
%constinteger sabms rx                 = 21
%constinteger uas rx                   = 22
%constinteger discs rx                 = 23
%constinteger frmrs rx                 = 24
%constinteger badframes rx             = 25
%constinteger null iframes rx          = 26
%constinteger grotted 2                = 27
%constinteger grotted 3                = 28
%constinteger grotted 4                = 29
%constinteger grotted 5                = 30
%constinteger poll failure             = 31
%constinteger rrs tx                   = 32
%constinteger rejs tx                  = 33
%constinteger rnrs tx                  = 34
%constinteger iframes tx               = 35
%constinteger retries tx               = 36
%constinteger sabms tx                 = 37
%constinteger uas tx                   = 38
%constinteger discs tx                 = 39
%constinteger frmrs tx                 = 40
%constinteger mon hw fail              = 47
%constinteger funny int                = 48
%constinteger buff full                = 49
%constinteger bad address              = 50
%constinteger spurious data            = 51
%constinteger grotted 1                = 52
%constinteger short frame              = 54
%constinteger from upper               = 56
%constinteger to upper                 = 57
%constinteger funny state              = 58
%constinteger bad function             = 59
%constinteger output tx                = 61
%constinteger bad ack                  = 62
%constinteger input rx                 = 63
%constinteger line no wrong            = 64
%constinteger line type wrong          = 65
!*                      
!Line and module state values for communicating with XGATE
!*                        
%constinteger link established         =0
%constinteger link down                =1
%constinteger xprot up                 =2
!*
!* X25 Frames
!*Information transfer
%constinteger iframe                   =0
!*Supervisory
%constinteger rr                       =1
%constinteger rnr                      =5
%constinteger rej                      =9
!*Unnumbered
%constinteger sabm                     =x'2F'
%constinteger sarm                     =x'0F'
%constinteger disc                     =x'43'
%constinteger ua                       =x'63'
%constinteger frmr                     =x'87'
!
!***** Hardware control bits *****
!
%constinteger rset=k'100',dsr=k'1000',dtr=2,rts=4,cts=k'20000'
%constinteger dcd=k'10000',rxen=k'20',txen=k'20',dlen=k'40'
%constinteger tsom = k'400', teom = k'1000'
%constinteger drs = k'400', snd = k'20', rcven = k'20'
%constinteger rx done = k'200', tx done = k'200'
!*
!* Values of flags etc
!*
%constinteger clear                    =0
%constinteger set                      =1
%constinteger pending                  =1
%constinteger sent                     =2
%constinteger pfset                    =x'10'
%constinteger command                  =0
%constinteger response                 =1
%constinteger invalid                  =-1
%constinteger sfmask                   =63
%constinteger dce                      =0
%constinteger dte                      =1

%constinteger initialise               =0
%constinteger line input               =1
%constinteger line output              =2
%constinteger input here               =3
%constinteger output done              =4
%constinteger modem status = 5
%constinteger rxgo                    =k'111'
%constinteger txgo                    =k'111'
%constinteger input req                =1
%constinteger output req               =2
%constinteger bounce                   =3
%constinteger put down                 =4
%constinteger put up                   =5
%constinteger poke                     = 22


!******************************************************************
! Reasons for a Line going down
!******************************************************************
%constinteger dead                     =0
%constinteger timed out                =1
%constinteger reset                    =  2
%constinteger sabm received            =  3
%constinteger user request             =  4
%constinteger data retries             =  5
%constinteger uframe in data           =  6
%constinteger read fails               =  7
%constinteger full up                  =  8
%constinteger disc received            =  9
%constinteger line timeout             = 10
%constinteger no buffs                 = 11

%constinteger critical                 =  4
%constinteger big limit                =  5;   ! level for sending RNR
!*
!***** Record Formats *****
%recordformat qf(%record (qf) %name link, %integer count)
%recordformat hwf((%integer rcs, rdb, tcs, tdb) %or %c
 (%integer mcsr, tcsr, rsr, rcr, twcr, tcar, rwcr, rcar))
%recordformat x25f(%byte add, type, octet1, octet2, octet3)
%recordformat parf(%integer type, (%record (x25f) %name b %or %integer address), %c
   %integer len)
      %recordformat desf(%integer pt, %byte state, s1, %c
       %integer maxln, p1, flag, seg, sa, vec, intno)
      %recordformat des2f(%record (desf) rx, tx)
%recordformat m1f(%integer a, b, c, d, e, f, g)
%recordformat mef(%record (mef) %name link, %byte len, type, %c
%byte d0, d1, d2, %record (x25f) x25)
%recordformat pf(%byte ser, reply, ((%integer a, b, c) %or %c
   (%byte fn, line, %record (mef) %name m, %byte len, c2)))
!*
!*
!***** Monitoring Information *****
!*
%owninteger irx, rrrx, rnrrx, rejrx, discrx, uarx, sabmrx, frmrrx, ierrrx, nullrx, wcov, silo,d1, d2 = 0
%owninteger itx, rrtx, rnrtx, rejtx, disctx, uatx, sabmtx, frmrtx, retrytx = 0
#if ~f
%ownintegerarray moncount(0:63)=0(64)
%constbytearray monaction(0:63) = %c
 2, 2, 2, 1, 1, 1, 1, 3, 3, 1, 1, 1, 3, 1, 1, 1,
 0, 0, 0, 0, 2, 0, 0, 2, 2, 3, 2, 3, 3, 3, 3, 1,
 0, 0, 0, 0, 0, 0, 0, 0, 2, 1, 1, 1, 1, 1, 1, 3,
 3, 2, 3, 3, 3, 1, 2, 1, 1, 1, 3, 3, 3, 4, 2, 4
#fi
            
                                                                       
!***** INTEGERS *****
!*
%owninteger rx watchdog = 0
%owninteger tx watchdog = 0
%owninteger clock0                     =0
%owninteger clock1                     =0
%owninteger clock2                     =0
%owninteger clock3                     =0
%owninteger clock4                     =0;    ! read fails - block too long
%owninteger clock5                     =0;  ! no read buffers for 3 mins
%owninteger address                    =  0
%owninteger type                       =  0
%owninteger pfbit                      =  0
%owninteger comres                     =  0
%owninteger poll                       =0           ;!"Pending" if we have a Poll bit to send
                              !"Sent" when we have sent it, cleared when we receive a final bit
%owninteger final                      =0          ;!Set when far end sends us a Poll bit.
                              !Cleared when we send back a Final bit
%owninteger istate=  0              ;!State of our end of the link
%owninteger tstate=  0              ;!Set if far end has RNR up against us
%owninteger rstate                     =  0
%owninteger abort req,abort reason =  0
%owninteger window =  6
%owninteger aaa =  0                 ;!Last message ackked by far end
%owninteger eee =  0                 ;!Next message expected
%owninteger ttt =  0                 ;!Next message to send
%owninteger xxx =  0 ;!High Water Mark
!This is the most advanced frame for which a valid ack is possible
!It is equal to TTT except during timer recovery (retransmission)
!where TTT is the frame just sent and XXX is the most advanced frame
%owninteger fff =  0                 ;!Last message sent
%owninteger active                     =0
%owninteger max reads                  =  5
%owninteger t1                         =  6 ;!6 Ticks = 2.5 - 3 secs
%owninteger n2                         = 20
%ownbyte line
%ownbyte line type
%owninteger i,b = 0
%owninteger txint                      = -6
%owninteger rxint                      = -7
%owninteger buffers held               =  0
%owninteger quiet idle                 =  1 ;! 0=send periodic RRs
%owninteger hold rnr                   =  0 ;!Hold RNR up for testing
%owninteger outstanding buff req       =  0
%owninteger sfff                       =  0; ! temp to hold fff
%ownbyte monbyte                = 1;!Controls what is monitored to where
!*
!*     Buffer Management Constants etc
!*
#IF Q
%constintegername ps == k'017776';      ! processor status - in seg 0
#else
%constintegername ps == k'077776';        ! processor status - in seg 0
#fi
%constintegername big buff pt== k'100104'
%constintegername small buff pt == k'100106'

%constintegername no of small buff == k'100114'
%constintegername min no of big == k'100120'
%constintegername min no of small == k'100122'
%constintegername no of big req == k'100124'
!%constintegername Big Boundary  == k'100130';    ! NB: Needs BUf Man of 18/2/85
!*
!****** NAMES *****
!*
%include "ercm06.INC_EXTS"
%include "ercm06.INC_VARIOUS"
!***** Arrays *****
!*
!*
!***** Own and Const Arrays *****
!*
%constintegerarray initstate(0:1)=disc queued(2)
!*
!***** Records and record names *****
!*
%ownrecord (pf) p
%constrecord (*) %name null == 0

!* variables used by the low-level comms hw driving routines

%ownrecord (parf) parb
%ownrecord (des2f) %name des
%ownrecord (des2f) %array %name desx
%ownrecord (hwf) %name hw == 1 ;!Set up by xprot on initialise
%ownrecord (*) %name handler address == 1
     %owninteger tx reply, rx reply
     %owninteger f, cad, oseg, ext bits
     %owninteger par, pad, x
      %ownintegerarray raddr(0:7)
%recordformat bpf(%record (mef) %name m)
%ownrecord (m1f) m1, m2
%recordformat wdse((%record (mef) %name m %or %integer b), %integer len)
%ownrecord (wdse) %name wdesc
%ownrecord (wdse) %array wspace(0:sfmask)
%ownrecord (wdse) %name idesc
%ownrecord (wdse) icurr = 0
%ownrecord (qf) ipool
%ownrecord (wdse) om
%ownrecord (bpf) %name im
%ownrecord (bpf) %name me2
%ownstring (7) %array abo reason(0:11) =
      "Dead", "tmd out", "U Reset", "Sabm rx", "User Rq",
      "Data Tx", "Ufrm Rx", "Rd Fail", "Full Up", "Disc Rx",
      "Line Tm", "No Buff"

!***** Routine Specs *****
!
%routinespec stop(%integer reason)
!
!
%routinespec abort(%integer reason)
%routinespec clock int
%routinespec free buffer(%record (mef) %name p)
%routinespec handle input
%routinespec handle output
%routinespec monitor(%record (pf) %name p,%integer type)
%routinespec octal(%integer n)
%routinespec query processes
%routinespec reinitialise hardware
%routinespec reset line
%routinespec move(%integer len, from, to)
%routinespec start input
%routinespec replace read
%routinespec to comms hw(%record (parf) %name par)
%routinespec to xgate(%integer flag)

!****** Others *****
!*
!*
!****** END OF DECLARATIONS *****

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

map virt(buffer manager,5,4)
map virt(buffer manager,6,5)


im == m1 ; om_m == m2
change out zero = t3 ser ;!Queued console I/O

p_ser=0 ;!Accept all messages
poff(p) ;!Wait. Expect an initialisation message

#if ~f
monitor(p, init msg)
#fi
line=p_fn ;!We have only one line. Just record it and use 
!it for communicating with XGATE.
printstring("XPRO (") ;printstring(longnetname(line)) ;printstring(") Running
")
line type = p_line & 7 ;!0 = DQS11 ;1 = DUP11 2 = DUP11 with read-chained-read DUP driver
dcedte = p_line >> 7 ;!0=DCE   1=DTE
handler address==p_m
rxint=p_len!X'FF00'
txint=p_c2!X'FF00'
stop(line no wrong) %unless 0 <= line <= 2
stop(line type wrong) %unless 0 <= line type <= 2
istate = initstate(dcedte)
reinitialise hardware
to xgate(xprot up)
alarm(25) ;!Half a second timer tick
handle output

%cycle ;!Main loop

   p_ser=0 ;!Accept all messages
   poff(p) ;!Wait

   %if p_ser&x'80'#0 %start ;!Interrupt
      %if p_ser = txint & x'ff' %start
         parb_type = output done
         to comms hw(parb)
         active = 0
         tx watchdog = 0
         handle output

      %else
         replace read
         rx watchdog = 0
         handle input
#if ~f
         monitor(parb, input rx)
#fi
      %finish

      %continue
   %finish

   %if p_reply=0 %start ;!Clock tick
      !Interrupts:
      !0-9: Change monitoring level
      !A: Force a line abort
      !B:Generate a bad link-level address
      !E: Force a REJ
      !N: Close trace file and start a new one
      !Q: Quiet: Suppress idle RR exchanges
      !U: Generate a spurious U-frame
      !R: Force a Transmitted sequence error
      !S: Force a reset of line by SABM
      !X: Generate a spurious frame (invalid)
      !W: Hold up RNR
      !Z: Stop program moderately tidily
#if ~f
      monitor(null, mon clock tick)
#fi
      clock int 
      %if int = 0 %then %continue
      %if int = 'S' %start
         abort(reset)

      %elseif int = 'A'
         abort(user request) ;!Int A aborts line

      %elseif int='?'
         query processes
         monitor(null,query) ;!Int ? produces a status report

      %elseif '0' <= int <= '9'
         monbyte = int - '0'

      %elseif int = 'N'
         selectoutput(1) ;close output

      %elseif int = 'Q'
         quiet idle = 1 - quiet idle

      %elseif int = 'W'
         hold rnr = 1 - hold rnr ;!Force RNR for testing

      %finishelse %continue
      int = 0
      %continue
   %finish


#if ~f
   monitor(p, from upper)
#fi

   %if p_fn = output req %start ;!"Write to line" from higher level
      buffers held = buffers held + 1
      %if 0 # p_m_type # 64 %then stop(grotted 2)
      %if istate=link up %start ;!Ignore unless line is up
      !Xprot maintains a circular array of 64 records. These
      !point to buffers received from the higher level from the time
      !they arrive to the time they are acknowleged


         wdesc==wspace(fff)
         wdesc_m==p_m
#if q
            wdesc_m_d0 = 0 ;!Flag to tell DQS handler whether to shuffle or not
#fi
         wdesc_len=p_len+2
         sfff=(fff+1)&sfmask ;!Increment n(s): Sequence no of next frame
         %if sfff = aaa %start
            !We've filled up our carousel. Nothing for it but to drop
            !the line to prevent a crash
            monitor(null, buff full)
            abort(full up)
         %finish
         fff = sfff;            ! if done before, buffers not freed on 'full'
         handle output

      %else ;!Link down
         free buffer(p_m) ;p_m == null
      %finish


   %elseif p_fn = poke
      %if istate = link up %then p_len = 1
      p_c2 = buffers held
      i = p_ser ;p_ser = p_reply ;p_reply = i
      %unless p_m == null %start
         move(48, addr(irx), addr(p_m_d0)) ;p_m_len = 48
      %finish
      pon(p)

   %else
      monitor(p,bad function)
      !We Won't free the buffer (Better slowly gobble space than risk crashing BUFF)

   %finish
%repeat
!*
!****************************************
!*                                      *
!*            Routines                  *
!*                                      *
!****************************************

%routine abort(%integer reason)
   %integer i, x

   %if istate = link up %start
   
      set prio(1);     ! no priority, bm must absorb buffers
      abort reason = reason %unless reason = 0
      %if abort req=0 %start ;!First try at aborting
         printstring(longnetname(line)) ;printstring(" Line Down at Level 2:")
         printstring(abo reason(abort reason)); newline
         monitor(null,line down)
         to xgate(link down)
      %finish
      
      %if active=2 %start ;!Big block being transmitted
         abort req=1
      %else
         abort req=0
      
         x = 0;     ! restrict concurrent no of release requests
         %while aaa#fff %cycle ;!Clear up requests
            wdesc == wspace(aaa)
            free buffer(wdesc_m); wdesc_m == null
            aaa=(aaa+1)&sfmask
            x = x+1
            %if x = 7 %then x = 0 %and set prio(1);   ! force it to wait
         %repeat
      
         istate=disc queued ;clock3 = 0
         %if abort reason = reset %then istate = sabm queued
         %if abort reason = sabm received %then istate = ua queued 1
         %if abort reason = disc received %then istate = ua queued 2
         abort reason = 0
         handle output
      %finish

   %elseif istate = 1
      istate = disc queued ;clock3 = 0
      handle output

   %finish
%end ;!of abort


%record (mef) %map grab buffer
      %integer x

      ! buffers there, grab one
      ps = ps!k'340';                   ! stop processor interrupts
      %if no of buff >=  critical %start
         buffers held = buffers held+1
         no of buff = no of buff-1
         %if no of buff < min no of big %then min no of big = no of buff
          no of big req = no of big req+1
         x = big buff pt;               ! get buffer managers free pointer
         x = x-k'20000';                ! make it my vm (my seg 3 = bm seg 4)
         big buff pt = integer(x);      ! copy rest of free queue
         ps = ps&(\k'340');             ! allow ints again
         %result == record(x);          ! and pass back result
      %finish
      ps = ps&(\k'340')
      %result == null
%end

%routine free buffer(%record (mef) %name mes)
   %integer x
   %record (pf) p
   !Frees the block pointed at by M
   %unless mes == null %start ;!Safety check for NULL pointer
      buffers held = buffers held - 1
      ps = ps!k'340';                   ! put processor status = 7
      x = addr(mes)+k'20000';            ! address in buff managers VM.
      %if mes_type # 0 %start;          ! small buffer
         no of small buff = no of small buff+1
         integer(addr(mes)) = small buff pt
         small buff pt = x
      %finish %else %start
!         %if x < Big Boundary %start;      ! neg numbers
!            printstring("xpr:bad big"); ! octal(x); ! newline
!            ps = ps&(\k'340');          ! ints on
!            %return;                    ! ditch bad buffer (its really a short one)
!         %finish
         no of buff = no of buff+1
         integer(addr(mes)) = big buff pt; ! copy in top of chain
         big buff pt = x;                  ! and remake 1st entry
      %finish
      ps = ps&(\k'340');                ! and allow ints again
   %finish
%end ;!of free block



%routine handle output
%record (x25f) %name x25
%record (mef) %name m
%integer type
%integer len
%integer x
%return %if active#0 ;!Transmit channel busy
%if abort req#0 %then abort(dead) %and %return; ! don't do recursively

%if istate#0 %start ;!Link setup phase

   %if istate=sabm queued %start ;!Have sent UA (DTE). Now send SABM
      type=sabm
      istate=waiting for ua
      sabmtx = sabmtx + 1

   %elseif istate = uaqueued 1
      type=ua
      %if b = 0 %start ;!LAP-B
         istate=link up
         reset line
         to xgate(link established)
      %else
         istate = dce sarm queued
      %finish

      uatx = uatx + 1
   
   %elseif istate = uaqueued 2 ;!We have had a DISC from DCE and
      !must send a UA in reply, with the P/F bit as received
      type=ua
      %if dcedte = dte %then istate=sabm queued %else istate = waiting for sabm
      uatx = uatx + 1

   %elseif istate=disc queued ;!We have had either an abort
      !or a DISC while the link was up. Send a DISC back 
      !and wait for DCE to repoll with DISCs
      type=disc
      %if dcedte = dte %then istate = dte waiting for ua %else istate = dce waiting for ua
      !i.e. down
      disctx = disctx + 1

   %elseif istate = dce sarm queued ;!LAP
      type = sarm
      istate = link up
      reset line
      to xgate(link established)

   %else
      %return

   %finish

   -> send unnumbered

%else ;!Link up

   %if rstate = rejpending %start
      type = rej
      rejtx = rejtx + 1
      rstate = rejsent ;!2
      ->send supervisory

   %elseif rstate = rnrpending ;!6
      type = rnr
      rnrtx = rnrtx + 1
      rstate = rnrsent ;!5
      ->send supervisory

   %elseif rstate = rrpending %or (rstate = rejsent %and clock0 >= t1) %or final = set
      rstate = rrsent %if rstate = rrpending
      type = rr
      rrtx = rrtx + 1
       clock5 = 0;              ! clear the solid RNR Clock
      ->send supervisory
   %finish

int r:
   %if ttt#fff %and tstate=0 %and (ttt-aaa)&7#window %start
      !Something to send/No RNR up from far end/No modulo count runout
      !respectively
      %if ttt=xxx %or clock1 >= t1 %start
      !Branch past this if we are retransmitting and Clock1 is still running
         wdesc==wspace(ttt) ;!Pick up the top frame on the Q
         m==wdesc_m
         x25==m_x25
         len=wdesc_len
         type=(ttt&7)<<1
         %if xxx=ttt %start
            xxx=(xxx+1)&sfmask
            itx = itx + 1
         %else
            poll=pending
            retrytx = retrytx + 1
         %finish
         !If we are not retransmitting, keep high water mark abreast of TTT
         !If we are, this is a retransmission so has the poll bit set
         ttt=(ttt+1)&sfmask
         active=2   ;!Big block being transmitted
         clock1=0
#if ~f
         %if int = 'R' %then int = 0 %and active=0 %and ->int r ;!Force a transmit sequence error
#fi
         
         ->send frame
      %finish
   %finish

%finish
%return
send supervisory:
send unnumbered:
   len=2
   active=1
   x25 == om_m
   
send frame:
   !In LAPB, I,SABM,DISC are always commands. UA,FRMR are responses.
   !         RR,REJ,RNR can be either
   !           We will drive REJ as a reply. RR and RNR will be commands if sent as
   !           idle line polls and responses if prompted by an I or RR command
   
   !           Note they must set the poll bit.
   pfbit=clear ;!Default
   
   %if type&1=0 %or type=sabm %or type=disc %then x=command %else x=response
   %if type = rr %or type = rnr %start
      x = comres
      %if x=command %then poll=pending
   %finish
   %if type&3 # 3 %then type = eee<<5 ! TYPE
   %if x=command %and poll=pending %then pfbit=pfset %and poll=sent
   %if x=response %and final=set %then pfbit=pfset %and final=clear
   
   !Calculate the address byte as follows: PSS algorithm is
   !   Commands  DCE--> DTE  Address=3  DTE--> DCE Address=1
   !   Responses DCE--> DTE  Address=1  DTE--> DCE Address=3
   %if x=command %then address=1 %else address=3
   !Addresses are the other way round for a DCE.
   %if dcedte=dce %then address=4-address
   
   clock0=0

#if ~f
   %if int = 'B' %then address = 2 %and int = 0 ;!Force a bad address
   %if int = 'U' %then type = ua %and int = 0   ;!Force a spurious UA
   %if int = 'X' %then type = x'FD' %and int = 0;!Force a bad ctrl byte
#fi

!For DQS - we may have shuffled the data one byte to the left.
!if so, plant address and control bytes in the shuffled position not where
!they normally go.
#if q
%if addr(x25) & 1 = 0 %or byteinteger(addr(x25)-3) = 0 %start
#fi
   x25_add=address
   x25_type=type ! PFBIT
#if q
%else
   byteinteger(addr(x25_add)-1) = address
   x25_add = type ! pfbit
%finish
#fi
   parb_type=line output
   parb_b==x25
   parb_len=len
   !There's no need for the deferred RR once we've sent a frame of any kind
   rstate = rrsent %if rstate = rrdeferred
#if ~f
   monitor(parb, output tx)
#fi
   to comms hw(parb)
%end ;!of handle output



%routine handle input
   %record (parf) m
   %record (x25f) %name x25
   %record (wdse) %name imess
   %integer r
   %integer s
   %integer x
   %integer l
   x25==parb_b ;!?
   m_b == x25 ;m_address = m_address - 7 ;!remove offset to X25 data
   l = parb_len
#if ~f
   %if int = 'E' %and type&1 = 0 %then l = -2 %and int = 0
   !Force a received sequence error
#fi
   
   %if l<2 %start ;!Bad frame
   
      %if l=-2 %start;           ! WC overflow
#if ~f
         monitor(null,dms)
#fi
         clock4=clock4+1
         %if clock4 > 24 %start
            %if clock5 > 25 %then abort(no buffs) %else abort(read fails)
                              ! either there were no big buffers   or
                              ! a too-long packet was being rec'd
         %finish

#if ~f
      %elseif l=-1
         monitor(null,bad fr)
   
      %elseif l=-3
         monitor(null,silofull) ;!Keep a count

      %else
         monitor(null, short frame)
         write(l, 3) ;printsymbol(':')
         write(address, 3) ;write(type, 3) ;write(x25_octet1, 3)
         newline
#fi
     %finish
      ->noise
   %finish
   
   %if address&x'FD' # 1 %then monitor(null, bad addrs rx) %and -> noise
   !Check for bad address. Strictly speaking we should ignore these if we're a DCE

   pfbit=type&x'10'
   !Find out what sort of frame this is. We need to know if it is
   !a command or response (or invalid).
   
   x=invalid ;!Guilty till proved innocent
   %if type&3#3 %start ;!S-frames and I-frames
      r=(type>>5)&7 ;!Extract N(R) 
      %if type&1=0 %start ;!I-frames.
         s=(type>>1)&7 ;!Extract N(S)
         type=iframe
         x=command
      %else ;!Supervisory frames
         type = type & 15 ;!Mask out N(R) and P/F bit
         %if type=rr %or type=rnr %or type=rej %start ;!Only ones we recognise
            %if dcedte=dce %then address=4-address ;!Watch out.
            %if address = 3 %then x = command %else x = response
         %finish
      %finish
   %else ;!Unnumbered frames
      type = type & x'EF' ;!Mask out P/F bit
      %if type=sabm %or type=disc %then x=command
      %if type=ua %or type=frmr %then x = response
   %finish
   
   %if x=command %start
      comres = response ;!Next frame is a response to this one unless there is a good reason otherwise

      %if pfbit=pfset %start
         !Command with poll bit set requires an immediate RESPONSE
         final=set
         %if rstate = rrsent %or rstate = rnrsent %start
            %if no of buff < big limit %or hold rnr # 0 %start
#if ~f
               monitor(null, buffers low)
#fi
               rstate = rnrpending
            %finishelse rstate = rrpending
         %finish
      %finish
   %else
      %if x=response %and poll=sent %start
         %if pfbit=pfset %then poll = clear %elsestart
#if ~f
            %if dcedte = dce %then monitor(null, poll failure)
#fi
         %finish
      %finish

      %if x=invalid %then monitor(null, badframes rx) %and -> noise
   %finish
   ->noise %if abort req#0
   
   %if istate#link up %start
   
      %if type=ua %and istate=waiting for ua %then %start
         istate = link up
         reset line
         to xgate(link established)
         set prio(2);       ! link up, so now raise tasks priority level
                             ! important for DUPs when modem signals lost
         ->valid
      %finish
   
      %if type=sabm %then b = 0 %and istate = uaqueued 1 %and ->valid
      %if type = sarm %then b = 1 %and istate = uaqueued 1 %and -> valid ;!LAP
   
      %if dcedte=dte %start
         %if type=disc %then istate = uaqueued 2 %and ->valid
         %if type = ua %then istate = sabm queued %and -> valid
   
      %else ;!DCE mode
         %if type=ua %then istate=waiting for sabm %and ->valid
   
         %if type=disc %and istate # dce waiting for ua %and %c
         istate # disc queued %then istate = uaqueued 2 %and ->valid
      %finish
#if ~f
      monitor(null,spurious uframerx)
#fi
      ->noise
   %else ;!LINK UP
      %if type&3=3 %start
         %if type=frmr %start
            frmrrx = frmrrx + 1

         %elseif type = sabm
            abort(sabm received)

         %elseif type = disc
            abort(disc received)

         %finishelse abort(uframe in data)
         -> noise

      %elseif type=iframe
         %if s = eee %start ;!Sequence OK
   
            %if l > 2 %start
               clock4 = 0;         ! No too long frame received
               p_ser=kernel ser
               p_reply = own id
               p_fn=input req 
               p_line=line ;!Redundant here
               p_m == m_b
               p_m_len=l-2 ;!Length excluding address & control bytes
#if ~f
               monitor(p,to upper)
#fi
               buffers held = buffers held - 1
               irx = irx + 1 ;!Just keep a count
               pon(p)
      
               x25==null ;!Avoid freeing buffer
            %finishelse nullrx = nullrx + 1

            eee=(eee+1)&7 ;!Increment received sequence no.
      
            %if no of buff<big limit %or hold rnr # 0 %start
#if ~f
               monitor(null,bufferslow) ;!Keep a count
#fi
               rstate = rnrpending
               !Send RNR if buffers get low

            %elseif ttt = fff %or tstate # 0 %or (ttt - aaa) & 7 = window
               !We either have no iframes to transmit or are blocked. Send an RR
               rstate = rrdeferred

            %finish
         %else ;!Sequence error
            rstate = rejpending %unless rstate = rejsent %or (eee-s)&7=1
            !Set REJ pending unless we have already sent one or its a retransmission
         %finish
      %else ;!Supervisory frames
         %if type=rr %then tstate=0 %and rrrx = rrrx + 1 %elsestart
         !Clear his RNR (if is was ever set) and count RRs
            %if type=rnr %then %c
               clock1=0 %and tstate=1 %and rnrrx = rnrrx + 1 %c
            %elsestart
               %if type=rej %start
                  rejrx = rejrx + 1 ;!Count them
                  tstate = 0 ;!REJ clears RNR
               %finishelse monitor(null,badframes rx) %and ->noise
            %finish
         %finish
      %finish
      !
      x=aaa
   
      %while x&7#r %cycle
         %if x=xxx %start
#if ~f
            monitor(null, badack) ;monitor(null, query) ;write(r, 3) ;newline
#fi
            abort(reset)
            ->valid
         %finish
         x=(x+1)&sfmask
      %repeat
   
      %unless active=2 %and (xxx-x)&sfmask <= (xxx-ttt)&sfmask %start 
         !Ignore ack if it includes one for block currently being transmitted
   
   
         %while aaa#x %cycle ;!Free off ackked blocks
            wdesc == wspace(aaa)
            free buffer(wdesc_m); wdesc_m == null
            itx = itx + 1 ;!Just count them
            wdesc_m==null
            !I have managed to convince myself that TTT could equal AAA
            !If we receive an ack for a frame while in mid-retransmit
            !If we dont do this, TTT and AAA could wind up inside-out.
            ttt = (ttt+1) & sfmask %if ttt = aaa
            aaa=(aaa+1)&sfmask ;!Increment sequence no. of first frame not ackked
            xxx=ttt ;clock1=0 ;window=6 ;!Leave Timer recovery condition
            clock3=0
         %repeat
         %if ttt#xxx %then ttt=aaa ;!Retransmitting: retransmit first unackked frame
         %if type=rej %start
            ttt = aaa ;xxx = ttt
            %if rstate = rrsent %or rstate = rejsent %then rstate = rr pending
         %finish
 
         !to the first one not ackked If a Reject or retransmission

      %finish
   %finish
   !
valid:
   ! "Valid" here just means that the CRC was OK and it was a recognisable frame
   clock2=0 ;!Reset validity timer - chops him if this gets too big.
noise:
   
   free buffer(m_b) %and m_b == null %unless x25==null %or m_b == im

   !
   handle output
   !
%end ;!of handle input
 



%routine clock int
   alarm(25) ;!Replace 1/2 second timer
   clock0=clock0+1
   
#if p
   !Special code for nasty spivvo dup11s
   !Watchdog expires if rxdone is not followed by an interrupt within
   !a second or so.
   %if hw_rcs & rx done # 0 %start
      rx watchdog = rx watchdog + 1
      %if rx watchdog = 5 %start
         printstring("Rx Watchdog Invoked") ;newline
         reinitialise hardware
      %finish
    %elseif hw_tcs & tx done # 0
      tx watchdog = tx watchdog + 1
      %if tx watchdog = 5 %start
         printstring("Tx Watchdog Invoked") ;newline
         reinitialise hardware
         active = 0
       %finish
    %finish
#fi

   %if istate#0 %start
   
      %if dcedte=dce %start ;!We are configured to be the DCE
         %if clock0 >= t1-1 %and istate=dce waiting for ua %then %c
            istate=disc queued %and poll = pending
         %if clock0>= t1*n2-1 %and istate=waiting for sabm %then %c
            istate = disc queued %and poll = clear
      %else ;!We are the DTE
   
         %if clock0 >= t1-1 %start
            %if istate=waiting for ua %start
               %if clock3 <= n2 %start
                  clock3 = clock3 + 1
                  istate=sabm queued
                  poll = pending
               %else
                  istate = disc queued
                  poll = clear
               %finish
            %elseif istate = dte waiting for ua
               %if clock3 <= n2 %start
                  clock3 = clock3 + 1
                  istate = disc queued
                  poll = pending
               %else
                  istate = waiting for disc
                  poll = clear
               %finish
            %finish
         %finish
      %finish
   %else ;!Link up
   
      %if rstate = rrdeferred %start
         %if no of buff < big limit %or hold rnr # 0 %then rstate = rnrpending %c
         %else rstate = rrpending
      %finish

       %if no of buff < big limit %start;   ! time this out
          clock5 = clock5 + 1
          %if clock5 > 360 %then abort(no buffs)
      %finish

      clock2=clock2+1
      %if clock2 = n2*t1 %and aaa # xxx %start
         !No data acknowledged by far end in 80 ticks.
         abort(line timeout)
      %finish
      !Clock 1 is knocked back whenever one of our frames is ackked or
      !we retransmit. If there is a frame unacknowleged (AAA#TTT) and it
      !hasnt been ackkecd for 5 seconds we wil retransmit
      !unless he has RNR up.
      %if aaa#xxx %then clock1=clock1+1
#if q
         ! code for dqs losing occasional ints
         %if clock2 = 20 %and active # 0 %start;  ! recover it (after 10 secs)
           printstring("TX Watchdog Invoked
")
           hw_tcsr = 0;    ! clear it out
           hw_tcsr = tx go;! kick it (will send grotty frame but who cares!)
        	    ! Leave it alone now, as it ought to gen an interrupt
        %finish
        %if clock2 > 200 %and active # 0 %start;  ! had it
                printstring("DQ:Lost Timing or Interrupt
")
           reinitialise hardware;  ! ditch (&lose) the current block!!!!
           active = 0
           abort(line timeout)
        %finish

#fi

      %if clock1 >= t1 %and aaa#ttt %and tstate=0 %start
         !Enter Timer Recovery state
         clock3=clock3+1
         ttt=aaa ;window=1
         %if clock3 >= n2 %then abort(dataretries) %and %return ;!Retry N2 times and give up
      %else
         %if clock0 >= t1*2 %and quiet idle =0 %start ;!RCO-Defined line idle poll
            comres = command
            rstate = rnrpending %if no of buff<big limit %or hold rnr # 0
            rstate = rrpending %if rstate = rrsent %or rstate = rnrsent
         %finish
      %finish
   
   %finish
   handle output
%end ;!Of clock int



%routine monitor(%record (pf) %name p,%integer type)
#if ~f
   %record (x25f) %name x25
   %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

   %elseif k = 3
      i = 1; j = 1

   %elseif k = 4
      !Frame sent to or received from hardware
      selectoutput(1)
      printsymbol(6) ;printsymbol(own id) ;printsymbol(type)
      printsymbol(parb_type) ;printsymbol(parb_len&255)
      x25 == parb_b
      printsymbol(x25_add) ;printsymbol(x25_type)
      selectoutput(0)
      %return

   %finish


   %if j # 0 %start ;!_Log to .TT
      printstring("*Xpro ") ;printstring(longnetname(line)) ;write(type, 1) 

      %if type = bad fr %start
         printstring(" Bad Frame")

      %elseif type = frmrs rx
         printstring(" FRMR:")
         x25 == parb_b
         write(x25_octet1, 1) ;write(x25_octet2, 1) ;write(x25_octet3, 1)

      %finish
      newline
   %finish

   %if i # 0 %start
      selectoutput(1)
      %if p == null %start
         printsymbol(2) ;printsymbol(own id) ;printsymbol(type)
      %else
         pa == p
         printsymbol(10) ;printsymbol(own id) ;printsymbol(type)
         %for i = 0,1,7 %cycle
            printsymbol(pa_a(i))
         %repeat
         %unless p_m == null %start
            %if (type = to upper %and p_fn = input req) %c
            %or (type = from upper %and p_fn = output req) %start
               pa == p_m
               %if 1 <= p_m_len <=19 %then j = p_m_len + 9 %else j = 28
               !4 bytes (link,len,type) 5 bytes (3 pads,addr,ctrl)
               printsymbol(j)
               %for i = 0,1,j-1 %cycle
                  printsymbol(pa_a(i))
               %repeat
            %finish
         %finish
      %finish
      selectoutput(0)
   %finish

#fi
%end ;!of Monitor


%routine query processes
   %integer i
   printstring(longnetname(line))
   %if dcedte = dce %then printstring(" DCE") %else printstring(" DTE")
   printstring(" BH=") ;write(buffers held,1)
      %if istate = link up %then printstring("  Link Up") %else %c
        printstring("Link Down:") %and write(istate, 1)
      printstring(" A:")
   write(active,1) ;printstring(" Clks:")
   write(clock0,1) ;write(clock1,1) ;write(clock2,1) ;write(clock3,1)
   write(clock4,1) ;write(clock5,1)
   newline
   %if istate=link up %start
      printstring(" R,T") ;write(rstate,1) ;write(tstate,1)
      printstring("AETFX=") ;write(aaa,1) ;write(eee,1)
      write(ttt,1) ;write(fff,1); write(xxx,1)
      newline
   %finish
   printstring("I,rr,rnr,rej,disc,ua,sabm,frm,ier,null,wcov,silo:")
   printstring("
Rx:")
   %for i = 0, 1, 11 %cycle ;write(integer(addr(irx)+i<<1), 1) ;%repeat
   printstring("
Tx:")
   %for i = 0, 1, 8 %cycle ;write(integer(addr(itx)+i<<1), 1) ;%repeat
   newline
%end ;!of Query Processes


%routine reinitialise hardware
   !Grabs Interrupt service nos and sets/resets Hardware
   linkin(rxint) ;linkin(txint)
   parb_type=initialise
   parb_b==handler address
   parb_len = line ;!Line Number for Multiple DUPs. Must be 0 <= x <= 2
   to comms hw(parb)
   free buffer(icurr_m) %and icurr_m == null %unless icurr_m == null %or icurr_m == im
   icurr_m==im ;!set up a short read
   icurr_len = 4
   active = 0 ;abort req = 0
   tx watchdog = 0 ;rx watchdog = 0 ;tx reply = 0 ;rx reply = 0
   start input
%end ;!of reinitialise hardware

%routine reset line
   tstate=0 ;!Assume no RNR from far end
   rstate = rrpending ;comres = command ;!Start off by sending a RR command
   final = clear
   !Zero transmit and receive sequence numbers
   aaa=0
   eee=0
   fff=0
   ttt=0
   xxx=0
   clock1=0
   clock2=0
   clock3=0
   clock4=0
%end ;!of reset line



%routine start input

   parb_type=line input     ;!Put a read on
   parb_b == icurr_m_x25
   parb_len = icurr_len
   %if icurr_len # 4 %and 0 # icurr_m_type # 64 %then stop(grotted 5)
   to comms hw(parb)
%end ;!of start input



%routine stop(%integer reason)
   %record (pf) p
   printstring("Xpro ") ;printstring(longnetname(line)) ;printstring(" disaster")
   write(reason, 1) ;newline
   !Gracefully. (This may not be a good idea but we'll try it.)
   %cycle
      poff(p) ;!Should be better than a tight loop -
      !a) Scheduler knows we're suspended   b) won't fill poff queue
   %repeat
%end ;!of Stop

%routine octal(%integer n)
   %integer i
   printsymbol((n >> i)&7+'0') %for i = 15, -3, 0
%end ;!of Octal



%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 uploop, downloop, up, 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
      *cmp_3,2      ;!Is TO address > FROM address?
      *bgt_up      ;!Yes - Move from top down in case...
      *beq_return  ;!Move in place - Null function
!
!     Loop to move LEN bytes FROM -> TO
!
downloop: *movb_(2)+,(3)+     ;! Move the byte
      *sob_1,downloop           ;! decrement & Continue if length not exhausted       
      *br_return
!
up:   *add_1,2
      *add_1,3
uploop: *movb_-(2),-(3)
      *sob_1,uploop
return:
      %return
%end ;!of Move


%routine replace read
   !The object of this routine is to get the next read on as fast as possible.
   !Side-effect is that once the first read after a reinitialise hardware has
   !been issued it is never taken off.

   !The old read returns the actual length read plus a flag via des. We
   !remembered the read base address in PAD.  We return..
   !read address in parb_ADDRESS
   !read length  in parb_LEN
   !x25 address  in ADDRESS
   !x25 control  in TYPE
   !These last two fields are passed up separately to avoid their being
   !overwritten if we are reading into IM

   %integer x, flag, ext bits
   
#if q
   %if hw_rsr&k'34067' = 0 %start
      %if hw_rsr&k'1000' # 0 %then flag = -2 %and wcov=wcov+1 %and -> flt
                            ! WC OVERFLOW
      flag = 0
      parb_len = hw_rcar-cad-2 
      parb_len = parb_len + 1 %if cad&1 # 0 ;!DQS ODD-BYTE

                            ! NUMBER OF BYTES TRANS
      %if hw_rsr&k'074000' # 0 %then parb_len = parb_len-1

   %else
      flag = -1;          ! FRAME ERROR
      %if hw_rsr&k'20' # 0 %then flag = -3;  ! SILO FULL
      silo = silo+1
flt:  hw_rcr = 0;          ! CLEAR DOWN
      hw_rcr = k'10';      ! AND UP AGAIN
   %finish
#else
   flag = des_rx_flag
   parb_len = des_rx_pt - cad
#fi
   parb_address = pad
#if q
   !If it was an odd-byte read, address & type will be in wrong place
   %if pad & 1 = 0 %start
      address = parb_b_add ; type = parb_b_type
   %else
      address = byteinteger(addr(parb_b_add)-1) ; type = parb_b_add
   %finish

#else
   address = parb_b_add ;type = parb_b_type
#fi

   icurr_m == grab buffer;   ! attempt to steal buffer from buffer manager
   %if icurr_m == null %start ;!If we failed for any reason, put a short read on instead
      icurr_m == im
      icurr_len = 4

   %else ;!Otherwise make it a long one
      icurr_len = big buffer length-7

   %finish

   pad = icurr_b + 7 ;!i.e. addr(icurr_m_x25)
   par = raddr(pad>>13)
#if q
   par = par + (pad & k'17700') >> 6
   ext bits = (par & k'176000') >> 6
   cad = par << 6 + pad & k'77'
   x = cad & x'fffe' ;hw_rcar = x
   x = -(icurr_len >> 1) ;hw_rwcr = x
   x = rxgo ! ext bits ;hw_rcr = x
#else
   cad = pad&k'17777'!K'140000';   ! IN SEG NO 6
    des_rx_maxln = icurr_len
   des_rx_seg = par
   des_rx_pt = cad
   !If we are running with read-chained-read DUP driver, DUP read is
  !re-initialised for us.
    %if line type # 2 %then hw_rcs = hw_rcs!K'100'!RCVEN
    des_rx_state = 0
#fi

   stop(12) %if icurr_len # 4 %and (0 # icurr_m_type # 64)

   %if flag < 0 %then parb_len = flag %elsestart
      %if parb_len > 252 %start
#if ~q
         printstring("DUP: read len > 252:")
         octal(hw_rcs) ;space ;octal(cad) ;space ;octal(parb_len) ;newline
#else
         printstring("DQS: read len > 252:")
         octal(hw_rcar) ;space ;octal(cad) ;space ;octal(parb_len) ;newline

      %finishelsestart
         %if parb_address & 1 # 0 %start
            !DQS doesnt obey odd addresses - received data will
            !start at parb_address&X'FFFE' so shift up 1 byte to compensate
            move(parb_len, parb_address&x'FFFE', parb_address)
         %finish
#fi
      %finish
  %finish
%end


%routine to comms hw(%record (parf) %name p)
   %routine dup11e(%record (parf) %name p)
#if ~q


      %recordformat r1f(%integer n)
      %recordformat r2f(%record (des2f) %arrayname des)

      %record (r1f) r1; %record (r2f) %name r2

     %constinteger mark = k'377'
     %constinteger parm = k'101062';         ! MODE=BYTE, NO CRC

      %integer i

      %switch typesw(initialise:output done)



      -> type sw(p_type)

type sw(initialise):            ! LEN IS NOW THE DEVICE NUMBER   (0-2)
     id = get id
     maphwr(3)
     hw == p_b

      %for i = 1, 1, 7 %cycle;              ! FIND ABSOLUTE ADDRESSES
         raddr(i) = map abs(i<<13, 256, id); ! MY ADDRESSES
         f = map abs(i<<13, 0, id);      ! AND OFF AGAIN
       %repeat

      x = dup addr(0)
      r2 == r1
      r1_n = x&k'77';           ! JUST THE PAGE DISPLACEMENT
      desx == r2_des; des == desx(p_len)
      des_rx_vec = k'160000'!(P_ADDRESS&K'17777')
      des_tx_vec = des_rx_vec
      hw_tcs = 0; hw_rcs = 0;  ! ensure ints etc are OFF (stuff pending)
      hw_tcs = hw_tcs!DRS;   ! RESET THE DEVICE
      i = 0;                   ! TO FORCE A MOV #0,
      hw_rdb = i;             ! PARM = 0
      hw_rcs = hw_rcs!DTR
      %while hw_rcs&dsr = 0 %cycle; %repeat
      hw_rcs = hw_rcs!RTS
      %while hw_rcs&cts = 0 %cycle; %repeat
      %while hw_rcs&dcd = 0 %cycle; %repeat
      hw_tcs = hw_tcs!K'100'!SND
      hw_tdb = tsom

      %return

type sw(output done):
                                       ! TRANSMITTER
              type = line output
              %if des_tx_flag < 0 %or txreply = 0 %start
                 !! TRANSMITTER ERROR
                 printstring("TX ERROR
")
                 p_len = 1
              %else
                 p_len = 0
              %finish
            p_type = line output
              txreply = 0
              %return

type sw(input here):
            %return

type sw(line input):
           !! USER CALL
              !!  First READ REQUEST after a hardware reset
              pad = p_address
!              PAR = MAP ABS(PAD, P_LEN, RXREPLY)
              par = raddr(pad>>13)
              %if par = 0 %then -> abort
              cad = pad&k'17777'!K'140000';   ! IN SEG NO 6
               des_rx_maxln = p_len
              des_rx_seg = par
              des_rx_pt = cad
               hw_rcs = hw_rcs!K'100'!RCVEN
               des_rx_state = 0
              %return

type sw(line output):
              !! OUTPUT REQUEST
              %if tx reply # 0 %then -> abort
              tx reply = id
              oseg = p_address
!              PAR = MAP ABS(OSEG, P_LEN, TX REPLY)
              par = raddr(oseg>>13)
              %if par = 0 %then -> abort
              des_tx_seg = par
              des_tx_pt = p_address&k'17777'!K'140000';  ! IN SEG NO 6
               des_tx_sa = p_len;     ! LENGHT IN CHARS
               des_tx_state = 1;           ! TELL IT TO EXPECT INTS
         %return

abort:
     printstring("DUP FAIL
")
     stop(mon hw fail)


#fi
   %end ;!of DUP11E


   %routine dqs11e(%record (parf) %name p)
#if ~p

     %integer i



      %switch typesw(initialise:modem status)



      -> type sw(p_type)

type sw(initialise):
     id = get id
     %for i = 1, 1, 7 %cycle;       ! FIND ABSOLUTE ADDRESSES
        raddr(i) = map abs(i<<13, 256, id); ! MY ADDRESSES
        f = map abs(i<<13, 0, id);   ! AND OFF AGAIN
     %repeat

     maphwr(0)
     p_address = p_address&k'17777'; ! ENSURE ADDRESS IN SEG 0
     hw == p_b
     hw = 0;                          ! TIDY IT UP FIRST
     hw_mcsr = k'40003';              ! DON'T TRANSFER THE CRC
     hw_rcr = k'10';                  ! ENABLE RECEIVER
     hw_tcsr = k'10';                 ! ENABLE TRANSMITTER
      rx reply = 0; tx reply = 0
      %return

type sw(output done):
                                       ! TRANSMITTER
              type = line output
              %if hw_tcsr < 0 %or txreply = 0 %start
                 !! TRANSMITTER ERROR
                 printstring("TX Error
")
                 p_len = 1
              %else
                 p_len = 0
              %finish
            p_type = line output
              txreply = 0
              %return

type sw(input here):
      %return

type sw(line input):
           !! USER CALL
              !! READ REQUEST
              %if rx reply # 0 %then -> abort
              rxreply = id
              pad = p_address
!              PAR = MAP ABS(PAD, P_LEN, RXREPLY)
              par = raddr(pad>>13)
              %if par = 0 %then -> abort
              par = par+(pad&k'17700')>>6; ! ENSURE ACTUAL BLOCK
              ext bits = (par&k'176000')>>6
              cad = par << 6+pad&k'77'
              x = cad&x'FFFE' ;hw_rcar = x

              x =- (p_len >> 1) ;hw_rwcr = x ;!Avoid compiler nasties (see bottom)
              x = rxgo!EXT BITS ;hw_RCR = X
         %return

type sw(line output):
              !! OUTPUT REQUEST
              %if tx reply # 0 %then -> abort
              tx reply = id
              oseg = p_address

              !Shuffle data one byte left to cope with DQS.  Leave a flag
              !in p_m_d0 to remind us not to do it again on retries
              !oseg-3 should correspond to p_m_d0.
              !Note that short blocks sent from om will be on an even byte
              !otherwise we would attempt to write a 1 3 bytes in front of om

              %if oseg&1 # 0 %and byteinteger(oseg-3) = 0 %start
                 move(p_len, oseg, oseg-1); byteinteger(oseg-3) = 1
              %finish

              par = raddr(oseg>>13)
              %if par = 0 %then -> abort
              par = par+(oseg&k'17700')>>6;  ! ENSURE ACTUAL BLOCK
              ext bits = (par&k'176000')>>6
              x = par << 6+p_address&k'77'
            x = x & x'FFFE' ;!DQS ODD-BYTE
            hw_tcar = x
              f = 0
              x =- ((p_len+1) >> 1) ;hw_twcr = x
              %if p_len&1 # 0 %start
                 f = k'040000';        ! 8 IN REMAINING BIT FIELD
              %finish
              x = tx go!F!EXT BITS ;hw_TCSR = X
         %return

type sw(modem status):
      %return

abort:
     printstring("DQS Fail
")
     stop(mon hw fail)


#fi
   %end ;!of DQS11E


   stop(mon hw fail) %if p_b == null %and p_type # initialise
#if p
   dup11e(p)
#else
   dqs11e(p)
#fi
%end ;!of to comms hw


%routine to xgate(%integer flag)
   %record (pf) p
   !Routine to send an 8-byte parameter area to XGATE giving it global
   !status, namely   XPROT UP   LINK ESTABLISHED/DOWN.
   !Differs from RCO-HDLC version in that LINK ESTABLISHED call passes
   !a Zero as the X25 address.
   
   p_ser = kernel ser
   p_reply = own id
   p_fn=output req
   p_line=line
   p_m == null
   p_c = flag
#if ~f
   monitor(p,to upper)
#fi
   pon(p)
   
%end ;!of to XGATE



%endofprogram

!
!Compiler is apt to do arithmetic in the LHS when compiling statements
!such as LHS = <arithmetic expression>.  Doesnt usually matter but bad
!news if LHS is a hardware register - Arithmetic will twiddle status
!bits etc.

version hierarchy:
!P = DUP11 only
!Q = DQS11 only
!F = Fast (Monitoring cut out)