! file ring_ringk7s

!********************************
!*    emas-2900   ring interface *
!*                    handler     *
!*      file: ringk7s              *
!*   date:20.nov.81               *
!*  For use with KMC11 only      *
!*********************************
!!  stk = 300,  strm = 1



%control 1
%include "deimosperm"
%constrecord (*) %name nil == 0

%begin

     %conststring (7)vsn = "vsn007e"

     %recordformat mef(%record (mef) %name link, %byteinteger len, %c
       type, %integer address, %integerarray a(0:100) )
                                                  ! think about the position of
                                                  ! 'len'




     %recordformat pe(%byteinteger ser, reply, fn, port, %c
       (%record (mef) %name mes, %byteinteger len, s1     %or  %c
       %integer lport, hport))





                                             !!           ring interface registers

                                                  !-----------------------------


%recordformat ringf(%integer rdata,source,sourceselect,status, %c
                tdata,dest,spare,intstat)

%constrecord (ringf) %name ring==k'004040';  ! in seg 0

%recordformat kmc11f(%byteinteger csr0, csr1, csr2, csr3, %integer ibuff, obuff)

      %constrecord (kmc11f) %name kmc == k'000160'
! KMC bit meanings
      %constinteger int enable = 1, csr i req = x'10', o ack = x'80'; ! csr0
      %constinteger rfn = 0, wfn = 1;                                 ! csr2 & 3
      %constinteger gobit = x'80'
      %constinteger kmcreq = x'10';                                   ! csr3



!           ring command/status register bits

%constinteger  busy=1
%constinteger  unselected=2
%constinteger  accepted=4
%constinteger  ignored=8
%constinteger  badpacket=16
%constinteger  packet rejected=64


!ring interface status bits

%constinteger  receive=1
%constinteger  transmit=2
%constinteger  onoff=16
%constinteger  rintoff=k'40'
%constinteger  rinton=k'100'
%constinteger  tready=k'200'
%constinteger  tintoff=k'400'
%constinteger  tinton=k'1000'
%constinteger  iproff=k'2000'
%constinteger  ipron=k'4000'
%constinteger  iptoff=k'10000'
%constinteger  ipton=k'20000'
%constinteger  repa=k'100000'




                                                  !byte stream command codes

%constinteger  rdy=x'3000'
%constinteger  notrdy=x'5000'
%constinteger  reset=x'6300'
%constinteger  close=x'6600'
%constinteger  data=x'a000'
%constinteger  nodata=x'c000'
%constinteger  closereq=4


                                                  !transport service command codes


%constinteger  open=x'6a00'
%constinteger  openack=x'6500'
%constinteger  longblock=x'9000'
%constinteger  longblockch=x'9000'
%constinteger  longblockcs0=x'9400'
%constinteger  singleshot=x'9800'





!                      incoming function codes
!                      -------------------------


!he following values may be added to the output codes

%constinteger release flag=x'80';           !release buffer at end of output
%constinteger tell flag=x'40';             !notify at end of transfer
%constinteger cs0flag=x'20'


%constinteger command mask=x'1f';           !to get command code

%constinteger enable port=0
%constinteger xdata=1
%constinteger ssout=2;            !single shot output
%constinteger xrdy=3
%constinteger xnotrdy=4
%constinteger xnodata=5
%constinteger xclose=6
%constinteger xreset=7
%constinteger xclosereq=8
%constinteger disable port=15
%constinteger output trace=16;     !force output of trace buffer


!                              outgoing function codes
!                                 -----------------------

%constinteger output done=0
%constinteger transfer error=1
%constinteger r input done=2
%constinteger input error=3



%constinteger  timeout=2;                         !number of alarm calls


!time is incremented on every alarm call, on overflow to
!zero it is set to 1 as time 0 implies time-not-set



%owninteger ntimes=0
%owninteger time


%owninteger me;                       !ring address

%integer t,i









                    !**************************************************************

                    !*         buffer manager calls   (from and to)               *

                    !**************************************************************

     %constinteger buffer here = 0
                                        !********** to buffer manager ***********

     %constinteger request buffer = 0
     %constinteger release buffer = 1
               !****************************************************************

                                   !********** various service numbers *************

     %constinteger ring ser = 13
     %constinteger buffer manager = 17
     %constbyteinteger tx int = -6;          
     %constbyteinteger rx int = -7;           

     %constinteger t3 ser = 21
                    !************************************************************



     %record (pe)p;         !input pon record
     %record (pe) op;          !output pon record

%owninteger x, no buffc


!#sretry statistics variables

%ownintegerarray rhist(0:6);                      !#s

%owninteger rcount;                               !#s

%owninteger ints;              !#s
%owninteger im, om, timec;              !$e       #s




                                             !#e if # 0 then a transmission error is

                                                  !#e efag is toggled wiuth int(e)





     %owninteger mon = 0


%constinteger tracelim = 1023;                    !#t keep to a power of 2 -1
                                                  !#t
   %owninteger tsent=0;                            !#t

!%ownrecord (pe) %array ptrace(0:300)
!%owninteger ptp=0

%owninteger state=0
!values of state
%constinteger closed=0;                 !before first entry
%constinteger on=1;                 !normal state
%constinteger off=2;                  !ring offline

%owninteger dstate=0;           !dynamic state (see bits below)

!values for dstate
%constinteger idle=0
%constinteger inputting=1
%constinteger outputting=256


!data used during an input transfer
!----------------------------------

%ownrecord (mef) %name inbuf
%owninteger port,csflag
%ownrecord (mef) %name inbufq
%constinteger maxlen=125;                  !250 bytes of data max

%constinteger nibufreqd=6;        !number of input buffers in pool


!data accessed in code therefore in fixed location the gla

%constintegername ics==k'140016';         !checksum
%constintegername ocs==k'140014';         ! output block checksum

!data used during output transfer
!---------------------------------

%ownrecord (pe) outp
%ownintegerarrayname obuf
%owninteger dest, o pktcount, o pktlen, i tout, o tout, %c
          outcs, d, oretry, func;    !outcs#0 => checksum reqd

!data used for input transfer

%ownintegerarrayname i buf



!data used for port-pairs list
!-----------------------------

!each record contains a port range (low, high) and the id
!of the task that will handle input on a port in this range

%recordformat ppf(%integer lport, hport, %byteinteger reply)

%constinteger nppmax=8
%ownrecord (ppf) %array ppa(1:nppmax)
%owninteger npp=0
%ownrecord (ppf) %name pp



!data used for output pon queue
!------------------------------

!all the pq records are on a cyclic list, pqfirst and pqlast point
!to the head and tail of the q, npq tells how many items are on the q.



%recordformat pqf( %record (pqf) %name link, %record (pe) p)

%constinteger maxnpq=32
%ownrecord (pqf) %array pq(1:maxnpq)
%ownrecord (pqf) %name pqfirst, pqlast
%owninteger npq=0



!data defining canned commands (rdy, nodata etc.)

!data defining 'canned' byte stream commands rdy etc. the command is
!put into the array ccbuf, ccbuf(0) is the port number, ccbuf(1) is
!the receiver command set from the reccom array, and ccbuf(2) is the
!transmitter command set from trancom array. the array sindex gives the position
!in ccbuf of the sequence number if reqd.

%recordformat ccbufff(%record (mef) %name mes, %byte len, type, %c
      %integer address, %integerarray ccbuf(0:2))
%ownrecord (ccbufff) cc

%constintegerarray reccom(xrdy:xclosereq)=rdy, %c
             notrdy, 0, close, reset, 0

%constintegerarray trancom(xrdy:xclosereq)=0,   %c
              0, nodata, 0, 0, x'a004';               !data+closereq

%constbyteintegerarray sindex(xrdy:xclosereq)=1,1,2,0,0,2
! data for communication with the KMC

%ownintegerarray raddr(0:7);            ! holds real address of segs (>>6)
%owninteger par






!%routinespec pont(%record (pe) %name p)
%routinespec do clock int
%routinespec end op transfer
%routinespec end ip transfer
%routinespec start input transfer
%routinespec start output transfer
%routinespec do timeout(%integer type)
%routinespec freebuffer(%record (mef) %name mes)
%routinespec getbuffer
%routinespec initialize
%routinespec input done(%integer function)
%routinespec disports
%routinespec puthex(%integer d);        !#t


                                   !**********************************************

                                   !*      initialisation                        *

                                   !**********************************************

     i = map virt(buffer manager, 4, 3)
      i = map virt(buffer manager, 5, 4);              ! map to my seg 4
      i = map virt(buffer manager, 6, 5);               !and to seg 5
      %cycle i = 0, 1, 7
         par = map abs(i<<13, 512, own id);       ! get real address of seg
         raddr(i) = par
         par = map abs(i<<13, 0, own id);         ! and off gaing
      %repeat

     map hwr(0);                                  ! map top seg to seg 0
     linkin(ring ser)
     linkin(tx int); linkin(rx int)

     change out zero = t3 ser

     initialize;                                  !initialise data structures

!get input buffers

   %cycle i=1,1,nibufreqd
      getbuffer
   %repeat


     alarm(20)

     %cycle
        p_ser = 0;  poff(p)

        %if p_ser = own id %start;
           %if p_reply=0 %start;                 !clock call
               alarm(20)
               do clock int
               -> check KMC;            ! temp measure until kmc interrupts

             %else;                               !from buffer manager
!                   pont(p)
                                        !link buffer onto input q
                  %if p_reply # buffer manager %start
                     printstring("RING:illegal message from:")
                     write(p_reply, 1); newline
                     %continue
                  %finish

                   p_mes_link==inbufq
                  p_mes_a(0) = k'123456'
                  p_mes_a(1) = k'123456'
                   inbufq==p_mes

             %finish
            %continue
        %else

            %if p_ser=ring ser %start
!                   pont(p)
                                     !decode 'normal' pon message
                   %if p_fn=enable port %start
                        %if npp >= nppmax %start
                             printstring("RING:too many ports")
                             newline
                        %else
                                    !add port pair to list
                              npp=npp+1
                             pp==ppa(npp)
                             pp_lport=p_lport
                             pp_hport=p_hport
                             pp_reply=p_reply
                             %if state=closed %start
                                  !if this is the first entry, setup
                                  !state according to the inverse of onoff
                                  !so that the state change is recognised

                                 %if ring_intstat & onoff=0 %thenc
                                        state=on                %c
                                 %elsec
                                        state=off
                             %finish
                         %finish
                   %else
                        %if p_fn=disable port %then dis ports %and %continue
                         %if p_fn=output trace %start
                                tsent=1;             !#t
                          %else
                                                      !assume output request
                            %if npq<maxnpq %start;    !put on output queue
                                pqlast==pqlast_link
                                pqlast_p=p
                                npq=npq+1
                            %else
                                printstring("RING:queue full")
                                newline
                            %finish
                       %finish
                   %finish
                  %if npq = 1 %and dstate&outputting = 0 %start
                                        ! ring idle and 1st request
                     start output transfer
                  %finish
                  %continue
              %finish
         %finish

   %if p_ser&x'80' # 0 %then ints = ints+1
      %if p_ser&x'80' # 0 %start
         %if mon<0 %start
            select output(1); printstring("kmc int
")
            select output(0)
         %finish
      %finish


check kmc:
      %if kmc_csr0 = x'ff' %start
         printstring("kmc failure
")
         %cycle; %repeat
      %finish

      %if kmc_csr3&kmc req # 0 %start
         %if mon < 0 %start
            select output(1)
            printstring("kmc reply:"); write(kmc_csr3, 1)
            newline
            select output(0)
         %finish

         %if kmc_csr3&x'80'#0 %then do timeout(kmc_csr3&1) %else %start
            %if kmc_csr3&wfn # 0 %start;   ! finished a write fn
               end op transfer;            ! tell upper handler
            %else;                         ! end of read fn
               end ip transfer
            %finish
         %finish

         kmc_csr0 = kmc_csr0!oack;      ! ack request seen
         %while kmc_csr3#0 %cycle; %repeat; ! wait for kmc to see oack down
         kmc_csr0 = kmc_csr0&(\oack);   ! clear oack
      %finish

%repeat

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

%routine input done( %integer function)
!-------------------

!find out who wants input to this port


%integer port,i, xx
%record (ppf) %name pp


   port = inbuf_a(0)
   %cycle i=npp,-1,1
      pp==ppa(i)
      %if pp_lport<=port<=pp_hport %start
         op_ser=pp_reply
         op_reply=ring ser
         op_fn=function
         %if function=r input done %start
            op_mes==inbuf
!             pont(op)
            pon(op)
            inbuf == nil
            getbuffer
         %else
!            pont(op)
            pon(op)
         %finish
         start input transfer;          ! tell the kmc to go again
         %return
      %finish

   %repeat
!nobody wants the input
   printstring("RING:input rejected ")
   write(port, 3);     write(inbuf_address, 3)
   newline

   !return the input buffer to the queue
   inbuf_link==inbufq
   inbufq==inbuf
   inbuf == nil
      start input transfer
%end



%routine do clock int
!--------------------
               %integer i
               time=time+1
               %if time=0 %then time=1;               !time=0 => time not set

                  

                %if ring_intstat & onoff = 0 %start
          
                      %if state=on %start
                           %cycle i=1,1,5
                                printstring("****************** ring switched off")
                                newline
                            %repeat
                            state=off
                         %finish
                 %else
                      %if state=off %start
                                           !calculate my ring address
                             me=0
                             %cycle
                               %cycle i=1,1,254
                                   ring_sourceselect=i
                                   ring_intstat=ring_intstat ! receive
                                   ring_dest=i
                                   ring_tdata=x'f0f0'
                                   %while ring_intstat & tready=0 %cycle
                                     %if ring_intstat&onoff = 0 %then ->out
                                   %repeat
                                   %if ring_intstat#0 %and ring_rdata= %c
                                       x'f0f0' %then me=i %andexit
                                %repeat
                              %repeat %until me # 0
                              printstring("ring online")
                              write(me, 3)
                              newline
                             state=on
                              
                                            !initialize ring interface
                             ring_intstat=ring_intstat ! receive
                             ring_sourceselect=-1
                             kmc_csr0 = kmc_csr0!int enable
                              start input transfer;  ! kick the kmc
                       %finish
                %finish

out:

               %if 'M' <= int <= 'P' %start
                  mon = int-'O';  int = 0
               %finish
    
    
               x = x+1;                               !#s
             %if x >= 150 %start;                     !#s
                  %if no buffc # 0 %start
                     printstring("RING: No buffer count =")
                     write(no buffc, 1); newline
                     no buffc = 0
                  %finish

                  %if mon>0 %start;                  !#s
                     select output(1)
                     printstring("RING:");           !#s
                     write(ints, 4);                 !#s
                     write(im, 5);                  !#s
                     write(om, 1);                  !#s
                     write(timec, 1);               !#s
                     newline;                        !#s
                     select output(0);             !$s
                   %finish;                            !#s
                  im = 0;                              !#s
                  om = 0;                              !#s
                   x=0;                                !#s
                   ints=0;                             !#s
               %finish;                               !#s
                  %if o tout#0 %and time- o tout>timeout %then do timeout(1)
%end

%routine end op transfer
!-----------------------
                   dstate = dstate&(\outputting)
                   o tout=0
                  %if outp_fn & release flag # 0 %then  %c
                      freebuffer(outp_mes)
                  %if outp_fn & tell flag # 0 %start
                      op_ser=outp_reply
                      op_reply=ring ser
                      op_fn=output done
                      pon(op)
                  %finish
                  start output transfer %if npq # 0
%end

%routine end ip transfer
!-----------------------
               ring_sourceselect= -1;  ! kmc to do this !!!!!!!!!!!!
                  input done(r input done)
               dstate = dstate&(\inputting)
%end

%routine start input transfer
!----------------------------
      %integer ad, seg, par, ext bits
                  %if inbuf==nil %start;       !$e - kent fault
                     %if inbufq==nil %start
                        no buffc = no buffc+1
                        %return
                     %finish
                     im = im+1;                  !$s
                     inbuf==inbufq
                      inbufq==inbufq_link
                  %finish
      ad = addr(inbuf);                 ! get its virt addr
      seg = ad>>13;                     ! and its seg no
      par = raddr(seg);                 ! real addr>>6
      ext bits = (par&x'c0')>>8;                ! bits 16&17 to pos 2&3
      par = par<<6+(ad&k'17777');       ! real addr bits 0-15
      kmc_ibuff = par
      kmc_csr2 = ext bits!rfn!gobit;          ! fn & bits 16&17
      kmc_csr0 = kmc_csr0!csr i req;    ! and request bit to kmc
      %while kmc_csr2#0 %cycle; %repeat;! wait for kmc to ack request
      kmc_csr0 = kmc_csr0&(\csr i req); ! and clear request bit
      %if mon < 0 %start
         select output(1)
         printstring("kmc i request on ok
")
         select output(0)
      %finish
                  dstate = dstate!inputting
%end

%routine start output transfer
!-----------------------------
      %integer par, ad, ext bits
      %record (mef) %name out buf

                    outp=pqfirst_p
                   pqfirst==pqfirst_link;        !remove record
                   npq=npq-1;                    !from output q
                  func=outp_fn & command mask
                  om = om+1;                  !#s
                  %if func=ssout %start;               !single shot block
                       dest=outp_mes_address
                       o pktcount=1
                       o buf==outp_mes_a
                       o pktlen=outp_mes_len
                       %if o pktlen=0 %start
                           end op transfer
                           %return
                       %finish

                       o cs = o buf(0);          !first packet
                       outcs=0;                         !no checksum
                       ring_tdata = o cs
                       oretry=0
                  %else
                      %if func<xrdy %start
                                     !output given buffer
                                     !-------------------
                         out buf == outp_mes
                      %else
                                     !output byte stream command
                                     !----------------------------
                         dest=outp_len
                        o pktlen=3
                          cc_ccbuf(0)=outp_lport
                           cc_ccbuf(1)=reccom(func)
                          cc_ccbuf(2)=trancom(func)
                          cc_len = o pktlen
                          cc_address = dest
                          out buf == cc
                                     !see if sequence number reqd
                         i=sindex(func)
                         %if i#0 %thenc
                            cc_ccbuf(i)=cc_ccbuf(i)+(outp_s1<<8);      !add in sequence
   
                      %finish

                                        ! now dump it in the kmc regs
                     ad = addr(out buf);  ! virt addr
                     par = raddr(ad>>13); ! abs addr>>6
                     ext bits = (par&x'c0')>>8;  ! bits 16&17
                     kmc_ibuff = (par<<6)+(ad&k'17777')
                     kmc_csr2 = ext bits!wfn!gobit
                     kmc_csr0 = kmc_csr0!csr i req
                     %while kmc_csr2#0 %cycle; %repeat; ! wait for kmc to ack req
                     kmc_csr0 = kmc_csr0&(\csr i req);  ! and ack kmc
                     %if mon < 0 %start
                        select output(1)
                        printstring("kmc write reqest ok ")
octal(ad); space; octal(par); space; octal(kmc_ibuff); newline
                        select output(0)
                     %finish
                %finish
                  o tout=time
                  dstate = dstate!outputting
%end

%routine do timeout(%integer type)
!----------------



   %if type = 1 %start;       ! outputting timeout
      o tout = 0; timec = timec+1
         printstring("RING:output fails to")
         write(dest,3);    newline
      op_ser=outp_reply
      op_reply=ring ser
      op_fn=transfer error
      op_port=outp_port
!       pont(op)
      pon(op)
      %if outp_fn& release flag # 0 %then freebuffer(outp_mes)
      dstate = dstate&(\outputting)
      start output transfer %if npq # 0;  ! put the next one on
   %else
        ! must be input timeout
         !send message if port number has been input

!return the input buffer
         %unless inbuf == nil %start
            inbuf_link==inbufq
            inbufq==inbuf
            printstring("RING:Input fails from")
            write(inbuf_address, 3); newline
            inbuf == nil
         %finish
         start input transfer

         ring_intstat=ring_intstat ! receive
         ring_sourceselect=-1
      %finish


%end


%routine initialize
!------------------
%integer i

!initialise pon q as cyclic list
   pqfirst==pq(1)
   pqlast==pq(maxnpq)
   %cycle i=1,1,maxnpq-1
      pq(i)_link==pq(i+1)
   %repeat
   pq(maxnpq)_link==pq(1)
   npq=0

%end



%routine freebuffer( %record (mef) %name mes)
!-----------------------------------------------

   op_ser=buffer manager;     op_reply=own id
   op_fn=release buffer;      op_mes==mes
!   pont(op)
   pon(op)

%end


%routine getbuffer
!-----------------

   op_ser=buffer manager;    op_reply=own id
   op_fn=request buffer;     op_len=0;        !long buffer
!pont(op)
   pon(op)

%end




%routine disports;                         !disable port by removing
!-----------------                        !from port pairs list

%integer i,j

   %cycle i=1,1,npp
      pp==ppa(i)
      %if pp_lport=p_lport %and pp_hport=p_hport %andc
          pp_reply=p_reply %start
          %cycle j=i,1,npp-1
            ppa(j)=ppa(j+1)
         %repeat
         npp=npp-1
         %return
      %finish
   %repeat
%end




%routine puthex(%integer d);              !#t
!--------------------------;              !#t

%integer i;              !#t
%byteinteger s;              !#t

   printsymbol(' ');              !#t
   %cycle i=12,-4,0;              !#t
      s=(d>>i)&x'f';              !#t
      %if s>9 %then s=s-'0'+'a'-10;              !#t
      printsymbol(s+'0');              !#t
   %repeat;              !#t
%end;              !#t





%endofprogram
!   ptrace(ptp)=p
   newline;              !#t
   newline;              !#t
   newline;              !#t