%CONSTSTRING (13) vsn="26 JUL 83   1"

!!SPEC WARNING: DPROCEDURE changed to DPROCS - change calls.
%EXTERNALINTEGERFUNCTIONSPEC dprocs(%INTEGERNAME n, %INTEGER adr)

!     %INCLUDE "ercc04.pd21s_c03formats"
%CONSTINTEGER MAXTCPNAME= 15    {TCP-name length}
%RECORDFORMAT PROCDATF(%STRING (6) USER, %STRING (MAXTCPNAME) TCPNAME,
   %BYTEINTEGER LOGKEY, %BYTEINTEGER INVOC,PROTOCOL,NODENO,FSYS,
   %INTEGER LOGSNO, %BYTEINTEGER SITE,REASON,CONSOLE1,CONSOLE2, %INTEGER ID,
   PROCESS,PREV WARN,SESSEND, %BYTEINTEGER GETMODE,PREEMPT,BLNK,LINK)
!
%RECORDFORMAT TMODEF(%HALFINTEGER FLAGS1,FLAGS2,
   {.04} %BYTEINTEGER PROMPTCHAR,ENDCHAR,
   {.06} %BYTEARRAY BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))},
   {.0A} %BYTEINTEGER PADS,RPTBUF,LINELIMIT,PAGELENG,
   {.0E} %BYTEINTEGERARRAY TABVEC(0:7), {.16} %BYTEINTEGER CR,ESC,DEL,CAN,
   SP1,SP2,SP3,SP4,SP5,SP6)
{length of this format is X20 bytes}

%RECORDFORMAT UINFF(%STRING (6) USER, %STRING (31) JOBDOCFILE,
   {.28} %INTEGER MARK,FSYS, {.30} PROCNO,ISUFF,REASON,BATCHID,
   {.40} SESSICLIM,SCIDENSAD,SCIDENS,STARTCNSL, {.50} AIOSTAT,SCT DATE,
   SYNC1 DEST,SYNC2 DEST, {.60} ASYNC DEST,AACCT REC,AIC REVS,
   {.6C} %STRING (15) JOBNAME, {.7C} %STRING (31) BASEFILE,
   {.9C} %INTEGER PREVIC, {.A0} ITADDR0,ITADDR1,ITADDR2,ITADDR3,
   {.B0} ITADDR4,STREAM ID,DIDENT,SCARCITY, {.C0} PREEMPTAT,
   %STRING (11) SPOOLRFILE, {.D0} %INTEGER FUNDS,SESSLEN,PRIORITY,DECKS,
   {.E0} DRIVES,PART CLOSE, {.E8} %RECORD (TMODEF) TMODES,
   {108} %INTEGER PSLOT, {10C} %STRING (63) ITADDR,
   {14C} %INTEGERARRAY FCLOSING(0:3), %INTEGER CLO FES,
   {160} %INTEGER OUTPUT LIMIT,DAPSECS, %LONGINTEGER DAPINSTRS,
   {170} %INTEGER OUT, %STRING (15) OUTNAME, {184} %INTEGER HISEG,
   {188} %STRING (31) FORK, {1A8} %INTEGER INSTREAM,OUTSTREAM,
   {1B0} %INTEGER DIRVSN, %INTEGER UEND)

%CONSTRECORD (uinff) %NAME uinf=9<<18
%CONSTINTEGER yes=1, no=0
%CONSTINTEGER print=no


%EXTERNALINTEGERFN fecount(%INTEGERNAME num on fe,num on tcp)

   %INTEGER j,cur,ct,my fe,nentries,fnum,tnum
   %STRING (maxtcpname) my tcp
   %RECORD (procdatf) %NAME c
   %RECORDFORMAT proc rec f(%INTEGER n,array adr)
   %RECORD (proc recf) proc rec
   %RECORD (procdatf) %ARRAY p(1:256)

   num on fe = 0
   num on tcp = 0
   proc rec_array adr = addr(p(1))

   j = dprocedure(1,addr(proc rec))
   %IF j#0 %THENRESULT = j

   nentries = proc rec_n
   my fe = -1
   my  tcp = ""

   fnum = 0
   tnum = 0

   %UNTIL fnum>0 %CYCLE
      cur = 0
      ct = 0
      %WHILE cur<nentries %CYCLE
         cur = cur+1
         ct = ct+1
         c == p(cur)

         %IF my fe>=0 %START
                                         ! Second pass: count users on my fe and tcp
            %IF (p(cur)_id>>16)&255=my fe %THEN fnum = fnum+1
            %IF p(cur)_tcpname=my tcp#"null" %THEN tnum = tnum+1
         %FINISH

         %IF p(cur)_user=uinf_user %AND p(cur)_invoc=uinf_isuff %AND %C
            my fe<0 %THEN my fe = (p(cur)_id>>16)&255 %AND %C
            my tcp = p(cur)_tcpname %ANDEXIT

      %REPEAT
   %REPEAT

   %IF print=yes %START
      printstring("Num on my  fe:"); write(fnum,1); newline
      printstring("Num on my tcp:"); write(tnum,1); newline
   %FINISH
   num on fe = fnum
   num on tcp = tnum
   %RESULT = 0

%END;                                    ! fecount

%EXTERNALROUTINE test fecount(%STRING (255) s)
   %INTEGER a,b,j
   j = fecount(a,b)
   printstring("Flag / fecount / tcp count")
   newline
   write(j,1); write(a,1); write(b,1)
   newline
%END

%ENDOFFILE