! *      The program works on the (3-3) noise in both directions line.  *
! *      A crc was not implemented, the one supplied was used.          *
! *      The object file is held on filestore 14 (wee)                  *

!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

!      ICD_products@1984

!           X25 level2 software

!              Top breeders recommend it !

!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

! externals

%externalroutinespec inputpacket(%string(255) data)
%externalroutinespec outputblock(%integer address,length)
%externalroutinespec packetoutput
%externalroutinespec linkstatus(%integer code)
%externalroutinespec blockinput
%externalroutinespec linkstatus(%integer code)
%externalshortfunctionspec crc(%integer address,length)


! consts

%constbyteinteger yes=1,
                  no= 0,
                  uplink= 1,
                  downlink= 0,
                  maxtimer1= 6,
                  maxretry= 5,
                  maxahead= 4,
                  a= 2_00000011,
                  b= 2_00000001,
               sabm= 2_00101111,
               disc= 2_01000011,
                 dm= 2_00001111,
                 ua= 2_01100011,
                 rr= 2_00000001,
                rnr= 2_00000101,
               frmr= 2_10000111,
               cmdr= 2_10000111,
                rej= 2_00001001,
              itype= 2_00000000,       {frame types
              utype= 2_00000011,
              stype= 2_00000001

! vars

! sliding windows
%ownstring(255)%array sendbuffer(0:3),       { 2 -> 1 buffer
                      recbuffer(0:3)         { 2 -> 3 buffer

! if physical level has not acknowledged the last frame sent then any
! supervisory or unnumbered frame will have to be buffered. The buffer
! is only 1 big, containing only the most recent of these frames.
%ownstring(255) extrabuffer3                 { buffers supervisory frames
%ownbyte extrabuffer1= 0,extrabuffer2

%ownbyteinteger sendptr= 0,       {ptr into sliding window
             oldsendptr= 0,       {for retransmissions
             sendno= 0,           {send ahead
             recptr= 0,
             recno=  0,
             retry= 0,            {counter 2
             timer1= 0,           {counter 1
             running= no,
             vs= 0,
             vr= 0,
             acked=0,             {last acknowledged frame
             mode= downlink,
             DTEbusy= no,
             DCEbusy= no,
             transup= no,
             uareqd= no,
             rejmode= no,
             OKtoGETpacket= yes,        {level 3 + 1 handshakes
             OKtoSENDblock= yes,
             pfbit=      0

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! routines

%routine START TIMER
 timer1= 0
 running= yes
%end

!________________________________________________________________________
%routine STOP TIMER
  running= no
%end


!_______________________________________________________________________
! control param determines frame type
%routine SEND(%byte address,control,%string(255) what)
%ownbytearray data(1:259)
%owninteger all
%integer i
%short temp0

%if OKtoSENDblock= yes %and (DCEbusy= no %or control# itype) %start
! send only if the physical level and DCE will allow
    data(1)= address
    data(2)= control!pfbit
    %if pfbit#0 %then pfbit= 0
    all= length(what)+2
    data(i)= charno(what,i-2) %for i= 3,1,all
    %if data(2)&3# utype %then data(2)=data(2)!(vr<<5)
    %if data(2)&3= itype %then data(2)=data(2)!(vs<<1)
    temp0=crc(addr(data),all)
!add checksum
    data(all+2)= temp0>>8
    data(all+1)= temp0&255
! send frame
    outputblock(addr(data(1)),all+2)
    %if control= itype %start
! slide window
        sendptr= (sendptr+1)&3
        vs= (vs+1)&7
    %finish
%if address= b %then START TIMER
OKtoSENDblock= no
%finish  %else %if control# itype %start
! buffer any non i frames: most recent is buffered
    extrabuffer1= address
    extrabuffer2= control
    extrabuffer3= what
%finish
%end

!__________________________________________________________________________
%externalroutine PACKETSTATUS(%integer code)
%if code= 1 %start
  %if mode= downlink %start
      send(b,sabm,"")
      uareqd= yes
  %finish
  transup= yes
%finish
%end


!_____________________________________________________________________
%externalroutine CLOCKTICK
%if running= yes %start
    timer1= timer1+1
    %if uareqd= no %and (vs+8-acked)&7= 0 %then STOP TIMER
      %if timer1>= maxtimer1 %start
        retry= retry+1
        %if retry>= maxretry %then packetstatus(-1)
        START TIMER 
        %if uareqd= yes %start
            %if mode= downlink %then send(b,sabm,"")
        %else
            vs= acked
            sendptr= (sendptr+4-((vs+8-acked)&7))&3
            send(b,itype,sendbuffer(sendptr))
        %finish
    %finish
%finish 
%end



!_______________________________________________________________________
%externalroutine PACKETINPUT
recno= recno-1
OKtoGETpacket= yes
! 1 less packet held in 2-> 3 buffer
%if recno= 3 %start
   DTEbusy= no
   send(a,rr,"")
%finish
%if recno# 0 %start
 input packet(recbuffer((recptr+4-recno)&3))  
 OKtoGETpacket= no
%finish 
%end


!_____________________________________________________________________________
%externalroutine OUTPUT PACKET(%string(255) data)
%byte newposition= (oldsendptr+sendno)&3
 sendbuffer(newposition)= data
 sendno= sendno+1
 %if (vs+8-acked)&7< max ahead %then %c
                       send(b,itype,sendbuffer(sendptr))
 %if sendno# 4 %then packetoutput
%end
  
  
!___________________________________________________________________________
%externalroutine INPUTBLOCK(%integer address,length)
%constbyte contr= 1,
           UorSerror= 3,
           lengt= 4,
           order= 8
%byte addr=byteinteger(address),
      control=byteinteger(address+1),
      nrsent=(control>>5)&7,
      nssent=(control>>1)&7

!_________
! sends frmr
     %routine REJECT(%byte why,contr,addr,vr,vs)
     %byte reply
      %if addr= a %then reply= 0 %else reply= 1
      send(a,frmr,tostring(contr).tostring(vs<<1!vr<<5!reply<<4). %c
            tostring(why))
      uareqd= yes
   %end

!________
! checks incoming crc
   %predicate FRAME OK(%byte addr,%integer address,length)
   %short newcrc= byteinteger(address+length-1)<<8+byteinteger(address+length-2)
    %if crc(address,length)= 16_0f47 %and %c
        (addr= a %or addr= b) %then %TRUE
    %FALSE
   %end

!________
! converts byte array to a string
   %string(255)%function string(%integer address,length)
     %if length=0 %then %result= ""
     %result= tostring(byteinteger(address)).string(address+1,length-1)
   %end

!________
! sets up for transmission at the specified sequence no
   %routine RETRANSMIT REQD(%byte nrsent)
     vs= nrsent
     START TIMER
     sendptr= oldsendptr
     send(b,itype,sendbuffer(sendptr))
   %end

!______________
! checks nr in control field
%routine CHECK PIGGY(%byte nrsent)
%byte update= (nrsent+8-acked)&7
                  oldsendptr= (oldsendptr+update)&3
                  %if sendno= 4 %and update# 0 %then packetoutput
                  sendno= sendno-update
                  acked= nrsent
                  %if vs# acked %then START TIMER %else retry= 0
%end

!_______________
! accept this frame
%routine ACCEPT BLOCK(%integer address,length)
       %if DTEbusy= no %start
                  STOP TIMER
                  retry= 0
                  recbuffer(recptr)= string(address+2,length-4)
                  %if OKtoGETpacket= yes %start
                         input packet(recbuffer((recptr+4-recno)&3)) 
                         OKtoGETpacket= no
                  %finish
                  recptr= (recptr+1)&3
                  vr= (vr+1)&7
                  recno= recno+1
                  %if recno= 4 %start
                      DTEbusy= yes
                      send(a,rnr,"")
                  %finish %else %c
                  %if (sendptr+8-oldsendptr)&7=sendno %c
                   %then send(a,rr,"") 
! send ack by rr if no transmissions pending
%finish
%end

!______________
! checks frame is in sequence 
%predicate INCORRECT(%byte nrsent)
%if vs>acked %start
  %if nrsent>=acked %and nrsent<= vs %then %FALSE
%else %if vs< acked
  %if nrsent<= vs %or nrsent>= acked %then %FALSE
%else %if nrsent= vs %then %FALSE
%TRUE
%end

{ start block input }

%if FRAME OK(addr,address,length) %start
  pfbit= control&16
! INFORMATION frames
  %if control&1= itype %start
        %if length > 259 %or length< 5 %start
          REJECT(length,control,addr,vr,vs)
        %finish %else %if DTEbusy= no %and UAreqd= no %start
               %if INCORRECT(nrsent)  %start
                  REJECT(order,control,addr,vr,vs)
               %finish %else %if nssent # vr %and rej mode= no %start
                  send(a,rej,"")
                  rej mode= yes
               %finish %else %if nssent = vr %start
                  ACCEPT BLOCK(address,length)
                  rej mode= no
               %finish
               CHECK PIGGY(nrsent)
        %finish
    
! UN-NUMBERED frames
  %finish %else %if control&3= utype %start
        %if length# 4 %and (length#7 %or control&128#128) %start
                  REJECT(UorSerror,control,addr,vr,vs)
        %finish %else %start
                  %if control&239= ua %start
                        uareqd= no
                        DCEbusy= no
                        STOP TIMER
                     %if mode= downlink %start
                         mode= uplink 
                         link status(1)
                     %finish
                  %finish %else %if control&239= sabm %start
                        DCEbusy= no
                        rej mode= no
                        retry=0 
                        DTEbusy= no
                        PFbit= 0
                        send(a,ua,"")
                        vr= 0
                        vs= 0
                 %finish %else %if control&239= disc %start
                        send(a,ua,"")
                        mode= downlink
                        linkstatus(0)
                 %finish %else %if control&239= frmr %start
                        printstring("FRMR")
                 %finish %else %if control&239= dm %start
                        send(a,ua,"")
                        mode= downlink
                        linkstatus(0)
                        printstring("dm")%andstop
                 %finish %else REJECT(contr,control,addr,vr,vs)
        %finish
! SUPERVISORY frames
  %finish %else %if control&3= stype %start
        %if length# 4 %start
                  REJECT(UorSerror,control,addr,vr,vs)
        %finish %else %if uareqd= no %start
!        ack command supervisor frames
                  %if addr= a %then send(a,rr,"")
                  %if control&15= rej %start
                     DCEbusy= no
                     CHECK PIGGY(nrsent)
                     RETRANSMIT REQD(nrsent)
                  %finish %else %if control&15= rnr %start
                     DCEbusy= yes
                     CHECK PIGGY(nrsent)
                  %finish %else %if control&15= rr %start
                     DCEbusy= no
                     CHECK PIGGY(nrsent)
                  %finish %else REJECT(contr,control,addr,vr,vs)
        %finish
  %finish %else REJECT(contr,control,addr,vr,vs)
%finish
blockinput
%end {block input}


           
!______________________________________________________________________
%externalroutine BLOCK OUTPUT
OKtoSENDblock= yes
! send the buffered S or U frame (if it exists) first
%if extrabuffer1# 0 %start
  send(extrabuffer1,extrabuffer2,extrabuffer3)
  extrabuffer1= 0
%finish %else %if DCEbusy= no %start
! send I frame if any are available
  %if (vs+8-acked)&7 < maxahead %and sendno# 0 %And (vs+8-acked)&7<sendno %then %c
      send(b,itype,sendbuffer(sendptr))
%finish
%end
        
%endoffile
