!**********************
!* padgrbs/padgrby    *
!* date: 12.dec.87    *
!**********************
%conststring (13) vsn = "padgr...1a "

! Prep options:-    t   -  TS29 - XXX over transport service
!                   x   -  xxx
!                   b   -  Big buffer vsn

#datestring

!! stack = 300, streams = 1

%control x'4001'


%recordformat xf(%byteinteger unit,fsys,%byteintegerarray fname(0:5))
%include "b_deimosspecs"
%begin

   %owninteger mon = 0
   %owninteger quiet = 0;        ! 1 = no console op at all
   %ownstring (1) snil = ""

#if x
%recordformat itpf(%byte res, (%bytearray data(0:127) %or %string (127) s))
              ! compiler problems
#if b
%recordformat lev3f(%bytearray reserved(0:3), %record(itpf) itp)
#else
%recordformat lev3f(%bytearray reserved(0:5), %record (itpf) itp)
#fi
#else
%recordformat itpf((%bytearray data(0:127) %or %string (127) s))
#if b
%recordformat lev3f(%bytearray reserved(0:5), %record (itpf) itp)
#else
%recordformat lev3f(%bytearray reserved(0:7), %record (itpf) itp)
#fi
#fi
            ! itp_data(0) is actually inside the reserved space, as it is
            !             only used for the length, this should not matter
            !             In TS29, length byte is overwritten with zero


#if ~b
%recordformat mef(%record(mef)%name link,%byteinteger len,type,  %c
   (%record(lev3f) lev3 %or %bytearray params(0:241)))

%recordformat pf(%byteinteger service,reply,(%byte fn,s1,  %c
%record(mef)%name mes,%byteinteger gate port, task port %or %c
  %byte a1, a2, b1, b2, c1, c2))
#else
%recordformat mef(%integer buff no, len, %byte owner,type,  %c
   (%record(lev3f) lev3 %or %bytearray params(0:241)))

%recordformat pf(%byte service, reply, (%byte fn, s1, %c
%integer buff no, %byte gate port, task port %or %c
 %byte a1, a2, b1, b2, c1, c2))
#fi

%own %record (pf) p

      %recordformat qf(%record (mef) %name e)
      %recordformat tcpf(%integer state, con state ind, %c
         %byteinteger port, tcpn, flag, mflag, %c
         d1, d2, size, max, %integer packets, cons, delay, ticks)
         %constinteger max conns = 100


         %ownrecord (tcpf) %name tcp
         %ownrecord (tcpf) %array tcpa(0:max conns)
         %ownstring (15) %array pad address(0: max conns)
         %ownstring (15) %array pad name(0: max conns)

      ! %constinteger not allocated = 0
      %constinteger conn asked = 1
      %constinteger connected = 2
      %constinteger tcp disconnecting = 3
      !******  tcp_ostate states  (permission to send)  *****
      %constinteger idle = 0
      %constinteger busy = 1
      !***********************************************************

      %recordformat consf(%integer cnsl, state)
      %ownrecord (consf) %array cona(0:100)
      %ownrecord (consf) %name con

%constinteger tt ser=1, gate ser=24, buffer manager=17
%constinteger rd=0, echo off=10
%constinteger request buffer=0, release buffer=1
      %constintegername no of small == k'100114'

      %include "b_ygatecalls"

      %integer i, node, term, k, flag, tick, conns, x
      %owninteger initf
      %owninteger sta, cpu, pkts, sbr, byt, rjei, tim, rjeo, delay, ipkts, calls
      %owninteger inc users = 0, printall = 0, sesstype
      %owninteger conn ok, g port, power, kill it, maxc, d1, d2, session, chop
      %owninteger term char = ':';   ! for EMAS
      %constbyteintegername change out zero == k'160310'
      %constinteger t3 ser = 21

      %ownrecord(mef) %name mes
      %ownstring (63) address = ""
      %ownstring (80) s, t

      %routine readstring(%string (*) %name s)
         %integer i
         s = ""
         %cycle
            readsymbol(i); %exit %if i = nl
            s = s.tostring(i)
         %repeat
      %end

      %routine get buffer(%integer cnsl, r2)
         %integer type
         type = 1
         %if r2 = 255 %then type = 0;   ! get big buffer if connect, else small
         p_service=buffer manager;   p_reply=id
         p_a1=request buffer;   p_c1=type;   p_c2=cnsl
         p_a2 = r2
         pon(p)
      %end
#if ~b

      %routine free buffer(%record(mef)%name mes)
         p_service=buffer manager;   p_reply=id
         p_a1=release buffer;   p_mes==mes
         pon(p)
      %end

#else
%routine free buff no(%integer buff no)
     ! not mapped, so send it straight back
   %return %if buff no = 0
   p_service= buffer manager; p_reply = id
   p_fn = release buffer
   p_buff no = buff no
   pon(p)
%end

%routine free buffer(%record (mef) %name mes)
   %record (pf) p
   %integer buff no

       ! nb: routine ASSUMES buffer is mapped on
   buff no = mes_buff no
   %unless mes == null %start
      !There really is a buffer
         !Tell Buffer Manager it can have its buffer back.
         p_service = buffer manager ;p_reply = id
         p_fn = release buffer
         p_buff no = buff no
         pon(p)
   %finish
%end ;!of Free Buffer

     %record (mef) %map map(%integer buff no)
        ! New compiler  - so must get 0
        %result == null %if buff no = 0
        *mov_1,0
        *mov_#8,1;     ! desired vm seg no *2 ie 4*2
        *iot
        %result == record(k'100000')
     %end
#fi

      %routine mon mes(%record (mef) %name mes)
         %integer i, j, k, n
         %recordformat itp2f(%bytearray a(0:128))
         %record (itp2f) %name itp

         k = mes_len
         itp == mes_lev3_itp
         write(k, 1); space; space
         j = 0
         %cycle i = 0, 1, k
                  write(itp_a(i), 1)
               j = j+1;  %if j = 25 %then j = 0 %and newline
         %repeat
         newline
      %end
   
      %routine mon p(%record (pf)%name p)
         %integer i
         write(p_gate port, 1); printsymbol('/'); write(p_task port, 0)
         printstring(" fn ="); write(p_fn, 1)
         printsymbol(':'); write(p_a2, 1)
         newline
      %end
   

      %routine to gate(%integer fn, %record (mef) %name mes, %c
         %integer flag)
         %if fn = put output %start;        ! queue these as necessary
            %if tcp_state # connected %start; ! throw away
                free buffer(mes);  %return
            %finish

            ipkts = ipkts+1
            tcp_size = tcp_size+1
            tcp_max = tcp_size %if tcp_size>tcp_max

            %if mon < 0 %start
               select output(1)
               printstring("Out ");  mon mes(mes)
            %finish
         %elseif fn = disconnect
            tcp_delay = 0
            %return %if tcp_state = tcp disconnecting
            tcp_state = tcp disconnecting
         %finish

         p_service = gate ser; p_reply = id
         p_fn = fn; p_s1 = flag
#if b
         p_buff no = mes_buff no
#else
         p_mes == mes
#fi
         p_task port = tcp_tcpn; p_gate port = tcp_port
         %if mon < 0 %start
            select output(1)
            printstring("From T"); mon p(p)
            select output(0)
         %finish

         pon(p)
      %end

      %routine pack(%record(mef) %name mes, %string (*) %name s)
         string(addr(mes_params(mes_len))) = s
         mes_len = mes_len+length(s)+1
      %end


      %routine do connect(%integer type, %record (mef) %name mes)
      !============================================================

      %string (63) facn, cudf, cd2
      %integer i

         tcp == tcpa(type)
         p_service = gate ser; p_reply = own id
         p_fn = connect
         p_gate port = 0; p_task port = tcp_tcpn
#if x
         p_s1 = 1;        ! 1 is a non-ts call
#else
         p_s1 = 0;        ! 1 for xxx call
#fi
#if ~b
         p_mes == mes
#else
         p_buff no = mes_buff no
#fi
         mes_len = 0
         cd2 = "22" ; cudf = ""
         facn = pad address(tcp_tcpn)
         %if charno(facn, length(facn)) = 'X' %start   {SUPER Pad}
            cudf = "*s"
            string(addr(cd2)+4) = cudf
            length(cd2) = length(cudf)+4
            charno(cd2,1) = 1; charno(cd2,2)=0;
            charno(cd2, 3)=0; charno(cd2,4)=0
            length(facn) = length(facn)-1
         %finish %else %start
            facn = facn.cd2
            cd2 = ""
         %finish
         pack(mes, facn)
         pack(mes, snil);                ! calling address (null)
         facn = "P=128/128"
         pack(mes, facn)
         pack(mes, cd2)
         %if mon < 0 %start
            select output(1);  spaces(5)
            printstring("xxx: to gate:"); {t}  mon p(p)
            select output(0)
         %finish
         pon(p)
         conns = conns+1
         tcp_state = conn asked
         calls = calls +1
      %end

      %routine block(%record (mef) %name mes, %integer cnsl)
         %integer i, j, k
         %record (lev3f) %name lev3
         %record (itpf) %name itp

         lev3 == mes_lev3
         itp == mes_lev3_itp
         tcp == tcpa(cnsl)

         itp_s = padname(tcp_tcpn)."  "
         %If tcp_mflag = 1 %then %start
             itp_s = itp_s."Down "
             itp_s = itp_s.itos(tcp_d1, 0)."/".itos(tcp_d2, 0)
             tcp_mflag = 0
         %finish %else itp_s = itp_s."Up"
         j = 0
         mes_len = length(itp_s)
         %if mon < 0 %start
            select output(1)
            %if length(itp_s) # 0 %then spaces(3) %and printstring(itp_s)
            newline
            select output(0)
         %finish

         length(itp_s) = 0;      ! set the TS29 byte to zero

         p_service = 18     {INFO Module - NB - CONFLICTS WITH Auscomm Handler}
         p_reply = own id
         p_fn     = 1     {LOGMSG}
         p_mes == mes
         pon(p)

         pkts = pkts+1
         tcp_packets = tcp_packets+1

      %end

      %routine analyse itp input(%record (mef) %name mes)
         %record (itpf) %name itp
         %integer i, j, k, qbit, q
         %string (127) t,v

         itp == mes_lev3_itp
         k = tcp_tcpn
         qbit = length(itp_s);      ! pick up ts29 byte before overwriting it
                                    ! or pseudo byte if really xxx
#if x
         length(itp_s) = mes_len
#else
         length(itp_s) = mes_len-1
#fi
         v = itp_s
         %if qbit # 0 %start
            %if mon < 0 %start
               printstring("Incon: "); write(length(itp_s), 1)
               write(charno(v, 1), 4); newline
            %finish
!            %if charno(v, 1) = 1 %then -> disc it
            %if charno(v, 1)&4 # 0 %start;  ! set & read or read
               length(itp_s) = 128;       ! re-instate
               %if charno(v,1)=4 %start
                  itp_data(2)=1; itp_data(3)=0; mes_len = 3+1
                  %if mon # 0 %start
                     printstring("Read Params
")
                  %finish
               %finish
               itp_data(1) = 0
#if x
               to gate(control data, mes, 0)
#else
               to gate(put output, mes, 0)
#fi
            %finish %else free buffer(mes)
            %return
         %finish


         %if mon # 0 %start
            write(k, 1); printsymbol(':')
            printstring(v); newline
         %finish
      free buffer(mes)

      %end

      %routine mon tcps
         %integer i, pkt
         select output(1)
         %if chop # 0 %then printstring("Calls =") %and write(calls, 1)
         select output(0)
         tcpa(i)_packets = 0 %for i = 0, 1, maxc
         ipkts = 0; pkts = 0
         calls = 0
      %end

      %routine failures
         %integer i, x
         printstring("No of failures per pad
")
         %cycle i = 0, 1, maxc
            tcp == tcpa(i)
            printstring(pad name(tcp_tcpn))
            x = tcp_cons-1
            %if x < 0 %then printstring("  No Connection") %else %c
              write(x, 3)
            newline
         %repeat
      %end


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

      use tt(t3 ser)
      printstring(vsn)
#if x
      printstring(" XXX ")
#else
      printstring(" TS29 ")
#fi
      printstring(datestring)
      newline
      maxc = 97

      printstring("Reading Input File for names and addresses
")
      select input(1)
      %cycle i = 1, 1, 100
         readstring(s)
         %if s = "END" %or s = "end" %then %exit
         %unless s -> s.(" ").t %start
            printstring("Format is <address> <space> <name>
")
            printstring(s); newline
            %exit
         %finish
         pad address(i) = s; pad name(i) = t
      %repeat
      i = i-1
      write(i, 1); printstring(" names read
")


      %if maxc > i %then maxc = i
      maxc = maxc-1
      sta = maxc
      %cycle i = 0, 1, 100
         tcp == tcpa(i)
         tcp_tcpn = i+1
      %repeat
      alarm(10)

      %cycle
         p_service = 0; poff(p)
         %if p_reply = 0 %start;    ! clock
               %if int # 0 %start
               %if int = 'A' %start
                  kill it = -1
                  chop = 0
                  printstring("killing it
")
                  int = 0
               %finish
            %if 'M' <= int <= 'P' %start
               mon = int-'O'; int = 0
            %finish


            %if int = 'T' %then use tt(t3 ser)
            %if int = 'Z' %start
               %if kill it >= 0 %then printstring("Do int:A first
")                %else %stop
            %finish


            %if int='?' %start
               mon tcps; failures
            %finish
            int = 0
            %finish

            tick = tick+1
            %if tick >= 120*60 %and quiet = 0 %start
               tick = 0
               mon tcps 
            %finish

            alarm(25);             ! 1/2 second

#if ~b
               %continue %if no of small < 15
               i = initf
               initf = initf+1; initf = 0 %if initf > maxc
               %cycle
                  con == cona(i)
                     tcp == tcpa(i)
                     %if tcp_state = 0 %and kill it >= 0 %start
                        get buffer(i, 255)
                        tcp_state = conn asked
                        %exit %unless chop = 1; ! several on multi-option
                     %finish
                     %if kill it < 0 %and tcp_state = connected %start
                          {closing down}
                        to gate(Disconnect, null, 0)
                        tcp_state = tcp disconnecting
                        %exit   {one at a time}
                     %finish
                  %exit %if i = initf
                  i = i+1; i = 0 %if i > maxc
               %repeat

               %cycle i = 0, 1, maxc
                  tcp == tcpa(i)
                  %if tcp_delay > 0 %start
                     tcp_delay = tcp_delay-1
                     %if tcp_delay = 0 %and tcp_state # tcp disconnecting %c
                        %then get buffer(tcp_tcpn, 0)
                  %finish
               %repeat
               %continue
         %finish

         %if mon < 0 %and p_reply = gate ser %start
            select output(1)
            printstring("To T  ")
            mon p(p)
            select output(0)
         %finish

         %if p_reply = buffer manager %start
#if b
            mes == map(p_buff no)
            mes_owner = own id
#else
            mes == p_mes
#fi
            %if kill it < 0 %then free buffer(mes) %and %continue
            %if p_a2 = 255 %then do connect(p_c2, mes) %else %c
              block(mes, p_c2)
            %continue
         %finish

         %if p_reply = gate ser %start
#if b
            mes == map(p_buff no)
            mes_owner = own id %unless mes == null
#else
            mes == p_mes
#fi

            node = p_task port-1
            tcp == tcpa(node)

            %if p_fn = accept call %start;  ! 2nd reply
               %if %not mes == null %then free buffer(mes)
               tcp_port = p_gate port
               %if kill it < 0 %then to gate(Disconnect, null, 0) %c
                  %and tcp_state = tcp disconnecting
               flag = p_s1
               %if tcp_cons > 0 %start
                  write(tcp_tcpn, 1);
                  printstring("  ".pad name(tcp_tcpn))
                  printstring(":call accepted")
                  newline
                  get buffer(node, 2)
               %finish
               tcp_cons = tcp_cons+1
               tcp_state = connected
               %continue
            %finish

            %if p_fn = disconnect %start;   ! my end i hope
               conns = conns-1
               %unless mes == null %start
                  d1 = mes_lev3_reserved(2); d2 = mes_lev3_reserved(3)
                  free buffer(mes)
               %finish
               %if tcp_state = tcp disconnecting %start; ! expected in xxx
repeat:
                  tcp_delay = 0
                  %if session # 0 %and chop = 0 %start
                     tcp_state = 255
                     %if conns = 0 %start
                        p_service = 0; poff(p); %stop
                     %finish
                  %finish %else %start
                     cona(tcp_tcpn)_state = 0
                     tcp_state = 0
                  %finish
               %else
                  %if tcp_state = connected %c
                      %or mon # 0 %or tcp_flag = 0 %start
                     write(tcp_tcpn, 1); printstring("  ".pad name(tcp_tcpn))
                     %if tcp_state = connected %then %c
                        printstring(": call lost") %else %c
                        printstring(": can't connect")
                     write(p_s1, 2)
                     write(d1, 1); write(d2, 1)
                     newline
                     tcp_d1 = d1; tcp_d2 = d2
                     tcp_flag = 1;   ! flag the 1st failure only
                     tcp_mflag = 1; get buffer(node, 1)
                  %finish
                  %continue %if node < 0    {shouldn't happen !!}
   
                  %if tcp_state = connected  %or p_s1 = 141 %c
                    %then to gate(disconnect, null, 0) %and -> repeat
                 tcp_state = 0
               %finish
               %if conns = 0 %and kill it < 0 %start
                  p_service = 0; poff(p);   ! wait for timer tick
                  %stop
               %finish
               %continue
            %finish


            %if p_fn = enable output %start
               tcp_packets = tcp_packets+p_s1
               %continue
            %finish

            %if p_fn = input here %start
               -> junk %if kill it < 0
               pkts = pkts+1
               to gate(enable input, null, 1)
#if x
               length(mes_lev3_itp_s) = 0;  ! mark as pure data
#fi
               analyse itp input(mes)
               %continue
            %finish

            %if p_fn = control data %start
               pkts = pkts+1
               to gate(enable input, null, 1)
#if x
               length(mes_lev3_itp_s) = 128; ! mark as pseudo ts29
               analyse itp input(mes)
               %continue
#fi

junk:
               free buffer(mes)
               %continue
            %finish

            %if p_fn = reset %start
               printstring("Reset:"); write(mes_lev3_reserved(2), 1)
               write(mes_lev3_reserved(3), 1); newline
                free buffer(mes)
               to gate(Disconnect, null, 0)
               tcp_state = tcp disconnecting
               %continue
            %finish

            printstring("funny fn"); write(p_fn, 1)
            printstring(" from"); write(p_reply, 1); newline
            %continue
         %finish
      %repeat
%endofprogram