! file 'lmeots'
!**********************
!* lmeots/lmeoty   *
!* date: 20.may.81   *
!*********************
%conststring (13) vsn = "lmxs...1c "

! Prep options:-    t   -  itp over transport service
!                   x   -  xxx over transport service

#datestring

!! stack = 300, streams = 1

%control 1


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

   %owninteger mon = 0
      %ownstring (1) snil = ""

#if t
%%recordformat itpf(%byteinteger cnsl,hb1,hb2,  %c
   (%byteintegerarray data(0:127) %or %string (127) s))
#else
%%recordformat itpf((%byteintegerarray data(0:127) %or %string (127) s))
#fi

%recordformat lev3f(%bytearray reserved (0:7), %record (itpf) itp)

%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))

%record (pf) p

      %recordformat qf(%record (mef) %name e)
      %recordformat tcpf(%integer state, con state ind, %c
         held, h ind, h no, %byteinteger port, ostate, tcpn, term, %c
         size, max, %integer packets, %record (qf) outq)
         %constinteger max conns = 30


         %ownrecord (tcpf) %name tcp
         %ownrecord (tcpf) %array tcpa(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:48)
      %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
      %owninteger initf
      %owninteger users, sta, cpu, pkts, sbr, byt, rjei, tim, rjeo
      %owninteger conn ok, g port, power, kill it, maxc
      %constbyteintegername change out zero == k'160310'
      %constinteger t3 ser = 21

      %ownstring (63) address = ""
      %ownstring (9) name = "ZZZZ10**"
      %ownstring (7) pass = "....**"
      %ownstring (3) snl = "**"

      %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 reason, r2)
         p_service=buffer manager;   p_reply=id
         p_a1=request buffer;   p_c1=1;   p_c2=reason; ! small buff
         p_a2 = r2
         pon(p)
      %end

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


#if x!t
      %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
            %if mon > 0 %and i > 3 %start;        ! 'p' and not header
               n = itp_a(i)
               printsymbol(n) %unless n = 0 %or n = 4
            %else
                  write(itp_a(i), 1)
               j = j+1;  %if j = 25 %then j = 0 %and newline
            %finish
         %repeat
         newline;  select output(0)
      %end
   
      %routine mon p(%record (pf)%name p)
         %integer i
         printstring(" fn ="); write(p_fn, 1)
         printstring(" gate port"); write(p_gate port, 1)
         printstring(" task port"); write(p_task port, 1)
         printstring(" a2"); write(p_a2, 1)
         %if %not p_mes == null %start
            newline; spaces(5)
            write(p_mes_len, 3)
            %cycle i = 0, 1, p_mes_len
               write(p_mes_params(i), 2)
               newline %if i&15 = 15
            %repeat
         %finish
         newline
      %end
   
#fi

      %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

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

            %if mon < 0 %start
               select output(1)
               printstring("io ");  mon mes(mes)
            %finish
         %finish

         p_service = gate ser; p_reply = id
         p_fn = fn; p_mes == mes; p_s1 = flag
         p_task port = tcp_tcpn; p_gate port = tcp_port
#if x!t
         %if mon < 0 %start
            select output(1);  spaces(5)
            printstring("xxx: to gate:"); {t}  mon p(p)
            select output(0)
         %finish
#fi

         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 (23) facn
      #if t
      %ownbytearray grot(0:8) = 8, 1, 0, 0, 0, x'83', 'R', 'T', 'P'
      #fi
      #if x
      %ownbytearray grot(0:8) = 8, 1, 0, 0, 0, x'83', 'X', 'X', 'X'
      #fi

         tcp == tcpa(type)
         p_service = gate ser; p_reply = own id
         p_fn = connect
         p_gate port = 0; p_task port = tcp_tcpn
         p_s1 = 0
         p_mes == mes
         mes_len = 0
         pack(mes, address)
         pack(mes,snil);                ! calling address
         facn = "P=128/128"
         pack(mes, facn)
         facn = string(addr(grot(0)))
         pack(mes, facn)
         #if x!t
         %if mon # 0 %start
            select output(1);  spaces(5)
            printstring("xxx: to gate:"); {t}  mon p(p)
            select output(0)
         %finish
         #fi
         pon(p)
      %end

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

         %switch sw(0:6)

         lev3 == mes_lev3
         itp == mes_lev3_itp
         con == cona(cnsl)
         #if ~x
         tcp == tcpa(cnsl>>2)
         #else
         tcp == tcpa(cnsl-1)
         #fi
         #if ~x
         itp_cnsl = cnsl
         #fi
         %if p_a2 # 0 %then ->sw(6);  ! special go-ahead request
         itp_s = ""
         -> sw(con_state)

#if x

sw(0):   ! send blank line (to be removed)
         itp_s = snl
         -> comm

         #else

sw(0):   ! send hello
         itp_hb1 = 8+2
         length(itp_s) = 0
         mes_len = 4
         get buffer(cnsl, 1);  ! order up a go-ahead
         -> comm
         #fi

sw(1):   ! send name
         itp_s = name
         j = 0
         %if cnsl >= 10 %start
            k = cnsl//10
            j = k*10
            k = k+'1'
            charno(itp_s, 5) = k
            %finish
            k = cnsl-j+'0'
            charno(itp_s, 6) = k
         #if ~x
         itp_hb1 = 2; itp_hb2 = 2
         #fi
         -> comm

sw(2):   ! send pass
         itp_s = pass
         #if ~x
         itp_hb1 = 2; itp_hb2 = 2
         #fi
         -> comm

         #if x

sw(3):      ! disconnect call
         tcp_state = tcp disconnecting
         to gate(Disconnect, null, 0)
         free buffer(mes)
         %return

         #else

sw(3):   ! send eot
         itp_hb1 = 4; itp_hb2 = 0
         mes_len = 4

         -> comm

sw(6):   ! send go-ahead
         itp_hb1 = 3; itp_hb2 = 0; length(itp_s) = 0
         mes_len = 4

         #fi

comm:
         #if x
         mes_len = length(itp_s)
         #else
         mes_len = 4+length(itp_s)
         #fi
         %if mon # 0 %start
            select output(1)
            #if ~x
            write(itp_cnsl, 1); write(itp_hb1, 1); write(itp_hb2, 1)
            #fi
            %if length(itp_s) # 0 %then spaces(3) %and printstring(itp_s)
            newline
            select output(0)
         %finish

         to gate(put output, mes, 0)
         #if x
            con_state = con_state+1
         #else
         con_state = con_state+1 %unless itp_hb1 = 3;    ! not on go-ahead
         #fi
         %if con_state = 4 %then con_state = 0

         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
         %string (63) t,v

         itp == mes_lev3_itp
         #if x
         k = tcp_tcpn
         mes_lev3_reserved(7)=mes_len
         v=string(addr(mes_lev3_reserved(7)))
         #else
         k = itp_cnsl
         v = itp_s
         #fi


         con == cona(k)
         %if mon < 0 %start
            select output(1)
            printstring("anal:"); write(k, 1); write(con_state, 1)
            #if ~x
            write(itp_hb1, 1); write(itp_hb2, 1)
            #fi
            write(itp_data(0), 1)
            %if length(v) > 0 %then printstring(v)
            newline
            select output(0)
         %finish
         %if mon > 0 %start
            select output(1)
            printstring(v) %if length(v) > 0
            spaces(3); write(k, 1); newline
            select output(0)
         %finish

         #if ~x
         %if k> 48 %start
            printstring("cnsl ="); write(k, 1); newline
            free buffer(mes)
            %return
         %finish

         %if itp_hb1&4 = 4 %start
            con_state = 0
            free buffer(mes)
            %return
         %finish

         %if con_state < 3 %start;   ! look for prompt
            %if itp_hb1&1 = 0 %start; ! text
               %if itp_hb2&4 # 0 %start; ! prompt
                  get buffer(k, 0);        ! do the next thing
               %else;   ! text, so send go-ahead
                  itp_hb1 = 3; itp_hb2 = 0; length(itp_s) = 0
                  mes_len = 4
                  to gate(put output, mes, 0)
                  %return
               %finish
            %finish
         %else;                         ! ready to send eot
            get buffer(k, 0)
         %finish
      #else
      %if v -> t.("**2900").v %start
         to gate(Disconnect, null, 0)
         tcp_state = tcp disconnecting
      %finish %else get buffer(k, 0)
      #fi


         free buffer(mes)
      %end

      %routine mon tcps
         %integer i
         printstring("Ind   Qu   Max  Pkts
")
         %cycle i = 0, 1, sta
            tcp == tcpa(i)
            #if ~x
            %continue %if tcp_state # connected
            #fi
            write(i, 2); write(tcp_size, 4); write(tcp_max, 4)
            write(tcp_packets, 4)
            newline
            tcp_max = 0; tcp_packets = 0
         %repeat
      %end


      CHANGE OUT ZERO = T3 SER
       i = map virt(buffer manager,4, 3)
       i = map virt(buffer manager, 5, 4)
       i = map virt(buffer manager, 6, 5)

      printstring(vsn)
      #if t
         printstring("itp ")
      #fi
      #if x
         printstring("xxx ")
      #fi
      printstring(datestring)
      newline
      prompt("Address?"); readstring(address)
      %if address = "" %then address = "15000009"
      prompt("cnsls?"); read(maxc)
      #if x
      sta = maxc
      #else
      sta = maxc>>2
      #fi
      %cycle i = 0, 1, sta
         tcp == tcpa(i)
         tcp_tcpn = i+1
         #if ~x
         get buffer(i, 255);            ! make a connection
         #fi
      %repeat
      alarm(10)
      charno(name,7) = 13; charno(name,8) = 10
      charno(pass,5) = 13; charno(pass,6) = 10

      %cycle
         p_service = 0; poff(p)
         %if p_reply = 0 %start;    ! clock
               %if int = 'A' %start
                  kill it = -1
                  printstring("killing it
")

                  %cycle i = 0, 1, max conns
                     tcp == tcpa(i)
                     to gate(Disconnect, null, 0) %if tcp_state = connected
                  %repeat
                  int = 0
                  %continue
               %finish
             alarm(50);           ! 1 secs
            %if 'M' <= int <= 'P' %start
               mon = int-'O'; int = 0
            %finish


            tick = tick+1
            %if tick >= 60 %start
               tick = 0
               mon tcps
            %finish

            %if int='?' %start
               write(flag, 1)
               write(pkts, 4); newline
               mon tcps
               int = 0
            %finish


               %continue %if no of small < 15
               i = initf
               initf = initf+1; initf = 0 %if initf = maxc
               %cycle
                  con == cona(i)
                     #if x
                     tcp == tcpa(i)
                     %if tcp_state = 0 %start
                       get buffer(i, 255)
                     tcp_state = conn asked
                     %exit
                     %finish
                     #else
                  %if con_state = 0 %start;   ! ready to go
                     tcp == tcpa(i>>2)
                     %if tcp_state = connected %and tcp_size < 3 %c
                     %then get buffer(i, 0)
                     %exit
                  %finish
                  #fi
                  %exit %if i = initf
                  i = i+1; i = 0 %if i = maxc
               %repeat
             %continue
         %finish

         %if mon < 0 %start
            select output(1)
            printstring("poff:"); write(p_reply, 1)
            write(p_fn, 1); write(p_s1, 1)
            %if p_reply = gate ser %then mon p(p)
            newline
            select output(0)
         %finish

         %if p_reply = buffer manager %start
            %if kill it < 0 %then free buffer(p_mes) %and %continue
            %if p_a2 = 255 %then do connect(p_c2, p_mes) %else %c
              block(p_mes, p_c2)
            %continue
         %finish
         %if p_reply = gate ser %start
            tcp == tcpa(p_task port-1)

            %if p_fn = accept call %start;  ! 2nd reply
               %if %not p_mes == null %then free buffer(p_mes)
                %if kill it < 0 %then to gate(Disconnect, null, 0)
               flag = p_s1
               %if mon # 0 %start
               printstring("call accepted
")
               %finish
               conns = conns+1
               conn ok = 1
               tcp_state = connected
               tcp_port = p_gate port
               #if x
               get buffer(tcp_tcpn, 0);       ! kick console
               #fi
               %continue
            %finish

            %if p_fn=disconnect %start;   ! my end i hope
               %unless p_mes == null %then free buffer(p_mes)
               %if tcp_state = tcp disconnecting %start; ! expected in xxx
                  tcp_state = 0
                  cona(tcp_tcpn)_state = 0
                  %continue
               %finish
               write(p_task port-1, 1)
               printstring(" call gone")
               write(p_s1, 2); newline

               %if tcp_state = connected  %and kill it = 0 %c
                 %then to gate(disconnect, null, 0)
               sta = sta-1;             ! number of conns sent out
               %if sta < 0 %start;      ! all gone
                  p_service = 0; poff(p);   ! wait for timer tick
                  %stop
               %finish
               %if sta = 1 %and tcp_state # connected %then %stop
               %continue
            %finish


            %if p_fn = enable output %start
               tcp_ostate = idle
               tcp_size = tcp_size-p_s1
               tcp_packets = tcp_packets+p_s1
               %continue
            %finish

            %if p_fn = input here %start
               pkts = pkts+1
               analyse itp input(p_mes)
               to gate(enable input, null, 1)
               %continue
            %finish

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