%externalroutine dumpgec(%string(63) s)
%constinteger our exchange = 2
%constinteger scd = 0
%constinteger ecd = 1
%constinteger dcd = 2
%constinteger laustats = 3
%constinteger unitstats = 4
%routinespec dumpaddr(%bytearrayname a, %byte l)
%routinespec writehex(%integer n,d)
!Routine for dumping GEC Network Management logs
!J. butler 20.10.82
%routinespec dat(%integer dat)
%routinespec tod(%integer d)
%externalroutinespec define(%string(63) s)
%externalintegerfnspec smaddr(%integer chan,%integername l)
%externalintegerfnspec exist(%string(63) s)
%integer ina,inl,idunit, idexch,idtype
%string(63) t,u
u = ".out" %and t = s %unless s -> t.(",").u
 
define("1,".t)
ina=smaddr(1,inl)
printstring("Length discrepancy
") %and inl = inl & x'ffffff00' %unless inl & 255 = 0
define("2,".u) ;selectoutput(2)
%begin
%recordformat logf(%integer tod, seqno, %c
((%halfinteger date, exchno) %or %c
(%halfinteger l, %byte type, spare1, %integer id, %c
 (%halfinteger callid, spare, %c
      ((%bytearray called, caller(0:7), %byte cdl, crl, facs, res, scause, sdiags, spare2, spare3) %c
      %or (%integer segs tx, segs rx, %halfinteger ints tx, ints rx, res tx, res rx, retries, ecause, ediags) %c
      %or ((%halfintegerarray l stats(0:11) %c
         %or (%integer oflo, %halfinteger 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, l idle errors))) %c
)))))
%record (logf) %name a
%conststring(4) %array types(0:4) = "SCD ","ECD ","DCD ","LAU ","Unit"
%integer n,j,i,ll,inla
n = inl >> 8 ;!No of blocks

Printstring("    No.       Time

")
%for i = 0, 1, n-1 %cycle
   inla = ina + i * 256


   %cycle
      a == record(inla)
      %if a_seqno = x'ffff' %start
         spaces(9) ;tod(a_tod)
         !Initialising log
         spaces(3) ;dat(a_date) ;spaces(3) ;writehex(a_exchno,4)
         ll = 0
   
      %finishelsestart
         !Anything else
         ll = a_l
         %exit %if ll = 0
         write(a_seqno, 5) ;spaces(3) ;tod(a_tod)
         idtype = (a_id >>24) & 255
         idexch = (a_id >>16) & 255
         idunit = (a_id >>8) & 255
         spaces(3) ;write(ll, 5) ;spaces(3)
         %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
               writehex(idexch, 2) ;printsymbol('/')
            %finishelse spaces(3)

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

         %finishelsestart
            writehex(a_id, 8)

         %finish
   

         %if a_type = scd %or a_type = ecd %or a_type = dcd %start
            write(a_callid, 5) ;space
            %if a_type = scd %start
               dumpaddr(a_caller, a_cdl) ;printstring(" -> ") ;dumpaddr(a_called, a_crl)
               space ;writehex(a_facs, 2) ;space ;writehex(a_res, 2)
               space ;writehex(a_scause, 2) ;space ;writehex(a_sdiags, 2)

            %finishelsestart
               write(a_segs tx, 5) ;write(a_segs rx, 5) ;write(a_ints tx, 5)
               write(a_ints rx, 5) ;write(a_res tx, 5) ;write(a_res rx, 5)
               write(a_retries, 5)
               %if a_type = ecd %start
                  space ;writehex(a_ecause, 2) ;printsymbol('/') ;writehex(a_ediags, 2)
               %finish

            %finish
         %finishelseif a_type = laustats %start

         %finishelseif a_type = unitstats %start

         %finish
      %finish
      ll = (ll + 3) >>2 <<2
      inla = inla + ll + 12
      newline
   %repeat
%repeat
%end


%routine dumpaddr(%bytearrayname add, %byte l)
   %integer i
   %if l < 14 %then spaces(14-l)
   %if l > 1 %start
      %for i = 0, 1, l>>1-1 %cycle
         writehex(add(i), 2)
      %repeat
   %finish
   %if l & 1 # 0 %then writehex(add(l>>1) >> 4, 1)
%end

%routine tod(%integer secs)
   %integer hour, min
   hour = secs//3600
   min = (secs - hour*3600)//60
   secs = secs - (hour *60 + 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
%endoffile