      PROGRAM LOUSE
C
C     NAME:    LOUSE
C
C     AUTHOR:  D. PLATT
C              HONEYWELL LOS ANGELES DEVELOPMENT CENTER
C
C     DATE:    3/21/78
C
C     PROGRAM READS FILE ':LMMON.:SYS' WHICH WAS GENERATED BY THE LMMON
C     GHOST JOB (ALONG WITH THE LMMON PATCHES TO THE CP-V MONITOR) AND
C     PRODUCES A REPORT OF ALL (OR SELECTED) LOAD MODULES EXECUTED
C     DURING THE TIME PERIOD THAT MONITORING WAS IN EFFECT.  DATA
C     CAPTURED AND REPORTED INCLUDES: LOAD MODULE NAME AND ACCOUNT
C     NUMBER;  NUMBER OF TIMES USED;  CPU TIME (TOTAL AND AVERAGE PER
C     USE);  SYSTEM CALS ISSUED (DITTO);  PHYSICAL I/O OPERATIONS
C     PERFORMED (DITTO);  AND TOTAL WALL-CLOCK (REAL) TIME SPENT IN
C     THE PROGRAM (DITTO).  LOUSE WILL PROPERLY HANDLE SITUATIONS WHERE
C     ONE PROGRAM M:LINK'S TO ANOTHER (I.E., LYNX M:LINK'S TO THE
C     LOADER);  THE TIME, CALS, I/O'S, ETC. USED BY THE LINKED-TO
C     PROGRAM ARE NOT INCLUDED IN THE TOTAL FOR THE LINKED-FROM
C     PROGRAM (COBOL PROGRAMMERS USING NON-CO-RESIDENT SORT TAKE
C     NOTE!).  LOUSE PRODUCES NINE REPORTS, EACH ONE BEING SORTED BY
C     ONE OF THE ABOVE-LISTED STATISTICS.
C
      INCLUDE C:LOUSE
      CALL INIT
      CALL READIN
      CALL CALC
      CALL REPORT
      CALL EXIT
      END
      SUBROUTINE INIT
C
C     SUBROUTINE INIT INITIALIZES THE DATA AREAS FOR LOUSE
C     PROCESSING AND QUERIES THE USER FOR A LIST OF LOAD
C     MODULES/ACCOUNTS TO BE REPORTED ON.
C
      INCLUDE C:LOUSE
      CHARACTER*(45) SELECT
      NPROCS=0
      DO 10 I=1,PROCS
           INVOKE(I) = 0
           TOTCPU(I) = 0
           TOTIO(I) = 0
           TOTCAL(I) = 0
           TOTWALL(I) = 0
10    CONTINUE
      ENDTIME = '???'
      SAVEFLINK(0) = 0
      SAVEBLINK(0) = 0
      DO 15 I=1,SAVESIZE-1
15    SAVEFLINK(I) = I + 1
      SAVEFLINK(SAVESIZE) = 0
      DO 20 I=1,USERS
           CLOCK(I) = -1
20    CONTINUE
      OPEN (1, NAME = ':LMMON', STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
     + USAGE = 'INPUT', ACCOUNT=':SYS', ERR = 900)
      PRINT (108, 30)
30    FORMAT (' WHAT LOAD MODULES?  SPECIFY AS LMN.ACCOUNT - '
     + /' IF LMN OMITTED, SELECTS ALL IN SPECIFIED ACCOUNT;'
     + /' IF ACCOUNT OMITTED, SELECTS :SYS.  ENTER A BLANK'
     + /' LINE TO GET ALL LOAD MODULES IN ALL ACCOUNTS.')
      DO 50 I=1,SELMAX
35    READ (105,40) SELECT
40    FORMAT (A40)
      IF (SELECT .EQ. ' ') GOTO 60
      LMNLIST(I) = ' '
      ACCTLIST(I) = ' '
      DO 41 J=1,40
      IF (SELECT(J:J) .EQ. ' ') GOTO 42
      IF (SELECT(J:J) .EQ. '.') GOTO 42
41    CONTINUE
      J = 41
42    IF (J .LE .32) GOTO 44
      PRINT (108, 43)
43    FORMAT (' FILENAME TOO LONG')
      GOTO 35
44    IF (J .NE. 1) LMNLIST(I) = SELECT(1:J-1)
      IF (SELECT(J:J) .EQ. '.') ACCTLIST(I) = SELECT(J+1:J+9)
      IF (ACCTLIST(I) .EQ. ' ') ACCTLIST(I) = ':SYS'
50    CONTINUE
      I = SELMAX  + 1
60    ACCTNUM = I - 1
      RETURN
900   STOP ' CAN''T OPEN THE :LMMON FILE'
      END
      SUBROUTINE READIN
C
C     SUBROUTINE READIN READS THE :LMMON.:SYS FILE AND BUILDS THE
C     TABLES OF LOAD MODULE STATISTICS.
C
      INCLUDE C:LOUSE
      CHARACTER*(12) PRONAME
      CHARACTER*(8) ACCN
      READ (1,100) STARTIME
      PRINT (108,110) 'STARTED',STARTIME
100   FORMAT (4X,A16)
110   FORMAT (//' PROGRAM MONITORING ',A7,' AT ',A16)
1000  CONTINUE
X     READ (1,1050,END=9000) DATA
1050  FORMAT (11R4)
X     PRINT(108,1060) DATA
1060  FORMAT(/(8(3X,Z8)))
X     BACKSPACE 1
      READ (1,1100,END=9000) USER,BC,PRONAME,ACCN,CPUT,CALCNT,IO,
     + CLOCKT,LINK
1100  FORMAT (R4,R1,A11,A8,5R4)
      IF (USER) 3000,8000,2000
2000  IF (PRONAME(1:BC) .EQ. 'DELTA') GOTO 1000
      CALL USERCHK(USER, 1000S)
      IF (LINK.EQ.0) GOTO 2100
      I = SAVEFLINK(1)
      IF (I .EQ. 0) GOTO 2100
X     PRINT (108,2054) USER,PROC(USER),ACCT(USER),
X    + CPUT,CALCNT,IO,CLOCKT,LINK
2054  FORMAT ('0USER ',Z2,' PUSH  ',A12,2X,A8,5I9)
      SAVEFLINK(1) = SAVEFLINK(I)
      SAVEPROC(I) = PROC(USER)
      SAVEACCT(I) = ACCT(USER)
      SAVECPU(I) = CPU(USER)
      SAVECLK(I) = CLOCK(USER)
      SAVECAL(I) = CALCOUNT(USER)
      SAVEIO(I) = IOCOUNT(USER)
      SAVEUSER(I) = USER
      SAVEFLINK(I) = SAVEFLINK(0)
      SAVEFLINK(0) = I
      SAVEBLINK(I) = 0
      SAVEBLINK(SAVEFLINK(I)) = I
      GOTO 2200
2100  I = SAVEFLINK(0)
      REPEAT 2150, WHILE (I .NE. 0)
      J = SAVEFLINK(I)
      IF (SAVEUSER(I) .EQ. USER) CALL DELINK(I)
2150  I = J
2200  PROC(USER) = PRONAME(1:BC) // BLANKS(1:12-BC)
      ACCT(USER) = ACCN
      CPU(USER) = CPUT
      CALCOUNT(USER) = CALCNT
      IOCOUNT(USER) = IO
      CLOCK(USER) = CLOCKT
X     PRINT (108,2001) USER,PRONAME,ACCN,CPUT,CALCNT,IO,CLOCKT,LINK
2001  FORMAT ('0USER ',Z2,' START ',A12,2X,A8,5I9)
      GOTO 1000
3000  USER = ABS(USER)
      CALL USERCHK(USER, 1000S)
      IF (CLOCK(USER) .LT. 0) GOTO 1000
X     PRINT (108,3005) USER,PROC(USER),ACCT(USER),
X    + CPUT,CALCNT,IO,CLOCKT,LINK
3005  FORMAT ('0USER ',Z2,' END   ',A12,2X,A8,5I9)
      IF (ACCTNUM .EQ. 0) GOTO 3105
      DO 3101 I=1,ACCTNUM
      IF (LMNLIST(I) .EQ. ' ') GOTO 3070
      IF (LMNLIST(I) .NE. PROC(USER)) GOTO 3101
3070  IF (ACCTLIST(I) .EQ. ACCT(USER)) GOTO 3105
3101  CONTINUE
      GOTO 3300
3105  DO 3110 I=1,NPROCS
      IF (PROC(USER).EQ.NAME(I) .AND. ACCT(USER).EQ.ACCOUNT(I))
     + GOTO 3200
3110  CONTINUE
      IF (NPROCS .LT. PROCS) GOTO 3150
      IF (.NOT. OVERFLOW) PRINT (108,3125)
3125  FORMAT   (' LOAD MODULE TABLE OVERFLOW - RECOMPILE!')
      OVERFLOW = .TRUE.
      GOTO 3300
3150  NPROCS = NPROCS + 1
      I = NPROCS
      NAME(I) = PROC(USER)
      ACCOUNT(I) = ACCT(USER)
3200  INVOKE(I) = INVOKE(I) + 1
      DELTACPU = CPUT - CPU(USER)
      DELTAIO = IO - IOCOUNT(USER)
      DELTACAL = CALCNT - CALCOUNT(USER)
      DELTACLK = CLOCKT - CLOCK(USER)
      TOTCPU(I) = TOTCPU(I) + DELTACPU
      TOTIO(I) = TOTIO(I) + DELTAIO
      TOTCAL(I) = TOTCAL(I) + DELTACAL
      TOTWALL(I) = TOTWALL(I) + DELTACLK
3300  CLOCK(USER) = -1
      I = SAVEBLINK(0)
      REPEAT 3400, WHILE (I .NE. 0)
      IF (SAVEUSER(I) .NE. USER) GOTO 3400
      J = I
      REPEAT 3350, WHILE (J .NE. 0)
      IF (SAVEUSER(J) .NE. USER) GOTO 3350
      SAVECPU(J) = SAVECPU(J) + DELTACPU
      SAVECLK(J) = SAVECLK(J) + DELTACLK
      SAVECAL(J) = SAVECAL(J) + DELTACAL
      SAVEIO(J) = SAVEIO(J) + DELTAIO
3350  J = SAVEBLINK(J)
      PROC(USER) = SAVEPROC(I)
      ACCT(USER) = SAVEACCT(I)
      CPU(USER) = SAVECPU(I)
      CLOCK(USER) = SAVECLK(I)
      IOCOUNT(USER) = SAVEIO(I)
      CALL DELINK(I)
X     PRINT (108,3305) USER,PROC(USER),ACCT(USER),CPU(USER),
X    + CALCOUNT(USER),IOCOUNT(USER),CLOCK(USER),LINK
3305  FORMAT ('0USER ',Z2,' PULL  ',A12,2X,A8,5I9)
      GOTO 3500
3400  I = SAVEBLINK(I)
3500  GOTO 1000
      GOTO 1000
8000  BACKSPACE 1
      READ (1,100) ENDTIME
      PRINT (108,110) 'STOPPED',ENDTIME
9000  CLOSE (1)
      RETURN
      END
      SUBROUTINE CALC
C
C     SUBROUTINE CALC CALCULATES THE AVERAGE-PER-USE VALUE OF THE
C     LOAD MODULE USAGE STATISTICS.
C
      INCLUDE C:LOUSE
      DO 10 I=1,NPROCS
      CPUPER(I)  = TOTCPU(I)  / INVOKE(I)
      CALPER(I)  = TOTCAL(I)  / INVOKE(I)
      IOPER(I)   = TOTIO(I)   / INVOKE(I)
      WALLPER(I) = TOTWALL(I) / INVOKE(I)
10    CONTINUE
      RETURN
      END
      SUBROUTINE SORT(KEY)
C
C     SUBROUTINE SORT SORTS THE LOAD MODULE USAGE TABLES INTO
C     ORDER BASED ON ONE OF THE STATISTICS (OR THE LOAD MODULE
C     NAME OR ACCOUNT NUMBER).  A DEFERRED-EXCHANGE COMPARISON
C     SORT IS USED - NOT ELEGANT BUT FAIRLY SIMPLE TO IMPLEMENT
C     AND NOT AS BAD AS SOME (E.G., BUBBLE SORT).
C
      INCLUDE C:LOUSE
      DO 200 I=1,NPROCS-1
      K=I
      DO 100 J=I+1, NPROCS
      IF (KEY) 10,20,30
10    IF (NAME(K) .GT. NAME(J)) K=J
      GOTO 100
20    IF (ACCOUNT(K) .GT. ACCOUNT(J)) K=J
      GOTO 100
30    IF (MOVE(K, KEY) .LT. MOVE(J, KEY)) K=J
100   CONTINUE
      CALL SWAP(I, K)
200   CONTINUE
      RETURN
      END
      SUBROUTINE SWAP(I, K)
C
C     STATISTICS TABLE (UNLESS THEY'RE THE SAME ROW, IN WHICH CASE
C     IT DOES NOTHING.
C
      INCLUDE C:LOUSE
      IF (I .EQ. K) RETURN
      DO 110 L=1, 9
      J = MOVE(I, L)
      MOVE(I, L) = MOVE(K, L)
      MOVE(K, L) = J
110   CONTINUE
      CHAR = NAME(I)
      NAME(I) = NAME(K)
      NAME(K) = CHAR
      CHAR = ACCOUNT(I)
      ACCOUNT(I) = ACCOUNT(K)
      ACCOUNT(K) = CHAR
      RETURN
      END
      SUBROUTINE PRINT(KEY, ID)
C
C     SUBROUTINE PRINT CALLS SORT TO PUT THE STATISTICS TABLE IN THE
C     DESIRED ORDER, PRINTS A PAGE HEADING, AND CALLS PRINTAB TO
C     PRINT THE USAGE REPORT.
C
      INCLUDE C:LOUSE
      CHARACTER ID*(*)
      CALL SORT(KEY)
      PRINT (108, 10) LEN(ID),ID,STARTIME,ENDTIME
10    FORMAT('1'/T10,' ** SORTED BY ',AN,' **',10X,'FROM ',A16,
     + ' TO ',A16)
      CALL PRINTAB
      RETURN
      END
      SUBROUTINE PRINTAB
C
C     SUBROUTINE PRINTAB PRINTS COLUMN HEADINGS FOR THE USAGE REPORT,
C     AND THEN FORMATS AND PRINTS THE REPORT.
C
      INCLUDE C:LOUSE
      EXTERNAL HMS
      CHARACTER*8 HMS
      PRINT (108,10)
10    FORMAT ('0LOAD MODULE',T16,'ACCOUNT',T27,' # OF',T34,'  TOTAL ',
     + T45,'CPU TIME',T61,'TOTAL #',T70,'   CALS',T82,'TOTAL #',T91,
     + '    I/O',T101,' TOTAL ',T112,'RUN TIME'/
     + ' NAME',T16,'NUMBER',T27,' USES',T34,'CPU TIME',
     + T45,' PER USE',T61,'OF CALS',T70,'PER USE',T82,' OF I/O',T91,
     + 'PER USE',T101,'RUN TIME',T112,' PER USE'/)
      DO 100 I=1,NPROCS
      PRINT (108,110) NAME(I), ACCOUNT(I), INVOKE(I),
     + TOTCAL(I), CALPER(I),
     + TOTIO(I),  IOPER(I),
     + HMS(TOTWALL(I)), HMS(WALLPER(I))
100   CONTINUE
110   FORMAT(' ',A12,2X,A8,3X,I5,2X,2(A8,3X),3X,2I9,3X,2I9,3X,2(A8,3X))
      RETURN
      END
      SUBROUTINE REPORT
C
C     SUBROUTINE REPORT CALLS SORT TO PRESORT THE STATISTICS TABLE
C     INTO ACCOUNT NUMBER ORDER, AND THEN CALLS 'PRINT'
C     REPEATEDLY TO GENERATE THE NINE SORTED USAGE REPORTS.
C
      CALL SORT(0)
      CALL PRINT(-1, 'LOAD MODULE NAME')
      IF (ACCTNUM .NE. 1) CALL PRINT(0, 'LOAD MODULE ACCOUNT NUMBER')
      CALL PRINT(1,'# OF USES')
      CALL PRINT(2, 'TOTAL CPU TIME')
      CALL PRINT(6, 'CPU TIME / USE')
      CALL PRINT (3, 'TOTAL # OF CALS')
      CALL PRINT (7, '# OF CALS / USE')
      CALL PRINT (4, 'TOTAL # OF I/O ACCESSES')
      CALL PRINT (8, '# OF I/O ACCESSES / USE')
      CALL PRINT (5, 'TOTAL WALL-CLOCK TIME')
      CALL PRINT (9, 'WALL CLOCK TIME / USE')
      RETURN
      END
      CHARACTER*8 FUNCTION HMS (TMS)
C
C     FUNCTION HMS ACCEPTS AN INTEGER ARGUMENT AND TREATS IT AS
C     A COUNT OF TWO-MILLISECOND TIME UNITS;  IT RETURNS AN 8
C     CHARACTER STRING OF THE FORM HH:MM:SS.
C
      IMPLICIT INTEGER (A-Z)
      EXTERNAL CODA
      CHARACTER*2 CODA
      SEC = (TMS + 250) / 500
      HRS = SEC / 3600
      SEC = MOD(SEC, 3600)
      MIN = SEC / 60
      SEC = MOD(SEC, 60)
      HMS = CODA(HRS) // ':' // CODA(MIN) // ':' // CODA(SEC)
      RETURN
      END
      CHARACTER*2  FUNCTION CODA(ITEM)
C
C     FUNCTION CODA ACCEPTS AN INTEGER ARGUMENT IN THE RANGE 0-99,
C     THE CALLER.  NO ZERO SUPPRESSION;  OVERFLOW DIGITS ARE
C     TRUNCATED.
C
      CHARACTER DIGITS*10
      IMPLICIT INTEGER (A-Z)
      DATA DIGITS/'0123456789'/
      HIGH = MOD(ITEM / 10, 10) + 1
      LOW = MOD(ITEM, 10) + 1
      CODA = DIGITS(HIGH:HIGH) // DIGITS(LOW:LOW)
      RETURN
      END
      SUBROUTINE DELINK(ID)
C
C     SUBROUTINE DELINK ACCEPTS AN ARGUMENT WHOSE VALUE IS THE INDEX
C     NUMBER OF AN ENTRY IN THE 'SAVED PROGRAM' TABLES;  IT DECHAINS
C     THE ENTRY, PLACES IT ON THE FREE-ENTRY LIST, AND RETURNS.
C
      INCLUDE C:LOUSE
      SAVEFLINK(SAVEBLINK(ID)) = SAVEFLINK(ID)
      SAVEBLINK(SAVEFLINK(ID)) = SAVEBLINK(ID)
      SAVEFLINK(ID) = SAVEFLINK(1)
      SAVEFLINK(1) = ID
      RETURN
      END
      SUBROUTINE USERCHK(ID, ALTRET)
C
C     SUBROUTINE USERCHK ACCEPTS A USER NUMBER AS AN ARGUMENT.  IF THE
C     USER NUMBER IS TOO LARGE FOR THE USER'S INFORMATION TO BE
C     PLACED IN THE CURRENT-USAGE TABLES, AN ERROR MESSAGE IS PRINTED
C     AND USERCHK DOES A NON-STANDARD RETURN TO THE STATEMENT PASSED
C     AS THE SECOND ARGUMENT.  IF THE USER NUMBER IS OK, USERCHK
C     SIMPLY RETURNS.
C
      INCLUDE C:LOUSE
      IF (ID .LE. USERS) RETURN
      IF (USERBIG) RETURN ALTRET
      PRINT (108, 10) ID
10    FORMAT (' USER TABLE OVERFLOW ON USER ',Z2,' - RECOMPILE!')
      USERBIG = .TRUE.
      RETURN ALTRET
      END
      BLOCK DATA
      INCLUDE C:LOUSE,LIST
      END
