!**********************************************************
!*                                                        *
!*       RCO ITP to GEC Network Management Module         *
!*                                                        *
!*                       Gecgrab                             *
!*                                                        *
!*                                                        *
!**********************************************************

#options
!* Prep options
!*  b   -   output binary file, else packed hex+compression
!*
!*
%control 1 ;!No record checking.
!*
#if ~i
%include "deimosperm"
#else
%include "b_deimosspecs"
%control x'4001'
#fi
%begin

%conststring (13) vsn = "GecGrab...2b "
#datestring
#timestring
!*
!**************************
!*                        *
!*    Declarations        *
!*                        *
!**************************

!****** Constintegers ******
!*

!States
%constinteger estb = 2
%constinteger wait data = 1
%constinteger disconnected = 0

!* modes

%constinteger idle = 0
%constinteger sft sent = 1
!estb = 2
%constinteger go sent = 3
%constinteger expect data = 4

%constinteger interact = 0
%constinteger dump = 1
%constinteger hex = 1
%constinteger interp = 2
%include "b_ygatecalls"
%constinteger gatex ser                = 24
%constinteger buffer manager = 17
!Various useful consts etc
%CONSTINTEGER REQUEST BUFFER           =  0
%CONSTINTEGER RELEASE BUFFER           =  1

%constinteger data = 5
%constinteger ack  = 4


!Reasons for grabbing buffers
%constinteger send go = 1
%constinteger send er = 2
%constinteger send ms = 3
%constinteger send sft = 0
%constinteger send connect = 4

!Monitor Calls
%constinteger grotted 2                =  2
%constinteger grotted 4                =  6

!*
!****** End of Constintegers ******
!*


!*
!****** Recordformats ******
!*
%recordformat qf(%record (qf) %name link, %integer count)
%recordformat ts29f(%string (255) s %or %byte octet1 %or %bytearray a(0:255))
%recordformat itpf(%byte cnsl, hb2, hb3, (%string(252) s %or %bytearray a(0:252)))
%recordformat mef(%record (mef) %name link, %byte l,type, %c
       (%bytearray a(0:251) %c
   %or (%string(4) padding, %byte octet1, lcn, fn ,(%bytearray data(0:243) %or %record (itpf) itp %or %record (ts29f) ts29 %or %string (243) ds)) %c
   %or %string(250) s ))
%recordformat pf( %c
    (%byte ser, reply, fn, s1, %record (mef) %name m, %byte gate port, task port) %c
%or (%integer address, d5, %string (3) facility) %c
%or (%byte d6, d7, a1, a2, b1, b2, c1, c2) %c
 %or (%integer type, a, b, c))

%recordformat sidef(%byte proc, state, inputs, outputs, %record (qf) outq)

%ownbyte param, cnsl, mode
%owninteger blocks in, blocks out, bout2
%owninteger gate port
%constinteger max lines = 35
%ownintegerarray m fr tx(0:max lines)
%ownintegerarray l fr tx(0:max lines)
%ownintegerarray o tod a(0:max lines)

!*
!****** Names ******
!*
%ownrecord (sidef) gec
!*
!****** Records and Recordarrays ******
!*
%constrecord (*) %name null == 0
%ownrecord (pf) p = 0
%owninteger forg info = 1
%owninteger print all = 1
%owninteger i,logopt, dataopt,buffers held = 0

%ownbyteintegerarray inbuff(0:511)
%owninteger inp = 0
%owninteger stop on midnight = 0

%ownstring (63) address = ""

!*
!****** Routine Specs ******
!*
%routinespec ask for buffer(%record (mef) %name mes, %byte reason)
%routinespec free buffer(%record (mef) %name mes) ;!EXT
%routinespec to gatex(%integer type, flag)
%routinespec do connect(%record (mef) %name mes)
%routinespec handle gec data(%record (pf) %name p)
%routinespec handle ts packet(%byte ser)
%routinespec read string(%string (*) %name s)
%routinespec query process
%routinespec send(%record (mef) %name mes, %c
%integer fn)
%routinespec stop(%integer reason)
%routinespec process gec log data(%bytearrayname inb, %integer inpt)
!*
!****** Others ******
!*
%ownstring(1) snil = ""
!************************
!*                      *
!*    Main Program      *
!*                      *
!************************
!*
      %on 9 %start;   ! disc full etc.
         selectoutput(0)
         printstring("Disc/directory is full!
")
         -> abo
      %finish

printstring(vsn); printstring(datestring); newline
      prompt("Address?"); readstring(address)
      %if address = "" %then address = "18888888888803"
      prompt("Ignore INFO?")
      readsymbol(i)
      %if i = 'N' %then forg info = 0

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

      ask for buffer(null, send connect)

%cycle
   p_ser = 0
   poff(p)

      %if '0'<=int<='9' %then printall=int-'0' %and int = 0
      %if int = 'S' %then stop on midnight=stop on midnight!!1
      %if 'M' <= int <= 'O' %start
         logopt = int-'O'; int = 0
      %finish

     %if int = 'A' %then to gatex(Disconnect, 1)

   %if int = '?' %start
      query process

   %finish
   int = 0

   buffers held = buffers held + 1 %unless p_m == null
   handle ts packet(p_reply)
      %continue

abo:  to gatex(disconnect, 1)
%repeat

!*********************
!*                   *
!*    Routines       *
!*                   *
!*********************



%routine ask for buffer(%record (mef) %name mes, %byte reason)
   !This routine fires off a buffer request to Buffer Manager
   %record (pf) p
   
   %if mes == null %start
      p_ser = buffer manager ;p_reply = own id
      p_fn = request buffer 
      p_c = 0
      ponoff(p)
      buffers held = buffers held+1
      mes == p_m
   %finish


#if m
      %if logopt < 0 %start
         printstring("ask for buffer, call ="); write(reason, 1); newline
      %finish
#fi

      %if reason = send sft %start
         mes_l = 5
         mes_data(0) = x'84' ;mes_data(1) = 3 ;mes_data(2) = 0
         mes_data(3) = param >>8 ;mes_data(4) = param & 255

      %elseif reason = send go
         mes_l = 3
         mes_data(0) = x'82' ;mes_data(1) = 2 ;mes_data(2) = 0

      %elseif reason = send er
         mes_l = 3
         mes_data(0) = 0 ;mes_data(1) = 4 ;mes_data(2) = 0

      %elseif reason = send ms
         mes_l = 3
         mes_data(0) = 0 ;mes_data(1) = 3 ;mes_data(2) = param

      %else %if reason = send connect
         do connect(mes); %return
      %finish

      send(mes, data)

   %return

%end ;!of Buffer Arrived


%routine free buffer(%record (mef) %name mes)
   %record (pf) p
   %if mes == null %then %return ;!No buffer to free
   p_ser = buffer manager ;p_reply = own id
   p_fn = release buffer
   p_m == mes
   buffers held = buffers held - 1
   pon(p)
%end ;!of Free Buffer

      %routine mon mes(%record (mef) %name mes)
         %integer i, j, k, n

         k = mes_l
         write(k, 1);  space;  space
         j = 0
         %cycle i = 0, 1, k-1
               write(mes_data(i), 1)
               j = j+1;   %if j = 20 %then j = 0 %and newline
         %repeat
         newline;   select output(0)
      %end
      %routine to gatex(%integer fn, flag)
         p_ser = gatex ser; p_reply = id
         p_fn = fn; p_s1 = flag
         p_gate port = gate port; p_task port = 1
         p_m == null
         pon(p)
#if m
         %if logopt < 0 %start
            printstring("To Gatex, call ="); write(fn, 1)
            printstring(", flag ="); write(flag, 1)
            newline
         %finish
#fi
      %end

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


%routine do connect(%record (mef) %name mes)
      %string (3) facn
      %ownstring (5) wind = "W=4/4"

         p_ser = gatex ser; p_reply = id
         p_fn = Connect
         p_s1 = 0
         p_gate port = 0; p_task port = 1
         p_m == mes
         mes_l = 0
         pack(mes, address)
         pack(mes, snil)
         pack(mes, wind)
         pack(mes, snil)
         %if logopt # 0 %start
           printstring("Connect to "); printstring(address)
            newline
         %finish
         pon(p)
%end


%routine dump figs
      %integer i, j
	printstring("No of blocks in:"); write(blocks in, 1)
	printstring(", Blocks out:"); write(blocks out, 1); newline
      printstring("Max pkts (& per sec)for each line:"); newline
      %cycle i = 0, 1, max lines
         %if m frtx(i) # 0 %start
            printstring("lau"); write(i, 2); write(mfrtx(i), 6)
            write(mfrtx(i)//(30*60), 6)
            newline
         %finish
      %repeat
%end

%routine handle gec data(%record (pf) %name p)
   %integer i, m, n, q, l
   %record (mef) %name mes
   mes == p_m

      to gatex(ack, 1);  ! ack the block: NB: Disturbs P
      %if logopt < 0 %then printstring("From Gate ") %and mon mes(mes)

      %if mes_l = 0 %then free buffer(mes) %and %return

      %if mode = sft sent %start
         %if mes_data(1) = 0 %and mes_data(2) = 0 %start
            !Rpos rec'd ok
            ask for buffer(mes, send go) ;mes == null
            printstring("Rpos
")
            mode = go sent

         %else
            printstring("Rneg
")
            mes == null
            mode = idle
            to gatex(Disconnect, 1)

         %finish

      %elseif mode = go sent
         %if logopt # 0 %then printstring("SS
")
         mode = expect data

      %elseif mes_data(0) = 0 %and (mode = estb %or mode = expect data)
         blocks in = blocks in+1
         process gec log data(inbuff, inp)
         inp = 0
         %if mes_data(1) = 1 %start
            %if blocks out = 10000 %start
               printstring("File too large, stopping
")
               to Gatex(Disconnect, 0)
               mode = idle
               free buffer(mes)
               %return
            %finish

            param = mes_data(2)
            ask for buffer(mes, send ms) ;mes == null
            %if logopt # 0 %start
               printstring("MR"); write(param, 1); newline
            %finish
            mode = expect data

         %elseif mes_data(1) = 2
            ask for buffer(mes, send er) ;mes == null
            printstring("ES
")
            mode = idle
            to gatex(Disconnect, 1)

         %else
            printstring("Unkn ?")
            write(mes_data(0), 1) ;write(mes_data(1), 1) ;write(mes_data(2), 1) ;newline

         %finish
      %elseif mode = expect data
         %if mes_data(0) > 127 %then mode = estb %and mes_data(0) = mes_data(0) & 127
            q = 1
            %if length(mes_ds) # 0 %start
            l = length(mes_ds)
back:
              select output(1)
               %for i = 1, 1, l %cycle
                  inbuff(inp) = mes_data(q); inp = inp+1
                  q = q +1
               %repeat
               select output(0)
               %if mes_l > q %then l = mes_data(q) %and q = q+1 %and -> back
            %finish

      %finish

   free buffer(mes)

%end ;!of Handle GEC Data



%routine handle ts packet(%byte ser)
   %record (mef) %name mes
   %integer gate port, task port
   mes == p_m
   task port = p_task port
   gate port = p_gate port
#if m
      %if logopt < 0 %start
         printstring("From Gate; Fn ="); write(p_fn, 1)
         printstring(" flag ="); write(p_s1, 1)
         newline
      %finish
#fi
%if p_fn = accept call %start
      free buffer(mes) %unless mes == null
   cnsl = 0 ;mode = 0
   dataopt = hex
      param = 0
      ask for buffer(null, send sft)
      mode = sft sent

%elseif p_fn = data %or p_fn = control data
   handle gec data(p)

%elseif p_fn = disconnect
      free buffer(mes) %unless mes == null
      printstring("Call Disconnected "); write(p_s1, 1)
      newline
      dump figs
      %stop


%elseif p_fn = ack
%finish

%end ;!of Handle TS packet


%routine read string(%string (*) %name s)
%integer i,j
      s = ""
      %cycle
         readsymbol(i)
         %return %if i = nl
         s = s.tostring(i)
      %repeat
%end

%routine query process
   printstring("BH=") ;write(buffers held, 1) ;newline
      printstring("Blocks In ="); write(blocks in, 1)
      newline
%end ;!of Query Process








%routine send(%record (mef) %name mes, %integer fn)
   %byte q
   p_reply = id
   p_fn = fn
   p_m == mes
   p_gate port = gate port
   p_task port = 1
      p_ser = gatex ser
   %unless p_m == null %start
      buffers held = buffers held - 1
   %finish
   pon(p)
   %return
%end ;!of Send

%routine stop(%integer reason)
   printstring("Gecgrab Stopped") ;write(reason, 1)
#if ~f
   monitor(null, query)
#fi
   %cycle
   %repeat
%end ;!of Stop

      %routine process gec log data(%bytearrayname inb, %integer inpt)


%constinteger our exchange = 1
%constinteger scd = 0
%constinteger ecd = 1
%constinteger dcd = 2
%constinteger laustats = 3
%constinteger unitstats = 4

%constinteger gate start = 33

%routinespec writehex(%integer n,d)
%routinespec dat(%integer dat)

%routinespec dump block(%bytearrayname inb, %integer len)
%routinespec print name
%routinespec tod(%integer d1, d2)
%conststring (7) %array units(0:4) = "Max Bf:", "Cur Bf:", "Vcs", "Min Bf:", "Req Dl:"
%integer ina,inl,idunit, idexch,idtype
! %recordformat logf(%integer tod1, tod2, seq1, seq2, %c
! ((%integer l, %byte type, spare1, %integer id1, id2, %c
!  (%integer callid, spare, %c
!       ((%bytearray called, caller(0:7), %byte cdl, crl, facs, res, scause, sdiags, spare2, spare3) %c
!       %or (%integer seg tx1, seg tx2, seg rx1, seg rx2, %c
!       %integer ints tx, ints rx, res tx, res rx, retries, ecause, ediags)) %c
!       %or (%integerarray l stats(0:11)) %c
!          %or ((%integer oflo1, oflo2, %c
!       %integer l ctrl rx, l ctrl tx, l 1seg rx, l 2seg rx, %c
!       l 3seg rx, l 4seg rx, l 1seg tx, l 2seg tx, l 3seg tx, l 4seg tx, l frms rx, %c
!       l frms tx, l calls rx, l calls tx, l retries, l ints rx, l ints tx, %c
!       l res rx, l res tx, l sups rx, l sups tx, l fcs rx, l abrts rx, %c
!       l idle errors, ldcd,lshort,lunder,l l2res, %c
!       %integer brx1, brx2, btx1, btx2 %or %integerarray lust(0:42))))) %c
! ))

      %recordformat logf(%integer tod1, tod2, seq1, seq2, %c
      %integer l, %byte type, spare1, %integer id1, id2, %c
      %integerarray lust(0:42))

      %record (logf) %name a

%conststring(4) %array types(0:4) = "CON ","END ","CHK ","Link","Unit"
%integer l,n,j,i,ll,inla,seq,blkno,laun, ins, free, k, ww
%integer forget, outp, tod1, tod2, seq1, seq2, x, y
%owninteger otod1, otod2
%integer id1, id2
%owninteger count = 0, unitfl = 0
%owninteger maxcalls = 0
%owninteger pt len = 0

%ownbyteintegerarray out(0:600)


      %return %if inpt = 0
      %if inpt # 512 %start
	  %if pt len = 0 %start;   ! print message flag
            printstring("pt ="); write(inpt, 1); newline
	     pt len = 1
	 %finish
      %finish

         ina = addr(inb(0))
      inla = ina

      forget = 0; outp = 0
      dump block(inb, 512) %if print all = 9
      select output(2)



   %cycle
      a == record(inla)
      ins = 0
      tod1 = swab(a_tod1); tod2 = swab(a_tod2)
      seq1 = swab(a_seq1); seq2 = swab(a_seq2)

      %if otod2 # 0 %and tod1+tod2#0 %start;    ! other way to remove end zeroes?
			x = tod1 - otod1
			%if tod2-otod2>15*60 %and x # 1 %start
				printstring("Time seq? Old ="); tod(otod1, otod2)
				printstring(", New ="); tod(tod1, tod2); newline
			%finish
		%finish
		otod1 = tod1; otod2 = tod2

      %if a_seq1 = -1 %start
         newlines(2)
         spaces(9) ;tod(tod1, tod2)
         !Initialising log
         select output(0)
         printstring("  Date:")
         spaces(3) ;dat(swab(a_l)) ;spaces(3) ;writehex(a_spare1,4)
         newline
         ll = 12;              ! no length byte present in Date
         select output(1)
         %if stop on midnight # 0 %then int = 'A'
   
      %finishelsestart

         !Anything else
inside:
         seq = swab(a_seq2)
         ll = swab(a_l)
         %exit %if ll = 0
      id1 = swab(a_id1); id2 = swab(a_id2)
         idtype = id1 >> 8 &255
         idexch = id1 & 255
         idunit = id2 >> 8 &255
         %if swab(a_seq1) > 2 %or ll > x'100' %c
            %or ll<x'10' %or (a_seq2 = 0 %and a_seq1 = 0) %start
            select output(0)
            writehex(inla-ina, 4)
            printstring(" Invalid Element, skipping
")
            writehex(swab(a_seq1), 4)
            writehex(swab(a_seq2), 4); space; writehex(swab(a_tod2), 4); space
            write(a_type, 1); write(ll, 1); newline
            dump block(inb, 512)
            %exit
         %finish
      %if count = 0 %start
         select output(0); printstring("First record at ")
         tod(tod1, tod2); newlines(2)
         select output(2)
      %finish
      count = count+1

         laun = -1
         %if idtype&255 = 2 %then laun = idunit
         %if idtype&255 = 3 %then laun = gate start+idunit
   

         %if a_type = scd %or a_type = ecd %or a_type = dcd %start
            %if printall = 8 %then print name %and newline
            %if forginfo # 0 %and laun = 20 %then forget = 1
         %finishelseif a_type = laustats %start

            n  = swab(a_lust(13))
            k = n-lfrtx(laun)
            %if k > mfrtx(laun) %and lfrtx(laun)#0 %and %c
             tod2-otoda(laun)<35*60 %then %c
               mfrtx(laun) = k
            l frtx(laun) = n
            otoda(laun) = tod2

            %if print all > 5 %start
            %if a_lust(12)+a_lust(13)#0 %start
               print name
               printstring(" Frms (RX/TX):")
               write(swab(a_lust(12)), 6); write(swab(a_lust(13)), 6)
               printstring(", Calls:")
               write(swab(a_lust(14)), 6); write(swab(a_lust(15)), 6)
               newline
            %finish
            %finish

         %finishelseif a_type = unitstats %start
            %if unitfl = 0 %or printall # 0 %start
               select output(0)
               tod(tod1, tod2); spaces(3)
               x = 2; y = 3
               %if unitfl = 0 %then x = 0
               %if a_lust(4) # 0 %then y = 4
               %for i = x, 1, y %cycle
                  spaces(3); printstring(units(i))
                  write(swab(a_lust(i)), 4)
               %repeat
               newline
               select output(2)
               unit fl = 1
            %finish
         %finish
      %finish

      x = (inla+ll+10)&x'fffc'
      %if forget = 0 %start
         %cycle i = inla, 1, x-1
            out(outp) = byteinteger(i); outp = outp+1
            %if outp > 600 %start
               select output(0)
               printstring("outp ="); write(outp, 1)
               writehex(inla, 4); space; writehex(x, 4); space
               writehex(ll, 4); newline
               dump block(inb, 512); newlines(2)
               dump block(out, 600)
            %exit
            %finish

         %repeat
      %finish
      inla = x
      %if inla >= ina+500 %then %exit;         ! 512-safety margin
      a == record(inla)
      forget = 0
      %if swab(a_tod1)&x'fff0'#0 %start;   ! sub-record
         inla = inla-8
         a == record(inla)
         a_tod1 = swab(tod1); a_tod2 = swab(tod2)
         a_seq1 = swab(seq1); a_seq2 = swab(seq2)

         ins = 1
         -> inside
      %finish
      inla = inla+4 %if a_tod1+a_tod2 = 0;      ! skip the zero word
   %repeat
      %if outp > 0 %start
         select output(1)
         %cycle i = 0, 1, outp-1
            printsymbol(out(i))
         %repeat
            bout2 = bout2+outp
            %if bout2 >= 512 %then blocks out = blocks out+1 %c
              %and bout2 = bout2-512
      %finish
      select output(0)
      dump block(out, outp) %if print all = 9
      %return


      %routine print name
         write(seq, 5)
         printstring(" ("); writehex(seq, 3); printsymbol(')')
         spaces(3) ;tod(tod1, tod2)
         spaces(3); writehex(inla,4); spaces(2)
         %if 0 <= a_type <= 4 %then printstring(types(a_type)) %else write(a_type, 3)
         spaces(3)
         %if idtype & 255 = 2 %start
            !LAU
               printstring("LAU") ;writehex(idunit, 2)
               %if idexch # our exchange %start
                  printsymbol('/'); writehex(idexch, 2)
               %finishelse spaces(3)

         %finishelseif idtype = 3 %start
            !GW
            printstring(" GW") ;writehex(idunit, 2)
            %if idexch # our exchange %start
               printsymbol('/'); writehex(idexch, 2)
            %finishelse spaces(3)

         %finishelsestart
            writehex(a_id2, 4)

         %finish
      %end

%routine dump block(%bytearrayname inb, %integer len)
      %integer i, j
      %cycle i = 0, 1, len-1
         writehex(inb(i), 2)
         space %if i&3 = 3
         newline %if i&31 = 31
         %return %if int # 0
      %repeat
      newline
%end

%routine tod(%integer sec1, sec2)
   %integer hour, min, secs, h, m, s
      h = 0; m = 0; s = 0
      %if sec1 > 1 %then writehex(sec1,4) %and writehex(sec2,4) %and %return
      %if sec1 = 1 %start
         h = 18; m = 12; s = 16
      %finish
      %if sec2&x'8000' # 0 %start
         sec2 = sec2&x'7fff'
         h = h+9; m = m+6; s = s+8
      %finish
   hour = sec2//3600
   min = (sec2 - hour*3600)//60
   secs = sec2 - (hour *60 + min)* 60
      hour = hour+h; min = min+m; secs = secs+s
      %if secs > 60 %then min = min+1 %and secs = secs-60
      %if min > 60 %then hour = hour+1 %and min = min-60
   printsymbol(hour//10 + '0') ;printsymbol(hour - (hour//10)*10 + '0')
   printsymbol(':')
   printsymbol(min//10 + '0') ;printsymbol(min - (min//10)*10 + '0')
  printsymbol(':')
   printsymbol(secs//10 + '0') ;printsymbol(secs - (secs//10)*10 + '0')
%end

%routine writehex(%integer n,d)
%integer i,j,mask
mask=15<<((d-1)<<2)
%cycle i=0,1,d-1
j=(n&mask)>>((d-i-1)<<2) ;mask=mask>>4
%if j>9 %then j=j+7
j=j+'0'
printsymbol(j)
%repeat
%end


%routine dat(%integer dat)
   %integer d, m, y
   d = dat & 31 ;m = (dat>>5) & 15 ;y = (dat>>9) & 63
   y = y + 1972
   write(d, 2); printsymbol('/') ;write(m, 2) ;printsymbol('/') ;write(y, 4)

%end
%end




%endofprogram