!*********************
!*    parr4fs/parr4y *
!* date: 20.jan.82   *
!* modified for fep  *
!*********************
!stack = 140



%control 1


%conststring (13) vsn = "parr:vsn004a
"
%begin

      %recordformat parrf(%integer rcsr, rbc, rba, rvec, %c
        tcsr, tbc, tba, tvec)

      %ownrecord (parrf) %name pa == 1




      %constinteger kernel ser = 10;  ! 29 is node, 10 is fep (ie gate)
      %owninteger line type = 0;        ! 0=dqs11, 1=dup11e
     %owninteger line = 0;        !logical line

     %constintegername no of buff == k'100112';    ! no of buffers
     %constinteger critical = 10;                 ! min global pool size
     %constinteger max reads = 3;                ! max it is allowed to hold


     %constinteger input req = 1;   ! interface to higher level
     %constinteger output req = 2
     %constinteger bounce = 3
     %constinteger put down = 4
     %constinteger put up = 5
     %constinteger monit = 6

     %constinteger buffer manager = 17
      %owninteger rx int = -7, tx int = -6

      %recordformat mef(%byteinteger hlen, htype, len, type, %c
         %byteintegerarray a(0:240))


      %recordformat hdlcf(%byteinteger add, type, %byteintegerarray a(0:239))
      %recordformat mef2(%byteinteger hlen, htype, %record (hdlcf) hdlc)

     %recordformat pe(%byteinteger ser, reply, (%integer a1, a2, a3 %or %c
        %byte fn, line, %c
         %record (mef) %name m, %byte len, s1))


     %ownrecord (pe)p
     %owninteger rstate, tstate, wpend, q max, rer
      %owninteger mon = 0
      %integer i
     %owninteger istate=2
     %owninteger input exp;               !blocks of input expected
     %owninteger clock0
                                       !clock.  time since 

      %owninteger ird, i tr, no read

     %recordformat wdse(%record (mef2) %name m, %integer len)
     %recordformat bpf(%record (mef2) %name m)
      %recordformat qf(%record (mef) %name e)
      %recordformat r1f(%record (mef) %name m)
      %recordformat r2f(%integer x)

      %ownrecord (qf) mq
      %ownrecord (mef2) %name icurr, ocurr
     %ownrecord (wdse) %name ipool
     %ownrecord (bpf) %name me2
      %ownrecord (r1f) r1
      %ownrecord (r2f) %name r2

      %ownintegerarray raddr(0:7);      ! holds page no of each segment

      %constbyteintegername change out zero == k'160310'
      %constinteger t3 ser = 21

     %switch sw(input req:monit)

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

     %routine tell
         printstring("par");  write(line, 1); printsymbol(':')
     %end

      %routine initialise
         %integer f
        linkin(rx int); linkin(tx int)
!         svc(18, 2, 0);                   ! set priority = 2
         %cycle i = 1, 1, 7;              ! 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)
!         pa_rcsr = pa_rcsr&(\k'100'); ! generate an extra int
         pa_rcsr = pa_rcsr!k'100'; ! generate an extra int
      %end

     %routine start input
      %integer pad, par, cad, ext bits
               r1_m == icurr;         ! need the address as an integer
               pad = r2_x+2
!              par = map abs(pad, p_len, rxreply)
               par = raddr(pad>>13)
               %if par = 0 %start
                  tell; printstring("** bad r addr ***
")
                  %cycle; %repeat
               %finish
               par = par+(pad&k'17700')>>6;  ! ensure actual block
               ext bits = (par&k'176000')>>6
               cad = par << 6+pad&k'77'
               pa_rbc = -252
               pa_rcsr = ext bits
               pa_rba = cad;            ! ext bits ********************
         pa_rcsr = pa_rcsr!k'100'
         r state = 1
     %end

      %routine start output(%record (mef2) %name m)

         %integer oseg, par, ext bits, i

         !! nb: the hdlc header must be swapped

         m_htype = m_hdlc_type
         m_hlen = 0
         pa_tbc = -(m_hdlc_add+2);          ! length
         m_hdlc_add = 0; m_hdlc_type = 0
         %if istate = 2 %then m_hdlc_type = 15;   ! sarm on 1st go

            r1_m == m;                  ! need address as integer
              oseg = r2_x+2
!              par = map abs(oseg, p_len, id)
              par = raddr(oseg>>13)
              %if par = 0 %start
               tell; printstring("** bad w addr ***
")
               %cycle; %repeat
            %finish
             par = par+(oseg&k'17700')>>6;   ! on actual block
              ext bits = (par&k'176000')>>6
              pa_tcsr = ext bits
              pa_tba = par << 6+oseg&k'77'
               !! nb: ext bits ***************************************
           pa_tcsr = pa_tcsr!k'100'
            tstate = 1
         %end



     %routine wreply(%integer flag, block)
        p_ser = kernel ser;  p_reply = id
        p2_fn = output req;  p_a2 = block;  p_a3 = flag
        p2_line = line
        !! monitor(p)
        pon(p)
     %end

     %routine return buff(%record (mef2) %name m)
        %record (wdse) %name me2
         p_ser=buffer manager;   p_reply=id
          p_a1=1;   p2_m == m
          p2_m_type = m_htype
        %if p2_m_type # 0 %or input exp >= max reads %or no of buff %c
          < critical %start
            pon(p)
        %else
           me2 == p2_m
           me2_m == ipool
           ipool == me2
           input exp = input exp+1
        %finish
     %end

     %routine ask for buffer
        p_ser = buffer manager; p_reply = id
        p_a1 = 0; p_a3 = 0;                       ! ask for big buffer
        pon(p)
     %end

     %routine abort(%integer type)
                   !  reasons for abort:
        %returnif istate # 0;          !already down
           tell; printstring("dead ")
           printsymbol(type+'0')
           newline
           wreply(1, 0);                  !tell gate down
            %while %not mq_e == null %cycle
               me2 == pop(mq)
               p_ser = buffer manager; p_reply = id
               p_a1 = 1; p2_m == me2
               pon(p)
            %repeat
         istate = 2
     %end


     %routine handle input(%record (mef2) %name m)
        %record (hdlcf) %name hdlc
        %record (wdse) %name imess
        %integer type, len, i

         %if m == null %start;          ! i frame in

            type = icurr_hdlc_type
            %if type = 15 %start;       ! sarm, ie reset
               abort(6);                ! other end reset
               tell; printstring("sarm
")
            %finish

            m == icurr
           len = pa_rbc+252


           %if pa_rcsr < 0 %or len <= 2 %start
              tell
               %if len <= 2 %then printstring("len<=2") %else %c
                printstring("rx error")
               newline
              rer = rer+1
              abort(3)
               start input;      ! start input on same buffer
!              %return;  ! unlike node vsn, signal line up
          %finish

            %if istate # 0 %start;     ! was down
               tell; printstring("up
")
               wreply(0, 0)
               istate = 0
            %finish

            p_ser = kernel ser; p_reply = id
            p2_fn = input req; p2_line = line
            p2_m == m
            p2_m_type = m_htype
            p2_m_len = len-2
            pon(p)
            ird = ird+1
         %finish
noise:   clock0 = 0
           %if input exp > 0 %start
              icurr == ipool
              ipool == ipool_m; input exp = input exp-1
              icurr_htype = icurr_hdlc_type
              %if input exp <= 1 %then ask for buffer
              start input
         %finish
     %end


     %routine clock int
        %integer flag
        alarm(25);                   !restart clock
        %if tstate # 0 %start
           clock0 = clock0+1
            %if clock0 = 80 %start;        ! 40 sec output timeout
               abort(2);                   ! failed to transmit
               %return
            %finish
         %finish

         no read = no read+1 %if input exp = 0
     %end
     !!
     map virt(buffer manager, 4, 3)
     map virt(buffer manager,5,4)
     map virt(buffer manager, 6, 5)


      change out zero = t3 ser
      p2 == p; r2 == r1

      p2_ser = 0;  poff(p2);              ! wait for instructions
      line = p2_fn;  line type = p2_line
      p_a2 = p_a2&k'17777';        ! ensure p2_m is in segment zero
      pa == p2_m
       rxint = p2_len!x'ff00';  txint = p2_s1!x'ff00'
      initialise

      wreply(2, 0);           ! here i am ( line number! = 0!)
      alarm(25)
     ask for buffer
      istate = 0
      tell; printstring("up?
")
      wreply(0, 0);     ! tentative up

     %cycle
        p_ser = 0
        poff(p)

         %if p_ser&x'80' # 0 %start;    ! interrupt
            %if p_ser = tx int&x'ff' %start;   ! op done
               %if pa_tcsr < 0 %start;  ! error
                  tell; printstring("tx error
")
                  %continue %if tstate = 0
               %finish
               tstate = 0
               return buff(ocurr)
               clock0 = 0
               %if %not mq_e == null %start
                  ocurr == pop(mq)
                  start output(ocurr)
                  wpend = wpend-1; itr = itr+1
               %finish
            %else;                      ! input interrupt
               rstate = 0;              ! now inactibe
               handle input(null)
            %finish
            %continue
         %finish
           %if p_reply = 0 %start
              clock int;               ! clock interrupt
               %if int = '?' %start
                  int = 0
                  tell; write(istate, 4); write(rstate, 4)
                  write(input exp, 5); write(w pend, 4); write(q max, 4)
                  q max = 0
                  newline
                  tell; write(ird, 4)
                  write(itr,4)
                  write(no read, 8); write(clock0, 4);  write(rer, 4)
                  newline
               %finish

           %continue
        %finish
         %if p_reply = buffer manager %start;   ! buffer has arrived
            me2 == p2_m
            me2_m == ipool
            ipool == me2
            input exp = input exp+1
            %if rstate = 0 %start;      ! no read on
               handle input(me2);       ! put a read on
            %finish
            %continue
         %finish

        !! user request
        !! monitor(p)
        -> sw(p2_fn)

sw(output req):
           %if tstate = 0 %start
              itr = itr+1;        ! count going writes
              ocurr == p2_m
              start output(ocurr)
           %else
              push(mq, p2_m)
               w pend = w pend+1
               %if w pend > q max %then q max = w pend
           %finish
           %continue

sw(input req):                    ! being phased out
               p_ser = buffer manager; p_reply = id
               p_a1 = 1
               pon(p)
         %continue

sw(bounce):;               ! force line bounce
          abort(4)
           %continue

sw(put down):
          abort(4); istate = 10
          %continue

sw(put up):
          initialise;            ! grab interrupts again
          %if input exp = 0 %then ask for buffer
          istate = 2
          %continue

sw(monit):
          int = '?'
      %repeat
%endofprogram