! file 'lmeors'
!**********************
!* lmeors/lmeory   *
!* date: 16.dec.81   *
!*********************
%conststring (13) vsn = "lmeo:vsn001b
"
!! stack = 300, streams = 1

%control 1


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

   %owninteger mon = 1

%%recordformat itpf(%byteinteger cnsl,hb1,hb2,len,  %c
   %byteintegerarray data(0:127))
%recordformat itp2f(%byteinteger cnsl, hb1, hb2, %string(127) s)
%recordformat bspf(%integer st,ss,rc,tc,ufl,   %record (itpf) itp);  !$e
%recordformat mef(%record(mef)%name link,%byteinteger len,type,  %c
   %record(bspf) bsp)
%recordformat me2f(%record(me2f)%name link,%byteinteger len,type,  %c
   %record(bspf) bsp)
%recordformat pf(%byteinteger service,reply,fn,port,  %c
%record(mef)%name mes,%byteinteger len,s1)
%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,  %record (qf) outq)

         %ownrecord (tcpf) tcp
      ! %constinteger not allocated = 0
      %constinteger connected = 1
      %constinteger tcp disconnecting = 2
      !******  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=16, buffer manager=17
%constinteger rd=0, echo off=10
%constinteger request buffer=0, release buffer=1
%constinteger enable facility=1, disable facility=2, call reply=3
%constinteger enable input=4, put output=5, close call=6
%constinteger abort call=7, open call=8, open message=9
%constinteger open call reply=1, incoming call=2, input recd=3
%constinteger output transmitted=4, call closed=5, call aborted=6
%constinteger open reply a=7, open reply b=8, message in=9, message reply=10
      %integer i, node, term, strm, k, flag
      %owninteger initf
      %owninteger users, sta, cpu, pkts, sbr, byt, rjei, tim, rjeo
      %owninteger conn ok, g port, power, kill it, maxc

      %ownstring (9) name = "EYRE10**"
      %ownstring (7) pass = "....**"

      %routine get buffer(%integer reason, r2)
         p_service=buffer manager;   p_reply=id
         p_fn=request buffer;   p_len=0;   p_s1=reason
         p_port = r2
         pon(p)
      %end

      %routine free buffer(%record(mef)%name mes)
         p_service=buffer manager;   p_reply=id
         p_fn=release buffer;   p_mes==mes
         pon(p)
      %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

            %if tcp_ostate # idle %start
               push(tcp_outq, mes)
               tcp_size = tcp_size+1
               tcp_max = tcp_size %if tcp_size>tcp_max
               %return
            %finish
            tcp_ostate = busy

!            %if mon # 0 %start
!               select output(1)
!               printstring("io ");!  mon mes(mes)
!            %finish
            mes_len = mes_len+2;        ! ring header
         %finish

         p_service = gate ser; p_reply = id
         p_fn = fn; p_port = tcp_port; p_mes == mes; p_s1 = flag
         pon(p)
      %end
      %routine do connect(%integer type)

            %recordformat p3f(%byteinteger ser, reply, %c
              fn, port, (%byteinteger node, flag  %or %c
            %record (mef) %name mes), %byteinteger term, facility)
             %record (p3f) p3

         p3_ser = gate ser;  p3_reply = id
         p3_fn = open call;  p3_port = type
         p3_node = node;  p3_term = term
            p3_flag = power
            p3_facility = strm
         pon(p3)
      %end
      %routine block(%record (mef) %name mes, %integer cnsl)
         %integer i, j, k
         %record (bspf) %name bsp
         %recordformat itp2f(%byteinteger cnsl, hb1, hb2, %string (128) s)
         %record (itp2f) %name itp

         %switch sw(0:6)

         bsp == mes_bsp
         itp == mes_bsp_itp
         con == cona(cnsl)
         itp_cnsl = cnsl
         %if p_port # 0 %then ->sw(6);  ! special go-ahead request
         -> sw(con_state)

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

sw(1):   ! send name
         itp_s = name
         j = 0
         %if cnsl >= 10 %start
            k = cnsl//10
lab1:       j = k*10
lab:        k = k+'1'
            charno(itp_s, 5) = k
            %finish
            k = cnsl-j+'0'
            charno(itp_s, 6) = k
         itp_hb1 = 2; itp_hb2 = 2
         mes_len = 4+8
         -> comm

sw(2):   ! send pass
         itp_s = pass
         itp_hb1 = 2; itp_hb2 = 2
         mes_len = 6
         -> comm

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

comm:
         %if mon # 0 %start
            select output(1)
            write(itp_cnsl, 1); write(itp_hb1, 1); write(itp_hb2, 1)
            %if length(itp_s) # 0 %then spaces(3) %and printstring(itp_s)
            newline
            select output(0)
         %finish

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

         pkts = pkts+1
      %end

      %routine analyse itp input(%record (mef) %name mes)
         %record (itpf) %name itp
         %record (itp2f) %name itp2
         %integer i, j, k

         mes_len = mes_len-2;           ! delete the uflag
         itp == mes_bsp_itp; itp2 == itp
         k = itp_cnsl
            %if k > 48 %start
               free buffer(mes); %return
            %finish

         con == cona(k)

         %if mon < 0 %start
            select output(1)
            printstring("anal:"); write(itp_cnsl, 1); write(con_state, 1)
            write(itp_hb1, 1); write(itp_hb2, 1); write(itp_len, 1)
            %if itp_len > 0 %then printstring(itp2_s)
            newline
            select output(0)
         %finish
         %if mon > 0 %start
            select output(1)
            printstring(itp2_s) %if length(itp2_s) > 0
            spaces(3); write(itp_cnsl, 1); newline
            select output(0)
         %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; itp_len = 0
                  mes_len = 6
                  to gate(put output, mes, 0)
                  %return
               %finish
            %finish
         %else;                         ! ready to send eot
            get buffer(k, 0)
         %finish

         free buffer(mes)
      %end

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

      prompt("node?"); read(node)
      prompt("term?"); read(term)
      strm = 18
      prompt("cnsls?"); read(maxc)
      prompt("send ahead?")
      skipsymbol
      readsymbol(i); readsymbol(k)
      i = i-'0'; k=k-'0'
      %if 0<=k<=7 %then power=i<<4+k<<1 %else power=i<<4
       sta = 1
         do connect(0)
      alarm(4*50)
      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
")
                  to gate(call aborted, null, 0) %if conn ok # 0
                  int = 0
                  %continue
               %finish
             alarm(50);           ! 1 secs
            %if 'M' <= int <= 'P' %start
               mon = int-'O'; int = 0
            %finish

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

            %if tcp_state = connected %start

               i = initf
               initf = initf+1; initf = 0 %if initf = maxc
               %cycle
                  con == cona(i)
                  %if con_state = 0 %start;   ! ready to go
                     get buffer(i, 0)
                     %exit
                  %finish
                  %exit %if i = initf
                  i = i+1; i = 0 %if i = maxc
               %repeat
            %finish
             %continue
         %finish

         %if mon = 2 %start
            select output(1)
            printstring("poff:"); write(p_reply, 1)
            write(p_fn, 1); write(p_port, 1); write(p_len, 1); write(p_s1, 1)
            newline
            select output(0)
         %finish

         %if p_reply = buffer manager %start
            %if kill it < 0 %then free buffer(p_mes) %and %continue
            block(p_mes, p_s1)
            %continue
         %finish
         %if p_reply = gate ser %start
            %if p_fn = open reply a %start;  ! 1st reply
               i = p_port;  ! my port number
               k = p_s1;    ! gate port number
               %if k = 0 %start
                  printstring("mcon: gate refused
")
                  %stop
               %finish
               %continue;               ! wait for reply b
            %finish

            %if p_fn = open reply b %start;  ! 2nd reply
                %stop %if kill it < 0
               i = p_port;   ! gate port number !!
               g port = i
               flag = p_s1
               %if p_s1 # 0 %start;     ! failed
                  %if tim = 0 %start
                    printstring("failed"); write(p_s1, 1); newline
                   %finish
                   tim = tim+1
                  do connect(0);        ! try again
                  %continue
               %finish
               printstring("call accepted
")
               conn ok = 1
               tcp_state = connected
               tcp_port = g port
               %continue
            %finish

            %if p_fn=call aborted %or p_fn=call closed %start;   ! my end i hope
               printstring("call gone
")
               %stop
            %finish
            %if p_fn = output transmitted %start
         tcp_ostate = idle
         %unless tcp_outq_e == null %start
            tcp_size = tcp_size-1
            to gate(put output, pop(tcp_outq), 0)
         %finish
               %continue
            %finish

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

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