ACT
  24
01@@@@SRC
02@@@@SRC
03@@@@SRC
04@@@@SRC
05@@@@SRC
06@@@@SRC
07@@@@SRC
08@@@@SRC
09@@@@SRC
10@@@@SRC
11@@@@SRC
12@@@@SRC
16@@@@SRC
ACNT10SRC
ACTP09SRC
CKPNT@002
FIG1@@SRC
FIG2@@SRC
FIG3@@SRC
LOG@@@002
SEEKIT003
SLIDESSRC
TSKTM1011
TSKTM2014
[\].
01@@@@SRC
 
 
 
        USER ACCOUNTING
 
             UNDER
 
          MULTIACCESS
 
 
 
 
[\].
02@@@@SRC
 
 
     USERS - EDUCATIONAL
 
           - RESEARCH
 
           - NON-ENGINEERING
 
           - OUTSIDE
 
 
 
[\].
03@@@@SRC
 
 
 
            PURPOSE
 
     TO GENERATE AN ACCURATE
     USAGE PROFILE FOR EVERY
       USER OF THE PDP-15
 
 
 
 
[\].
04@@@@SRC
 
 
 
 
 
   PREVIOUS ACCOUNTING SYSTEMS
 
 
 
 
 
 
[\].
05@@@@SRC
 
 
 
        PDP-9  1967-1969
 
          ADSS FROM DT
 
         NO ACCOUNTING
 
 
 
 
[\].
06@@@@SRC
 
 
 
        PDP-9  1969-1971 
 
          ADSS ON RB09
 
        MANUAL ACCOUNTING
          FROM LOG BOOK
 
 
 
[\].
07@@@@SRC
 
 
 
        PDP-9  1971-1976
 
          ADSS ON RB09
 
        ACCOUNTING CLOCK
 
 
 
 
[\].
08@@@@SRC
 
 
        PDP-15  1976-1978
 
          XVM/RSX V1A
 
                - BATCH
 
                - EDITOR
 
                - QUEUER
 
[\].
09@@@@SRC
 
 
 
 
        PDP-15  1978-  ??
 
          MULTIACCESS
 
 
 
 
 
[\].
10@@@@SRC
 
 
         SPECIFIC AIMS
 
   - MINIMAL CHANGES
 
   - MEASURE CPU TIME, I/O
     COUNT AND CONNECT TIME
 
   - ACCOUNT FOR ALL USER
     ACTIVITY
 
[\].
11@@@@SRC
    METHOD OF IMPLEMENTATION
 
    A - CHANGES TO EXISTING
        SOFTWARE
 
        RSX.P1, RSX.P2
 
        ...SAV
 
        TDV... (LOGON2, LOGOFF)
 
        ...DOS
[\].
12@@@@SRC
 
 
    METHOD OF IMPLEMENTATION
 
    B - ADDITIONAL SOFTWARE
 
       - TSKTM1, TSKTM2
 
       - .ON.NN, OFF.NN, ..CKP.
 
       - ACTP, ACNT
 
[\].
16@@@@SRC
 
 
          CONCLUSION
 
      THE PURPOSE HAS BEEN
      ACHIEVED WITHIN THE
      CONSTRAINTS OUTLINED
           UNDER THE
         SPECIFIC AIMS
 
 
 
[\].
ACNT10SRC
C     .TITLE ACNT
C
C  18 APR 78 (010; PDH) SPECIFY NUMBER OF COPIES OF MONTHLY PRINT-OUT
C  11 APR 78 (009; PDH) TRY TO ENSURE THAT THERE ARE NO NEGATIVE
C                       CONNECT TIME VALUES CALCULATED
C  11 APR 78 (008; PDH) ADD THE 'EDIT' SECTION
C  10 APR 78 (007; PDH) CHANGE THE OPERATOR RATE, WHERE APPLICABLE
C   6 APR 78 (006; PDH) INCORPORATE AN OPERATOR CHARGE FOR CERTAIN ACCOUNTS
C   4 APR 78 (005; PDH) ADD IN THE MONTHLY SUMMARY SECTION
C   4 MAR 78 (004; PDH) DON'T CHARGE USERS FOR CONNECT TIME BEFORE
C                       THE SYSTEM WAS UP (BEFORE TIME OF 'TSKTM1')
C  24 FEB 78 (003; PDH) TIDY UP THE OUTPUT A BIT
C  24 FEB 78 (002; PDH) DO SOME DEBUGGING
C  15 FEB 78 - PAUL HENDERSON
C
C  WATRAN ROUTINE TO PROCESS THE RAW ACCOUNTING DATA FILES AND
C  PRODUCE A LISTING AND DISK FILES FOR THE CONSOLIDATED
C  ACCOUNTING DATA.
C
      LOGICAL DOTNN/.FALSE./,SORTED,OPR,NEGTIM/.FALSE./
      INTEGER*2 DKI/57/,DKO/58/,LP/6/,TT/4/
      INTEGER*2 CPB(2),D(6),DL(6),LGINTM(0/5),INDEXU
      INTEGER*2 BEGTIM,NOW,THEN,ICNECT,ITOTCN
      INTEGER*4 KD0/0/,ICPUTM,IOCNT,ITOTIO
      INTEGER*4 IOCNTS(100),ICNECS(100)
      REAL*4    CPUTMS(100),CPRATE/10.0/,IORATE/0.0/,CNRATE/0.80/
      REAL*4    OPRATE/0.10/
      REAL*4    CPUTIM
      CHARACTER*2  MNTHS2(12)/'JA','FE','MR','AP','MY','JN',
     *                        'JL','AU','SE','OC','NV','DC'/
      CHARACTER*3  MNTHS3(12)/'JAN','FEB','MAR','APR','MAY','JUN',
     *                        'JUL','AUG','SEP','OCT','NOV','DEC'/
      CHARACTER*3  TSKNM1,TSKNM2,UIC,UICARY(0/5),USERS(100),CHKUIC
      CHARACTER*3  MONTH
      CHARACTER*9  INAME,ONAME,TNAME/'TMPFILUSR'/
      CHARACTER    COMAND*5,EDFILE*6,VALUE*20
      CHARACTER*80 HEADER
C
C  BEGIN THE INTERACTION WITH THE USER
C
   1  WRITE (TT,*) 'ACCOUNTS PROGRAM: (EDIT/SUM/EXIT)'
      READ (TT,*)   COMAND
      IF (COMAND .EQ. 'SUM' ) GO TO 10
      IF (COMAND .EQ. 'EDIT') GO TO 400
      IF (COMAND .EQ. 'EXIT') STOP 1
      WRITE (TT,*) 'INVALID COMMAND'
      GO TO 1
C
C  ASK USER VIA TTY TO INPUT MONTH AND YEAR FOR SUMMARY
C
  10  WRITE (TT,*) 'ENTER MONTH AND YEAR FOR ACCOUNT FILE',
     * 'SUMMARY (MMM YY):'
      READ  (TT,*) MONTH,IYEAR
      DO 20 INDEXM=1,12
      IF (MONTH .EQ. MNTHS3(INDEXM)) GO TO 30
  20  CONTINUE
      WRITE (TT,*) '*** INVALID MONTH ***'
      GO TO 10
C
C  THE MONTH HAS BEEN VALIDATED AND ITS NUMERICAL SEQUENCE NUMBER
C  ESTABLISHED.  BEGIN PROCESSING THE RAW ACCOUNTING DATA FILES.
C
  30  WRITE (TT,*) 'HOW MANY COPIES?'
      READ  (TT,*) INDEXC
      CALL DATE (D)
      CALL OPEN (LP,'STATS LST')
      WRITE (HEADER,39) D(2),MNTHS3(D(1)),D(3),D(4),D(5),D(6)
      DO 1231 IDAY=1,31
      WRITE (INAME,38) IDAY,MNTHS2(INDEXM),IYEAR,'ACT'
      WRITE (ONAME,38) IDAY,MNTHS2(INDEXM),IYEAR,'USR'
      CALL SEEKIT (DKI,INAME,IEV)
      IF (IEV .EQ. (-11)) GO TO 1231
      IF (IEV .LE.   0  ) GO TO 900
C
  39  FORMAT (9X,'ACCOUNTING FILE SUMMARY',T43,I2,1XA3,I3,
     *        T54,'   :00:00',T54,3(1XI2),T70,'PAGE')
  38  FORMAT ('00',T1,I2,A2,I2,A3)
C
C  RAW DATA FILE HAS BEEN FOUND.  OPEN IT FOR INPUT, AND ALSO
C  OPEN A TEMPORARY OUTPUT WORKING FILE.
C
      CALL OPEN (DKI,INAME)
      CALL OPEN (DKO,TNAME)
C
C  INDICATE THAT THE DEFAULT LOGIN TIME IS 0000 HOURS, AND THAT
C  NO USERS ARE LOGGED IN.  ALSO INITIALIZE THE ARRAY OF 'USERS'.
C
      USERS(1) = ' '
      NOW    = 0
      INDEXU = 1
      DO 40 K=0,5
      LGINTM(K) = 0
      UICARY(K) = ' '
  40  CONTINUE
C
C  LOOP RETURNS HERE TO READ ANOTHER RAW DATA RECORD
C
  50  READ (DKI,END=100) CPB,DL,TSKNM1,TSKNM2,ICPUTM,IOCNT,UIC
C
C  PERFORM REQUIRED DATA CONVERSIONS, SET A LOGICAL VARIABLE FOR
C  LATER 'CASE' DETERMINATION, AND GENERATE A 'TERMINAL NUMBER'
C  INDEX VALUE.  IF IT IS FOUND THAT WE HAVE A NEGATIVE TIME SINCE
C  THE PREVIOUS TASK EXIT, LOG OUT ALL USERS WITH THE PREVIOUS TIME,
C  THEN CONTINUE WITH THE NEW TASK EXIT TIME.
C
      CPUTIM = ICPUTM*0.00001
      THEN = NOW
      NOW  = DL(4)*60 + DL(5)
      IF (NOW .GE. THEN) GO TO 55
C
      NEGTIM = .TRUE.
      NOW    = THEN
      WRITE (TT,58) DL(2),MNTHS3(DL(1)),DL(3),DL(4),DL(5),DL(6)
      GO TO 84
C
  55  IF (NEGTIM) NOW = DL(4)*60 + DL(5)
      NEGTIM = .FALSE.
      DOTNN  = .FALSE.
      IF (TSKNM2 .GE. '.00' .AND. TSKNM2 .LE. '.05') DOTNN = .TRUE.
      IF (DOTNN) READ (TSKNM2,59) INDEXT
  59  FORMAT (1XI2)
  58  FORMAT (' NEGATIVE TIME INTERVAL AT',I3,1XA3,I3,I4,2(':',I2))
C
C  MAINTAIN A LIST OF ALL UIC'S PROCESSED IN THIS FILE
C
      DO 60 K=1,INDEXU
      IF (USERS(K) .EQ. UIC) GO TO 80
  60  CONTINUE
      IF (INDEXU .LT. 100) GO TO 70
      WRITE (TT,*) 'TOO MANY UIC''S'
      STOP 60
  70  INDEXU = INDEXU + 1
      USERS(INDEXU) = UIC
C
C  CHECK THE TASK NAME TO SEE WHAT (IF ANY) SPECIFIC ACTION
C  IS REQUIRED.  THE CHECK FOR 'USR.NN' IS MADE FIRST, BECAUSE
C  IT WILL BE THE MOST FREQUENTLY ENCOUNTERED TYPE.
C
  80  IF (TSKNM1 .EQ. 'USR' .AND. DOTNN) GO TO 82
      IF (TSKNM1 .EQ. '.ON' .AND. DOTNN) GO TO 81
      IF (TSKNM1 .EQ. 'OFF' .AND. DOTNN) GO TO 83
      IF (TSKNM1 .EQ. 'TSK' .AND. TSKNM2 .EQ. 'TM1') GO TO 84
      IF (TSKNM1 .EQ. '..D' .AND. TSKNM2 .EQ. 'OS.') GO TO 85
C
C  EXEC MODE TASK IS NOT 'USR.NN', BUT DOES HAVE UIC
C
      IF (TSKNM1 .NE. '   ' .AND. DOTNN) GO TO 82
      GO TO 86
C
C  CASE 1: LOGIN ENTRY.  RECORD LOGIN TIME.
C
  81  LGINTM(INDEXT) = NOW
      GO TO 86
C
C  CASE 2: USER PROGRAM ENTRY (USR.NN).  RECORD UIC
C
  82  UICARY(INDEXT) = UIC
      GO TO 86
C
C  CASE 3: LOGOUT ENTRY.  NO UIC EXISTS FOR THIS, BUT WE MAY INFER THE
C          APPROPRIATE UIC FROM THE LAST 'USR.NN'.  WE ALSO GENERATE
C          A CONNECT TIME VALUE, AND MARK THE TERMINAL AS LOGGED OUT.
C
  83  UIC = UICARY(INDEXT)
      ICNECT = NOW - LGINTM(INDEXT) + 1
      LGINTM(INDEXT) = -1
      UICARY(INDEXT) = ' '
      WRITE (DKO) UIC,0.0,KD0,ICNECT
      GO TO 50
C
C  CASE 4: TASK 'TSKTM1' MEANS A NEW BEGINNING TIME FOR REFERENCING
C          UNPAIRED LOGOUTS.  AT THIS TIME ALL USERS SHOULD BE LOGGED
C          OUT, SO WE ENSURE THAT THIS IS DONE, THEN SET NEW 'BEGTIM'.
C
  84  BEGTIM = DL(4)*60 + DL(5)
      DO 844 K=0,5
      IF (UICARY(K) .EQ. ' ') GO TO 843
      ICNECT = NOW - LGINTM(K) + 1
      WRITE (DKO) UICARY(K),0.0,KD0,ICNECT
      UICARY(K) = ' '
  843 LGINTM(K) = BEGTIM
  844 CONTINUE
      IF (NEGTIM) GO TO 55
      GO TO 50
C
C  CASE 5: TASK '..DOS.' MEANS THAT ALL ACTIVE USERS SHOULD BE
C          LOGGED OUT AT THIS TIME.  IT WOULD ALSO NOT DO ANY
C          DAMAGE TO SET A NEW START TIME HERE, SO CASE 4 IS USED.
C
  85  GO TO 84
C
C  CASE 6: TASK NAME NOT SELECTED FOR CASES 1-5 PROBABLY MEANS
C          A SYSTEM TASK.  NO SPECIAL ACTION TAKEN.
C
  86  WRITE (DKO) UIC,CPUTIM,IOCNT,0
      GO TO 50
C
C  THE END OF THE INPUT RAW ACCOUNT DATA FILE HAS BEEN REACHED.
C  ANY CURRENTLY ACTIVE USER WILL HAVE HIS CONNECT TIME
C  EXTENDED TO MIDNIGHT (2400 HOURS).
C
 100  NOW = 24*60
      DO 140 K=0,5
      IF (UICARY(K) .EQ. ' ') GO TO 140
      ICNECT = NOW - LGINTM(K) + 1
      WRITE (DKO) UICARY(K),0.0,KD0,ICNECT
 140  CONTINUE
      CALL CLOSE (DKI)
      CALL CLOSE (DKO)
C
C  THE ARRAY OF USER IDENTIFICATION CODES 'USERS' IS NOW
C  SORTED ALPHABETICALLY.
C
 150  SORTED = .TRUE.
      IF (INDEXU .LT. 2) GO TO 170
      DO 160 K=2,INDEXU
      IF (USERS(K) .GE. USERS(K-1)) GO TO 160
      UIC = USERS(K)
      USERS(K) = USERS(K-1)
      USERS(K-1) = UIC
      SORTED = .FALSE.
 160  CONTINUE
 170  IF (.NOT. SORTED) GO TO 150
C
C  THE UIC'S ARE NOW IN ALPHABETICAL ORDER.  NEXT STEP IS TO
C  SUM THE ENTRIES IN THE TEMPORARY WORKING FILE, BY UIC, AND
C  GENERATE A CONSOLIDATED DISK FILE, AND A LINE PRINTER LISTING.
C
      CALL OPEN (DKO,ONAME)
      WRITE (LP,179) IDAY,MNTHS3(INDEXM),IYEAR
 179  FORMAT (//10XI2,1XA3,I3/)
C
      DO 200 K=1,INDEXU
      CHKUIC = USERS(K)
      TOTCPU = 0.0
      ITOTIO = 0
      ITOTCN = 0
      CALL OPEN (DKI,TNAME)
C
C  LOOP RETURNS HERE TO READ ANOTHER INTERMEDIATE FILE RECORD.
C
 180  READ (DKI,END=190) UIC,CPUTIM,IOCNT,ICNECT
      IF (UIC .NE. CHKUIC) GO TO 180
      TOTCPU = TOTCPU + CPUTIM
      ITOTIO = ITOTIO + IOCNT
      ITOTCN = ITOTCN + ICNECT
      GO TO 180
C
C  END OF INTERMEDIATE FILE REACHED.  OUTPUT A SUMMARY RECORD.
C
 190  CALL CLOSE (DKI)
      WRITE (LP,199) CHKUIC,TOTCPU,ITOTIO,ITOTCN
      WRITE (DKO)    CHKUIC,TOTCPU,ITOTIO,ITOTCN
 200  CONTINUE
 199  FORMAT (10XA3,F14.6,2XI12,2XI7)
C
C  ALL STATISTICS FOR THIS PARTICULAR DAY HAVE BEEN PROCESSED.
C  CLOSE THE OUTPUT DISK FILE.
C
      CALL CLOSE (DKO)
1231  CONTINUE
C
C  NOW BEGIN TO OUTPUT THE MONTHLY SUMMARY.
C
      CPUTMS(1) = 0.0
      IOCNTS(1) = 0
      ICNECS(1) = 0
      USERS(1)  = ' '
      INDEXU    = 1
C
      DO 1232 IDAY=1,31
      WRITE (INAME,38) IDAY,MNTHS2(INDEXM),IYEAR,'USR'
      CALL SEEKIT (DKI,INAME,IEV)
      IF (IEV .EQ. (-11)) GO TO 1232
      IF (IEV .LE.   0  ) GO TO 900
C
C  DATA FILE HAS BEEN FOUND.  OPEN IT FOR INPUT.
C
      CALL OPEN (DKI,INAME)
C
C  LOOP RETURNS HERE TO READ ANOTHER DATA RECORD
C
 250  READ (DKI,END=300) UIC,CPUTIM,IOCNT,ICNECT
C
C  MAINTAIN A LIST OF ALL UIC'S PROCESSED.
C
      DO 260 K=1,INDEXU
      IF (USERS(K) .EQ. UIC) GO TO 280
 260  CONTINUE
      IF (INDEXU .LT. 100) GO TO 270
      WRITE (TT,*) 'TOO MANY UIC''S'
      STOP 260
C
C  INSERT NEW UIC AND ACCOUNTING FIGURES INTO ARRAYS
C
 270  INDEXU = INDEXU + 1
      USERS(INDEXU)  = UIC
      CPUTMS(INDEXU) = CPUTIM
      IOCNTS(INDEXU) = IOCNT
      ICNECS(INDEXU) = ICNECT
      GO TO 250
C
C  UIC ALREADY ENCOUNTERED.  UPDATE TOTALS.
C
 280  CPUTMS(K) = CPUTMS(K) + CPUTIM
      IOCNTS(K) = IOCNTS(K) + IOCNT
      ICNECS(K) = ICNECS(K) + ICNECT
      GO TO 250
C
C  END OF DATA FILE.  CLOSE IT IN PREPARATION FOR ANOTHER ONE.
C
 300  CALL CLOSE (DKI)
1232  CONTINUE
C
C  THE ARRAY OF USER IDENTIFICATION CODES 'USERS' MUST NOW BE
C  SORTED ALPHABETICALLY.
C
 350  SORTED = .TRUE.
      IF (INDEXU .LT. 2) GO TO 370
      DO 360 K=2,INDEXU
      IF (USERS(K) .GE. USERS(K-1)) GO TO 360
C
C  ARRAY OUT OF ORDER.  SWAP ITEMS IN THE THREE ARRAYS, REMEMBERING
C  THAT WE NEED AN I*4 VARIABLE FOR 'ICNECS'.
C
      UIC = USERS(K)
      USERS(K) = USERS(K-1)
      USERS(K-1) = UIC
      CPUTIM = CPUTMS(K)
      CPUTMS(K) = CPUTMS(K-1)
      CPUTMS(K-1) = CPUTIM
      IOCNT = IOCNTS(K)
      IOCNTS(K) = IOCNTS(K-1)
      IOCNTS(K-1) = IOCNT
      IOCNT = ICNECS(K)
      ICNECS(K) = ICNECS(K-1)
      ICNECS(K-1) = IOCNT
      SORTED = .FALSE.
 360  CONTINUE
 370  IF (.NOT. SORTED) GO TO 350
C
C  THE UIC'S ARE NOW IN ALPHABETICAL ORDER.  NEXT STEP IS TO
C  CALCULATE THE APPRIORIATE CHARGES AND OUTPUT THE STATISTICS.
C
      CALL DATE (D)
C
C  ENTER PRINT-OUT LOOP FOR SPECIFIED NUMBER OF COPIES
C
      DO 381 INDEX=1,INDEXC
      WRITE (LP,389) D(2),MNTHS3(D(1)),D(3),D(4),D(5),D(6),MONTH,IYEAR
C
      DO 380 K=1,INDEXU
      UIC    = USERS(K)
      CPUTIM = CPUTMS(K)
      IOCNT  = IOCNTS(K)
      ICNECT = ICNECS(K)
      CHARGE = CPUTIM/3600.*CPRATE + IOCNT*IORATE +
     *         ICNECT/60.*CNRATE
      OPR = .FALSE.
      IF (UIC.EQ.'BWC' .OR. UIC.EQ.'CTY' .OR. UIC.EQ.'NCR' .OR.
     *    UIC.EQ.'NCT' .OR. UIC.EQ.'SHM') OPR = .TRUE.
      IF (OPR) CHARGE = CHARGE + ICNECT*OPRATE
      WRITE (LP,388) UIC,CPUTIM,IOCNT,ICNECT,CHARGE
 380  CONTINUE
 381  CONTINUE
C
 388  FORMAT (10XA3,F14.6,2(2XI12),3X,'$',F7.2)
 389  FORMAT ('1',T11,I2,1XA3,I3,I4,':00:0',T24,2(1XI2),
     *  T48,'MONTHLY SUMMARY FOR ',A3,', 19',I2,//,
     *  T11,'UIC   CPU SECONDS',T33,'I/O COUNT',
     *  T44,'CONNECT MINS',T61,'CHARGE',/)
C
C  END OF STATISTICS FOR THE MONTH.  CLOSE LINE PRINTER FILE.
C
      CALL CLOSE (LP)
      STOP 381
C .EJECT
 408  FORMAT (A6)
 409  FORMAT (A6,'USR')
C
C  IT IS DESIRED TO EDIT THE SUMMARY FILE FOR A PARTICULAR DAY.
C
 400  WRITE (TT,*) 'ENTER DATE OF FILE TO BE EDITED (DDMMYY)'
      READ (TT,408) EDFILE
      WRITE (INAME,409) EDFILE
      CALL SEEKIT (DKI,INAME,IEV)
      IF (IEV .EQ. (-11)) GO TO 400
      IF (IEV .LT.    0 ) GO TO 900
      CALL OPEN (DKI,INAME)
      CALL OPEN (DKO,TNAME)
      WRITE (TT,*) 'WHEN MODIFYING VALUES, CHOOSE INDICIES 1-3'
C
 410  WRITE (TT,*) 'ENTER UIC OR ''DONE'''
      READ  (TT,*) COMAND
      IF (COMAND .EQ. 'DONE') GO TO 490
C
 420  READ (DKI,END=500) UIC,CPUTIM,IOCNT,ICNECT
      IF (UIC .EQ. COMAND) GO TO 430
      WRITE (DKO) UIC,CPUTIM,IOCNT,ICNECT
      GO TO 420
C
C  DISPLAY VALUES, THEN DETERMINE WHICH VARIABLE TO MODIFY
C
 430  WRITE (TT,199) UIC,CPUTIM,IOCNT,ICNECT
 440  WRITE (TT,*) 'MODIFY: (INDEX, VALUE)'
      READ  (TT,*) INDEX,VALUE
      IF (INDEX) 450,480,460
 450  WRITE (TT,*) 'ILLEGAL INDEX'
      GO TO 440
 460  IF (INDEX .GT. 3) GO TO 450
      GO TO (4701,4702,4703),INDEX
 4701 READ (VALUE,*) CPUTIM
      GO TO 430
 4702 READ (VALUE,*) IOCNT
      GO TO 430
 4703 READ (VALUE,*) ICNECT
      GO TO 430
C
C  RECORD HAS BEEN EDITED.  WRITE IT OUT AND ASK FOR NEXT UIC.
C
 480  WRITE (DKO) UIC,CPUTIM,IOCNT,ICNECT
      GO TO 410
C .EJECT
C  END OF EDITING (COMMAND = 'DONE').  COPY THE REST OF THE INPUT
C  FILE TO THE TEMPORARY OUTPUT FILE.
C
 490  READ (DKI,END=500) UIC,CPUTIM,IOCNT,ICNECT
      WRITE (DKO)        UIC,CPUTIM,IOCNT,ICNECT
      GO TO 490
C
C  END OF FILE.  MUST NOW COPY TEMPORARY FILE BACK TO BE THE
C  MODIFIED ORIGINAL FILE.
C
 500  WRITE (TT,*) 'END OF DATA FILE'
      CALL CLOSE (DKI)
      CALL CLOSE (DKO)
      CALL OPEN (DKI,TNAME)
      CALL OPEN (DKO,INAME)
 510  READ (DKI,END=520) UIC,CPUTIM,IOCNT,ICNECT
      WRITE (DKO)        UIC,CPUTIM,IOCNT,ICNECT
      GO TO 510
C
 520  CALL CLOSE (DKI)
      CALL CLOSE (DKO)
      GO TO 1
C .EJECT
C
C  A BAD EVENT VARIABLE HAS BEEN ENCOUNTERED.  ANNOUNCE IT!
C
 900  WRITE (LP,999) IEV
      WRITE (TT,999) IEV
      STOP 999
 999  FORMAT (' *** BAD EVENT VARIABLE',I7,' (DECIMAL) ***')
      END
[\].
ACTP09SRC
C     .TITLE ACTP
C
C   8 APR 78 (009; PDH) CHANGE TO OUTPUT ONE DAY ONLY
C  18 FEB 78 (008; PDH) CHANGE I/O COUNT TO I*4
C  16 JAN 78 (007; PDH) OUTPUT HEADER ON EVERY PAGE
C  13 JAN 78 (006; PDH) OPEN FILE NAME ON LP SO WE CAN CLOSE
C  12 JAN 78 (005; PDH) DO SOME MORE FORMATTING ADJUSTMENTS
C  12 JAN 78 (004; PDH) ALTER OUTPUT FORMAT SLIGHTLY AGAIN.
C  12 JAN 78 (003; PDH) CHANGE THE PRINT-OUT FORMAT SLIGHTLY;
C                       FIX UP CPU TIME.
C  11 JAN 78 (002; PDH) MUST 'CALL DATE' AT STATEMENT 3
C   6 JAN 78 - PAUL HENDERSON
C
C  WATRAN ROUTINE TO PRINT THE CONTENTS OF A SPECIFIED MONTH'S
C  ACCOUNTING FILES, AS DUMPED BY THE 'TSKTM2' ROUTINE.
C
      INTEGER*2 DKI/57/,LP/6/,TT/4/
      INTEGER*2 LINES/0/,PAGE/1/
      INTEGER*2 D(6),DL(6),CPB(2),YEAR,DAY,EV
      INTEGER*4 CPUTIM,IOCNT
      REAL*4 SECNDS
      CHARACTER*2 MNTHS2(12)/'JA','FE','MR','AP','MY','JN',
     *                       'JL','AU','SE','OC','NV','DC'/
      CHARACTER*3 MNTHS3(12)/'JAN','FEB','MAR','APR','MAY','JUN',
     *                       'JUL','AUG','SEP','OCT','NOV','DEC'/
      CHARACTER*3 MONTH,TSKNM1,TSKNM2,UIC
      CHARACTER*9 FNAME
      CHARACTER*80 HEADER
C
C  ASK USER (VIA MCR TERMINAL) TO INPUT REQUIRED DATE FOR PRINT-OUT
C
   1  WRITE (TT,*) 'ENTER DATE FOR ACCOUNTING STATICS',
     *  'PRINT-OUT (DD MMM YY):'
      READ (TT,99) DAY,MONTH,YEAR
      DO 2 INDEXM=1,12
      IF (MONTH .EQ. MNTHS3(INDEXM)) GO TO 3
   2  CONTINUE
      WRITE (TT,*) '*** INVALID MONTH ***'
      GO TO 1
C .EJECT
C  WE HAVE VALIDATED THE MONTH, AND HAVE ALSO DETERMINED
C  ITS NUMBER.  BEGIN OUTPUTTING THE STATISTICS FOR
C  SPECIFIED DAY OF THE MONTH.
C
   3  CALL DATE (D)
      CALL OPEN (LP,'STATS LST')
      WRITE (HEADER,94) D(2),MNTHS3(D(1)),D(3),D(4),D(5),D(6)
      WRITE (LP,98) HEADER,PAGE
      D(1) = 0
C
      WRITE (FNAME,97) DAY,MNTHS2(INDEXM),YEAR
      CALL SEEKIT (DKI,FNAME,EV)
      IF (EV .NE. (-11)) GO TO 35
      WRITE (TT,*) 'ACCOUNTING FILE NOT FOUND'
      GO TO 1
C
  35  IF (EV .LE. 0) GO TO 9
      CALL OPEN (DKI,FNAME)
C
C  LOOP RETURNS HERE TO READ A NEW ACCOUNTING RECORD
C
   4  READ (DKI,END=7) CPB,DL,TSKNM1,TSKNM2,CPUTIM,IOCNT,UIC
      SECNDS = CPUTIM*0.00001
C
C  COMPARE THE DATE AND TIME OF THE CURRENT RECORD WITH THAT OF
C  THE PREVIOUS RECORD TO DETERMINE AN INDEX TO BE USED FOR THE
C  OUTPUT OF ONE OF THREE CASES.  THE LOOP ALSO 'REMEMBERS' THE
C  NEW VALUES FOR THE NEXT RECORD.
C
      INDEXD = 7
      DO 5 K=6,1,-1
      IF (D(K) .NE. DL(K)) INDEXD = K
      D(K) = DL(K)
   5  CONTINUE
C .EJECT
C  WE NOW HAVE THREE DIFFERENT CASES FOR OUTPUT:
C
C     1) DATE OF THIS RECORD DIFFERS FROM THAT OF THE PREVIOUS RECORD.
C     2) DATE IS THE SAME, BUT THE TIME OF DAY IS DIFFERENT.
C     3) BOTH DATE AND TIME ARE THE SAME.
C
C  WE ONLY WISH TO INDICATE ITEMS THAT CHANGE, SO WE MUST SELECT
C  ONE OF THREE OUTPUT CASES.
C
      GO TO (60,60,60,61,61,61,62),INDEXD
      WRITE (LP,*) 'INVALID VALUE FOR ''INDEXD'' IN COMPUTED GOTO'
      STOP 1
C
C  NEW DATE:
C
   60 WRITE (LP,960) DL(2),MNTHS3(DL(1)),DL(3),DL(4),DL(5),DL(6),
     *  UIC,TSKNM1,TSKNM2,SECNDS,IOCNT
      GO TO 65
C
C  SAME DATE BUT DIFFERENT TIME MEANS THE BEGINNING OF A NEW
C  BUFFER DUMPING SEQUENCE.
C
   61 WRITE (LP,961) DL(4),DL(5),DL(6),UIC,TSKNM1,TSKNM2,SECNDS,IOCNT
      GO TO 65
C
C  SAME DATE, SAME TIME.
C
   62 WRITE (LP,962) UIC,TSKNM1,TSKNM2,SECNDS,IOCNT
C
C  COUNT LINES AND GO TO NEW PAGE EVERY 54 LINES
C
   65 LINES = LINES + 1
      IF (MOD(LINES,53) .NE. 0) GO TO 4
      PAGE = PAGE + 1
      WRITE (LP,98) HEADER,PAGE
      D(1) = 0
      GO TO 4
C .EJECT
C  END OF THIS DATA FILE HAS BEEN REACHED.  CLOSE THE FILE
C  BEFORE OPENING THE FILE FOR THE NEXT DAY.
C
   7  CALL CLOSE (DKI)
C
C  PRINT-OUT IS FINISHED.  CLOSE THE PRINTER TO FLUSH THE SPOOLER.
C
      WRITE (LP,95)
      CALL CLOSE (LP)
      STOP 7
C
C  A BAD EVENT VARIABLE HAS BEEN DETECTED.  ANNOUNCE IT!
C
   9  WRITE (LP,*) '*** BAD EVENT VARIABLE ***',EV
      STOP 999
  99  FORMAT (I2,1XA3,I3)
  98  FORMAT ('1',/,A80,T75,I3,///,8X,
     * 'TIME OF DUMP',T27,'UIC  TASK NAME     CPU TIME',7X,
     * 'I/O COUNT')
  97  FORMAT ('00MM00ACT',T1,I2,A2,I2)
  960 FORMAT (/,I6,1XA3,I3,T17,' 0:00:00',T17,I2,2(1XI2),
     *        T27,A3,4X2A3,F14.6,2XI12)
  961 FORMAT (T17,' 0:00:00',T17,I2,2(1XI2),
     *        T27,A3,4X2A3,F14.6,2XI12)
  962 FORMAT (T27,A3,4X2A3,F14.6,2XI12)
  95  FORMAT (//,11X,'END OF ACCOUNTING STATISTICS PRINT-OUT',//)
  94  FORMAT (9X,'ACCOUNTING STATISTICS PRINT-OUT',3X,I2,1XA3,I3,
     * T54,'   :00:00',T54,3(1XI2),T70,'PAGE')
      END
      FUNCTION MOD (I,J)
      MOD = I - (I/J)*J
      RETURN
      END
[\].
CKPNT@002
	.TITLE	CKPNT
/
/  15 MAR 78 (002; PDH) CHANGE PRIORITY OF THIS TASK TO 12 (LOWER THAN
/			'TSKTM2') AND ISSUE A FEW 'WAIT' DIRECTIVES.
/  11 FEB 78 - PAUL HENDERSON
/
/  THIS ROUTINE (TASK NAME '..CKP.', PRIORITY 12) IS INVOKED WHENEVER
/  IT IS DESIRED TO DUMP THE TASK TIMING BUFFERS, USUALLY IN
/  CONNECTION WITH A LOGIN OR LOGOUT ACTIVITY.  THE BUFFER DUMPING
/  GIVES A CHECKPOINT TIME-OF-DAY WHICH THE SUPPLEMENTARY ACCOUNTING
/  ROUTINES USE TO GENERATE CONNECT TIME VALUES.
/
TIMFLG=312		/ TASK TIMING FLAG (AND POINTER) IN EXECUTIVE
/
CKPNT	LAC	(CKPNT
	AND	(070000
	TCA
	TAD*	(TIMFLG		/ ADJUSTED ADDRESS OF
	PAX			/ TASK TIMING EVENT VARIABLE.
	LAC*	(TIMFLG		/ IS TASK TIMING ACTIVE?
	SNA
	CAL	(10		/ EXIT IF NOT.
/
	LAC	(3		/ YES.  SET TASK TIMING EV=3 TO
	DAC	0,X		/ DUMP BOTH BUFFERS
	CAL	(5		/ WE NEED TO GIVE 'TSKTM2' A	/(002)
	CAL	(5		/ CHANCE TO RESUME BEFORE THIS	/(002)
	CAL	(5		/ TASK EXITS.  ONE 'CAL (5' IS	/(002)
				/ PROBABLY SUFFICIENT, BUT 3	/(002)
				/ WON'T HURT.			/(002)
	CAL	(10
	.END	CKPNT
[\].
FIG1@@SRC
                  MONTHLY SUMMARY FOR APRIL, 1978
 
         UIC   CPU SECONDS     I/O COUNT  CONNECT MINS     CHARGE
 
               1404.891480        216571          3635   $  52.37
         ACT   2002.478760        364196           804   $  16.28
         AMS    383.816010         46877           281   $   4.81
         BOB   1989.991700        171112           920   $  17.79
         BWC    282.659111         90333           149   $  25.12
         CDA   1665.651340        236582           294   $   8.55
         CSD   2560.505000        594898           788   $  17.62
         CTY      3.493000          3664            36   $   5.89
         MKH     26.465920          5428           120   $   1.67
         MVS      9.582620          7839             6   $   0.11
         OBR    295.385521         25975            44   $   1.41
         PDH    213.510746         48478           578   $   8.30
         ROM     84.750231          9725            49   $   0.89
         SCR     82.362490         20552            55   $   0.96
         WAT      3.717680          2360           139   $   1.86
         WJG     24.283799         34800            62   $   0.89
  
  
		FIGURE 1 - SUMMARY FOR FIRST WEEK OF APRIL
[\].
FIG2@@SRC
	 8 APR 78       CPU SECONDS     I/O COUNT  CONNECT MINS
 
	                  8.630200           283        0
	         ACT     12.356300          6125       36
	         PDH      0.059370            40        1
	         WAT      0.267090           258        3
  
  
		FIGURE 2 - SUMMATION OF RAW ACCOUNTING DATA
[\].
FIG3@@SRC
    ACCOUNTING STATISTICS PRINT-OUT    8 APR 78  11:37:56    PAGE  1
 
 
       TIME OF DUMP      UIC  TASK NAME     CPU TIME       I/O COUNT
 
    8 APR 78   10:54:05         .ON.02      0.000780             0
                         ACT    USR.02      0.028430            20
                                ..CKP.      0.000820             0
               10:58:15  ACT    USR.02      0.385600            26
                         ACT    USR.02      1.835360          2857
               11:22:50  ACT    USR.02      0.025930            27
                         ACT    USR.02      1.563700           330
                         ACT    USR.02      1.582700           722
                         ACT    USR.02      1.510920           216
                         ACT    USR.02      0.004750             2
                         ACT    USR.02      2.954420           863
                         ACT    INS.02      0.007200             4
                         ACT    INS.02      0.007440             4
                         ACT    INS.02      0.869280           720
                                ACTP        0.064190            15
                                ACTP        0.357620            57
                                .ON.00      0.000780             0
                         PDH    USR.00      0.044260            25
                         PDH    USR.00      0.015110            15
                                OFF.00      0.000790             0
               11:23:05         ..CKP.      0.000840             0
               11:26:05         ACTP        0.655300            72
                                .ON.04      0.000780             0
                         WAT    USR.04      0.038120            25
                                ..CKP.      0.000820             0
               11:28:05  WAT    USR.04      0.103500           113
                         WAT    USR.04      0.038200            25
                         WAT    USR.04      0.087270            95
                                OFF.04      0.000800             0
                                ..CKP.      0.000810             0
               11:29:05  ACT    USR.02      1.580570           334
                                OFF.02      0.000790             0
                                ..CKP.      0.000830             0
               11:30:20         TDV...      7.545820           139
                                ..DOS.      0.000000             0
               11:31:19         TSKTM1      0.069660            85
                                ..CKP.      0.000810             0
 
 
            FIGURE 3 - RAW ACCOUNTING DATA STORED BY 'TSKTM2'
[\].
LOG@@@002
	.TITLE	LOG
/
/  23 FEB 78 (002; PDH) CHANGE 'REQUEST' TO 'SYNC' SO THAT ROUTINE
/			'..CKP.' RUNS AT 5 SECONDS AFTER THE NEXT MINUTE
/  11 FEB 78 - PAUL HENDERSON
/
/     THIS ROUTINE IS USED, IN CONJUNCTION WITH TASK '..CKP.', TO
/  ESTABLISH TIME OF LOGIN OR LOGOUT, SO THAT THE SYSTEM CAN
/  CALCULATE CONNECT TIME FOR THE VARIOUS USER TERMINALS.
/      THIS TASK IS BUILT WITH NAME '.ON.NN' FOR LOGIN AND
/  'OFF.NN' FOR LOGOUT, WHERE NN CORRESPONDS TO THE TERMINAL
/  NUMBER.
/     TASK '..CKP.' CAUSES THE DUMPING OF BOTH TASK TIMING BUFFERS
/  TO GENERATE AN ACCURATE CHECKPOINT TIME.
/
	.GLOBL	.IOERR
/
LOG	CAL	SYNC		/ SYNC '..CKP.			/(002)
	CAL	WAITFR						/(002)
	LAC	EV		/ VALIDATE EVENT VARIABLE	/(002)
	SPA							/(002)
	JMS*	.IOERR						/(002)
	CAL	(10		/ THEN EXIT
/
/  SYNCHRONIZE TASK '..CKP.' AT 5 SECONDS AFTER THE NEXT MINUTE,
/  TO BE EXECUTED ONLY ONCE AT ITS DEFAULT PRIORITY.
/
SYNC	14; EV;	.SIXBT	'..CKP.' ; 3; 5; 2; 0; 2; 0		/(002)
WAITFR	20;	EV						/(002)
EV								/(002)
	.END	LOG
[\].
SEEKIT003
	.TITLE	SEEKIT
/
/  11 JAN 78 (003; PDH) CORRECT BUG IN 'THREEC', REMOVE SNAPS.
/			WE STILL HAVE TO RESOLVE THE PROBLEM WITH THE
/			NAME BEING STORED IN CHARACTER CONSTANT,
/			CHAR VARIABLE, REAL OR INTEGER VARIABLE.
/  11 JAN 78 (002; PDH) ADD SOME SNAPS TO DEBUG 'THREEC'
/   9 JAN 78 - PAUL HENDERSON
/
/  ROUTINE TO BE CALLED BY A WATRAN PROGRAM.  IT PERFORMS A
/  'SEEK' ON THE DEVICE AND FILE NAME SPECIFIED BY THE CALLING
/  PROGRAM, AND RETURNS THE EVENT VARIABLE TO THE CALLING
/  PROGRAM.  AFTER THE SEEK, THE FILE IS CLOSED AGAIN TO
/  PREVENT ANY POSSIBLE I/O PROBLEMS.
/
IDX=ISZ
/
	.GLOBL	SEEKIT,.ARG
/
	.EJECT
SEEKIT	XX
	JMS*	.ARG
	JMP	.+4
LUN
NAME
EV
	LAC*	LUN
	DAC	SEEK+2		/ SET UP 'SEEK' AND
	DAC	CLOSE+2		/ 'CLOSE' CPB'S WITH LUN.
	LAC	EV
	DAC	SEEK+1		/ SET UP 'SEEK' AND
	DAC	WAITFR+1	/ 'WAITFOR' CPB'S WITH EVENT VARIABLE
/
	CLA!IAC
	PAX			/ SET XR = 1
	IDX	NAME		/ STEP PAST CHARACTER CONSTANT COUNT
				/ *** THIS IS A TEMPORARY FUDGE ***
	LAC*	NAME,X		/ GET 2ND WORD OF ASCII PAIR
	LMQ			/ AND PLACE IN MQ
	LAC*	NAME		/ 1ST WORD OF PAIR GOES IN AC
	IDX	NAME
	IDX	NAME		/ INDEX ARGUMENT POINTER
	CLX			/ XR = 0 FOR FIRST 3 CHARACTERS
	JMS	THREEC		/ CONVERT 3 CHARACTERS TO .SIXBT
	AXR	1		/ XR = 1 FOR SECOND 3 CHARACTERS
	LACQ			/ CHARACTERS 4 & 5 ARE NOW LEFT
	AND	(777760		/ JUSTIFIED IN MQ.  TRIM OFF
	DAC	CHAR		/ GARBAGE AND STORE TEMPORARILY
	LAC*	NAME		/ GET 2 MORE CHARACTERS AND
	LRS	16		/ SHIFT SO THEY WILL
	XOR	CHAR		/ COMBINE WITH CHARACTERS 4 & 5.
				/ THESE NOW LOOK LIKE AN ASCII
				/ PAIR STORED IN AC, MQ.
	JMS	THREEC		/ PROCESS CHARACTERS 4-6
	LAC*	NAME,X		/ GET SECOND WORD OF ASCII PAIR
	LMQ
	LAC*	NAME		/ GET FIRST WORD
	LLS	7		/ SHIFT OUT PREVIOUSLY USED 6TH CHAR
	AXR	1		/ SET XR = 2 IN ORDER TO
	JMS	THREEC		/ PROCESS CHARACTERS 7-9
/
	CAL	SEEK		/ SEEK SPECIFIED FILE
	CAL	WAITFR		/ WAIT UNTIL SEEK COMPLETE
	CAL	CLOSE		/ CLOSE FILE (IN CASE OPENED)
	JMP*	SEEKIT		/ THEN RETURN TO CALLING PROGRAM
/
	.EJECT
/  SUBROUTINE TO PROCESS ASCII CHARACTERS STORED IN AC & MQ, AND
/  STORE THEM IN .SIXBT IN THE 'SEEK' CPB, INDEXED BY THE VALUE
/  IN THE XR, WHICH IS SET EXTERNALLY.
/
THREEC	XX
	LLS	1		/ DISCARD 7TH BIT OF CHARACTER
	DAC	CHAR		/ SAVE INTERMEDIATE RESULT
	AND	(770000		/ SELECT 1ST CHARACTER ONLY
	SAD	(400000		/ IS IT A SPACE?
	CLA			/ CONVERT SPACE TO NULL
	DAC	SEEK+3,X	/ STORE IN 'SEEK' CPB
	LAC	CHAR		/ RETRIEVE INTERMEDIATE RESULT
	LLS	1
	DAC	CHAR
	AND	(007700		/ SELECT 2ND CHARACTER
	SAD	(004000
	CLA
	XOR	SEEK+3,X
	DAC	SEEK+3,X
	LAC	CHAR
	LLS	1		/ 4TH (& 5TH) CHARACTERS NOW
	AND	(77		/ LEFT JUSTIFIED IN MQ
	SAD	(40
	CLA
	XOR	SEEK+3,X
	DAC	SEEK+3,X
	JMP*	THREEC
/
	.EJECT
/  VARIABLES AND CPB'S
/
CHAR
/
SEEK	3200;	EV;	LUN;	.BLOCK	3
WAITFR	20;	EV
CLOSE	3400;	0;	LUN
	.END
[\].
SLIDESSRC
C     .TITLE SLIDES
C
C  17 APR 78 - PAUL HENDERSON
C
      INTEGER DK,LP
      CHARACTER*9 NAME(16)/
     *  '01    SRC','02    SRC','03    SRC','04    SRC',
     *  '05    SRC','06    SRC','07    SRC','08    SRC',
     *  '09    SRC','10    SRC','11    SRC','12    SRC',
     *  'FIG1  SRC','FIG2  SRC','FIG3  SRC','16    SRC'/
      CHARACTER*80 LINE
C
      COMMON /LL/LP,DK,LINE
C
      LP = 6
      DK = 15
      CALL OPEN (LP,'LIST  LST')
      DO 40 I=1,3
      WRITE (LP,99)
      DO 30 J=1,4
      K = (I-1)*4 + J
      CALL OPEN (DK,NAME(K))
  10  READ (DK,98,END=20) LINE
      CALL PRINT
      GO TO 10
C
  20  CALL CLOSE (DK)
      WRITE (LP,97)
      WRITE (LP,97)
      WRITE (LP,97)
  30  CONTINUE
  40  CONTINUE
      WRITE (LP,99)
      CALL OPEN (DK,NAME(13))
  50  READ (DK,98,END=55) LINE
      CALL PRINTF
      GO TO 50
  55  CALL CLOSE (DK)
      WRITE (LP,99)
      CALL OPEN (DK,NAME(14))
  60  READ (DK,98,END=65) LINE
      CALL PRINTF
      GO TO 60
  65  CALL CLOSE (DK)
      WRITE (LP,99)
      CALL OPEN (DK,NAME(15))
  70  READ (DK,98,END=75) LINE
      CALL PRINTF
      GO TO 70
  75  CALL CLOSE (DK)
      WRITE (LP,99)
      CALL OPEN (DK,NAME(16))
  80  READ (DK,98,END=85) LINE
      CALL PRINT
      GO TO 80
  85  CALL CLOSE (DK)
      CALL CLOSE (LP)
      STOP 7
  99  FORMAT ('1 ')
  98  FORMAT (A80)
  97  FORMAT ('  ')
      END
      SUBROUTINE PRINT
      INTEGER DK,LP
      CHARACTER*80 LINE
C
      COMMON /LL/LP,DK,LINE
C
      WRITE (LP,99) LINE
      WRITE (LP,98) LINE
      WRITE (LP,98) LINE
      WRITE (LP,98) LINE
      RETURN
  99  FORMAT (' ',T20,A80)
  98  FORMAT ('+',T20,A80)
      END
      SUBROUTINE PRINTF
      INTEGER DK,LP
      CHARACTER*80 LINE
      COMMON /LL/LP,DK,LINE
C
      WRITE (LP,99) LINE
      WRITE (LP,98) LINE
C      WRITE (LP,98) LINE
C      WRITE (LP,98) LINE
      RETURN
  99  FORMAT (' ',A80)
  98  FORMAT ('+',A80)
      END
[\].
TSKTM1011
	.TITLE	TSKTM1
/
/  11 FEB 78 (011; PDH) ADD 'CHECKPOINT' FACILITY FOR LOGGING IN;
/			INCREASE BUFFER SIZE TO 26
/  18 JAN 78 (010; PDH) FIX UP SOME FILE MANAGEMENT ERRORS
/  18 JAN 78 (009; PDH) CHECK FOR -6, -13 EV'S IN 'WTFOR'
/  17 JAN 78 (008; PDH) ADD CODE TO UPDATE "TO-DAY'S" ACCOUNTING
/			FILE WHEN ONE EXISTS (AFTER 'DOS', 'SAVE').
/  12 JAN 78 (007; PDH) PERFORM RELOCATION OF 'TSKTM2' VIA XR
/  11 JAN 78 (006; PDH) WAIT UNTIL 'TSKTM2' LOADED INTO CORE
/			BEFORE RELOCATING THE ADDRESSES.
/  11 JAN 78 (005; PDH) CHANGE 'WTFOR' TO SUPPLY BETTER INFORMATION
/   9 JAN 78 (004; PDH) RELOCATE ADDRESS IN CONTROL TABLE
/   9 JAN 78 (003; PDH) WE GOOFED WITH THE 'PARINF' CPB
/   9 JAN 78 (002; PDH) ADD 'DEBUG', 'SNAP' AND 'SUSPND'
/   6 JAN 78 - PAUL HENDERSON
/
/  THIS ROUTINE IS SECTION 1 OF A 2-SECTION TASK TO PERFORM
/  TASK TIMING.  ITS FUNCTION IS TO REQUEST THE EXECUTION OF
/  THE SECOND SECTION (TSKTM2), THEN DETERMINE THE BASE ADDRESS
/  OF ITS PARTITION SO THAT IT CAN RELOCATE THE ADDRESSES IN THE
/  TASK TIMING CONTROL TABLE.  ONCE THESE ADDRESSES HAVE BEEN
/  RELOCATED, IT IS SAFE TO SET 'TIMFLG' IN THE EXECUTIVE.
/     THIS SECTION WILL BE TASK BUILT WITH A PRIORITY OF 50 TO
/  RUN IN THE MCR PARTITION.
/
/     FOR DEBUGGING, THE SYMBOL
/DEBUG=1		/ IS DEFINED.
/
TIMFLG=312
IDX=ISZ
	.DEC							/(008)
DKI=57			/ DISK INPUT FILE			/(008)
DKO=58								/(008)
	.OCT							/(008)
I=400000							/(008)
IRS=711000							/(008)
IMP=711400							/(008)
IDV=712000							/(008)
ILD=713000							/(008)
IST=713600							/(008)
UNSWQ=715270							/(008)
/
	.NOLST	/ DON'T LIST SNAP DEFINITION IF NOT DEBUG	/(002)
	.IFDEF	DEBUG						/(002)
	.LST							/(002)
TT=3								/(002)
	.DEFIN	SNAP,ID,CODE,BEGIN,END				/(002)
	.GLOBL	.SNAP						/(002)
BG=BEGIN-1							/(002)
	.DEC							/(002)
ID2=ID								/(002)
	.OCT							/(002)
	JMS*	.SNAP						/(002)
	CODE+0*1000 ID2&777					/(002)
	BG							/(002)
	END-BG*777777						/(002)
	.ENDM							/(002)
	.ENDC							/(002)
	.LST							/(002)
/
	.EJECT							/(004)
	.GLOBL	.IOERR
/
TSKTM1	CAL	DATE		/ GET TO-DAY'S DATE		/(008)
	CAL	DELETM		/ 'UPDATE ACT' PROBABLY NOT	/(010)
	JMS	WTFOR		/ THERE, BUT DELETE IT ANYWAY	/(010)
	CAL	RENAME		/ ATTEMPT TO RENAME THE FILE	/(008)
	JMS	WTFOR		/ GENERATED ON LAST 'DOS', OR	/(008)
	SAD	(-13		/ OR 'SAVE'.			/(008)
	JMP	PARTIT		/ NO FILE. BYPASS UPDATING.	/(008)
	CAL	CLOSTM		/ RENAMING NECESSARY TO PREVENT	/(010)
	JMS	WTFOR		/ MAJOR I/O DISASTER		/(008)
	LAC	DATE+3		/ GET DAY OF MONTH		/(008)
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL	/(008)
	LLSS	11		/ SHIFT TO CORRECT PLACE	/(008)
	DAC	S.NM1						/(008)
/
	LAC	DATE+4		/ GET YEAR			/(008)
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL	/(008)
	LRSS	11		/ YEAR NOW LEFT JUSTIFIED IN MQ	/(008)
/
	LAC	DATE+2		/ GET MONTH			/(008)
	PAX							/(008)
	LAC	MONTHS-1,X	/ GET 2-CHARACTER MONTH DESIGNATOR /(008)
	LRSS	6		/ INCLUDE 1 CHARACTER WITH OTHERS IN MQ /(008)
	XOR	S.NM1		/ AND OTHER WITH PREVIOUS EFFORT /(008)
	DAC	S.NM1		/ PUT IN 'SEEK' CPB		/(008)
	DAC	C.NM1		/ AS WELL AS THE 'CLOSE'	/(008)
	DAC	D.NM1		/ AND 'DELETE' CPB'S		/(008)
	LACQ							/(008)
	DAC	S.NM2		/ FILE NAMES NOW COMPLETELY READY /(008)
	DAC	C.NM2						/(008)
	DAC	D.NM2						/(008)
/
	.EJECT
	CAL	ENTER		/ OPEN FILE 'TEMPRY ACT'	/(008)
	JMS	WTFOR						/(008)
	CAL	SEEK		/ SEE IF WE HAVE DONE ANY	/(008)
	JMS	WTFOR		/ ACCOUNTING YET TO-DAY.	/(008)
	SAD	(-13						/(008)
	JMP	APPEND		/ NO.  NOTHING TO UPDATE.	/(008)
/
	JMS	MOVE		/ COPY TO-DAY'S STATISTICS	/(008)
	CAL	CLOSEI						/(008)
	JMS	WTFOR						/(008)
APPEND	CAL	SEEKTM		/ 'UPDATE ACT'			/(008)
	JMS	WTFOR						/(008)
	JMS	MOVE		/ APPEND THE LATEST INFO	/(008)
	CAL	CLOSEI		/ CLOSE INPUT FILE 'UPDATE ACT'	/(010)
	JMS	WTFOR						/(010)
/
	CAL	CLOSE		/ CLOSE TEMPORARY OUTPUT FILE	/(008)
	JMS	WTFOR						/(008)
	CAL	DELETM		/ DELETE FILE 'UPDATE ACT'	/(010)
	JMS	WTFOR						/(010)
	CAL	DELETE		/ DELETE ORIGINAL INPUT FILE	/(008)
	JMS	WTFOR						/(008)
	CAL	RENAME		/ RENAME TEMPORARY FILE TO ORIG NAME /(008)
	JMS	WTFOR						/(008)
	CAL	CLOSE		/ RENAMING OCCURS ON THE 'CLOSE' /(008)
	JMS	WTFOR						/(008)
/
	.EJECT
PARTIT	CAL	PARINF		/ INVESTIGATE PARTITION 'TSKTIM' /(008)
	JMS	WTFOR						/(006)
	.IFDEF	DEBUG						/(006)
	SNAP	1,1,P.BA,P.SZ					/(006)
	JMS	SUSPND						/(006)
	.ENDC							/(006)
	LAC	WTFOR		/ 'WTFOR' NOW CONTAINS A VALID	/(007)
	AND	(070000		/ ADDRESS FOR GENERATING	/(007)
	TCA			/ THE XR ADJUSTMENT FACTOR	/(007)
	DAC	XRADJ						/(007)
	LAC	P.BA		/ TO DETERMINE WHEN REQUESTED	/(006)
	AAC	20		/ TASK HAS BEEN LOADED INTO	/(006)
	TAD	XRADJ		/ CORE, WE WILL SET THE EVENT	/(007)
	PAX			/ VARIABLE LOCATION NON-ZERO,	/(007)
	DAC	PNTR		/ THEN WAIT FOR IT TO BECOME 0	/(006)
	LAW	-1						/(006)
	DAC	0,X		/ SET EV LOCATION		/(007)
/
	CAL	REQ		/ REQUEST TASK 'TSKTM2'		/(007)
	JMS	WTFOR
	.IFDEF	DEBUG						/(002)
	SNAP	2,401		/ SNAP REGISTERS		/(002)
	JMS	SUSPND		/ THEN SUSPEND TASK		/(002)
	.ENDC							/(002)
/
WAIT	LAC	PNTR		/ RESTORE XR LOST DURING 'CAL'	/(007)
	PAX							/(007)
	LAC	0,X		/ HAS TASK BEEN LOADED INTO	/(007)
	SNA			/ PARTITION YET?		/(006)
	JMP	LOADED		/ EV IS ZERO WHEN LOADED	/(006)
	CAL	MARK		/ NOT LOADED.  MARK TIME FOR	/(006)
	JMS	WTFOR		/ 1 CLOCK TICK, THEN		/(006)
	JMP	WAIT		/ TRY AGAIN			/(006)
/
LOADED	AXR	1		/ POINT TO 1ST ADDRESS IN	/(007)
				/ TASK TIMING CONTROL TABLE	/(006)
	LAW	-5		/ RELOCATE THE 5 ADDRESSES	/(004)
	DAC	CNTR		/ IN THE TIMING CONTROL TABLE	/(004)
/
LOOP	LAC	0,X		/ GET ADDRESS			/(007)
	TAD	P.BA		/ ADD RELOCATION FACTOR		/(004)
	DAC	0,X		/ ADDRESS NOW REAL-WORLD ADDRESS /(007)
	AXR	1						/(007)
	ISZ	CNTR						/(004)
	JMP	LOOP						/(004)
/
	.EJECT
	.IFDEF	DEBUG						/(007)
	LAC	P.BA		/ INSERT ADDRESS OF TIMING	/(007)
	AAC	20		/ CONTROL TABLE IN 'SNAP'	/(007)
	DAC	SNAP3+2		/ MACRO EXPANSION		/(007)
SNAP3	SNAP	3,0,1,10	/ SNAP THE RELOCATED TABLE	/(007)
	JMS	SUSPND						/(007)
	.ENDC							/(007)
	LAC	P.BA
	AAC	20		/ NORMAL MODE TASKS BEGIN AT 20
	DAC*	(TIMFLG		/ SET 'TIMFLG' TO BEGIN TASK TIMING
	.IFDEF	DEBUG						/(002)
	SNAP	4,401						/(002)
	JMS	SUSPND						/(002)
	.ENDC							/(002)
	CAL	REQCKP		/ CHECKPOINT START-UP IN CASE	/(011)
		/ WE NEED TO GENERATE A LOGIN TIME FOR SOMEONE	/(011)
	CAL	(10		/ THEN EXIT.
/
WTFOR	XX
	CAL	WAITFR
	LAC	EV
	SMA							/(005)
	JMP*	WTFOR
	SAD	(-13		/ 'FILE NOT FOUND'?		/(009)
	JMP*	WTFOR		/ THIS WILL BE ACCEPTED		/(009)
	SAD	(-6		/ IGNORE UNIMPLEMENTED FUNCTION	/(009)
	JMP*	WTFOR						/(009)
/
	LAC	WTFOR		/ INSERT ADDRESS INTO		/(005)
	DAC*	.IOERR		/ '.IOERR'			/(005)
	LAC	.IOERR						/(005)
	IAC			/ NOW POINT TO SECOND LOCATION	/(005)
	DAC	WTFOR						/(005)
	LAC	EV		/ RETRIEVE BAD EV		/(005)
	JMP*	WTFOR		/ GO TO '.IOERR' (NEVER RETURN)	/(005)
/
/  SUBROUTINE TO COPY A FILE, RECORD BY RECORD FROM ONE LUN TO ANOTHER.
/
MOVE	XX
READ	CAL	READL		/ READ A RECORD FROM INPUT FILE
	JMS	WTFOR
	LAC	LINE
	AND	(7
	SAD	(5
	JMP*	MOVE		/ RETURN ON END OF INPUT FILE
	CAL	WRITEL		/ COPY RECORD TO OUTPUT FILE
	JMS	WTFOR
	JMP	READ
/
	.EJECT
/  SUBROUTINE TO CONVERT AN OCTAL (BINARY) NUMBER TO DECIMAL, SELECT THE
/  TWO LEAST SIGNIFICANT DIGITS, AND PLACE THEM IN THE AC & MQ
/  SO THAT SHIFTING LEFT BY 3 PLACES THEM IN THE AC (.SIXBT CODE).
/
/  CALLING SEQUENCE:
/
/	LAC	BINVAL
/	JMS	OCTDEC
/	(RETURN)		/ .SIXBT VALUES IN AC, MQ
/
OCTDEC	XX
	DAC	CHAR
	LAW	-4
	DAC	WTFOR		/ CONVERT 4 DIGITS
	LAC	(DIVISR
	DAC	FPADR1
	LAC	(ANS
	DAC	FPADR2
	ILD;	CHAR
CONVRT	IDV;FPADR1
	IST;FPADR2		/ QUOTIENT IS NEXT CONVERTED DIGIT
/***	UNSWQ;	0		/ REMAINDER IS NEXT DIVIDEND
	IMP;	I+FPADR1	/*** PROGRAM AROUND HARDWARE FAULT
	IRS;	CHAR		/***
	IST;	CHAR		/*** END OF FUDGE
	IDX	FPADR1		/ POINT TO NEXT DIVISOR
	IDX	FPADR2
	ISZ	WTFOR
	JMP	CONVRT
	LAC	ANS+3		/ GET LEAST SIGNIFICANT ANSWER DIGIT
	XOR	(60		/ CONVERT TO .SIXBT ASCII
	CLQ!LRSS 6		/ SHIFT INTO MQ
	LAC	ANS+2		/ GET OTHER DESIRED DIGIT
	XOR	(60		/ CONVERT IT TO .SIXBT ASCII
	LLSS	3
	JMP*	OCTDEC		/ LEAVE WITH ANSWER IN AC, MQ
/
	.DEC
DIVISR	1000;	100;	10;	1
ANS	.BLOCK	4;	.OCT
	.EJECT
	.NOLST							/(002)
	.IFDEF	DEBUG						/(002)
	.LST							/(002)
SUSPND	XX							/(002)
	CAL	WRSUS		/ 'TSKTM1' SUSPENDED		/(002)
	JMS	WTFOR						/(002)
	CAL	(6		/ SUSPEND THE TASK		/(002)
	JMP*	SUSPND						/(002)
/
WRSUS	2700;	EV;	TT; 2; SUSMSG				/(002)
SUSMSG	SM-.*400+2; 0; .ASCII "'TSKTM1' SUSPENDED"<15> ;SM=.	/(002)
	.ENDC							/(002)
	.LST							/(002)
/
/  VARIABLES AND CPB'S
/
EV;XRADJ;P.BA;P.SZ		/ P.BA & P.SZ MUST BE CONSECUTIVE
PNTR=P.SZ;CNTR=EV						/(004)
WAITFR	20;	EV
PARINF	26;	EV;	.SIXBT	'TSKTIM' ; P.BA			/(003)
MARK	13;	EV;	1; 1
REQ	01;	EV;	.SIXBT	'TSKTM2' ; 13
REQCKP	01;	0;	.SIXBT	'..CKP.' ; 2
DATE	24;	0;	.BLOCK	6
ENTER	3300;	EV;	DKO; .SIXBT 'TEMPRYACT'
SEEK	3200;	EV;	DKI;S.NM1;S.NM2; .SIXBT 'ACT'
SEEKTM	3200;	EV;	DKI; .SIXBT 'UPDATEACT'
READL	2600;	EV;	DKI; 0; LINE; 26
WRITEL	2700;	EV;	DKO; 0; LINE
CLOSEI	3400;	EV;	DKI
CLOSE	3400;	EV;	DKO;C.NM1;C.NM2; .SIXBT 'ACT'
CLOSTM	3400;	EV;	DKO; .SIXBT 'UPDATEACT'			/(010)
DELETE	3500;	EV;	DKI;D.NM1;D.NM2; .SIXBT 'ACT'
DELETM	3500;	EV;	DKI; .SIXBT 'UPDATEACT'			/(010)
RENAME	3700;	EV;	DKO; .SIXBT 'TEMPRYACT'
LINE	.BLOCK	26
CHAR=LINE+1
/
MONTHS	.SIXBT	'@JA'
	.SIXBT	'@FE'
	.SIXBT	'@MR'
	.SIXBT	'@AP'
	.SIXBT	'@MY'
	.SIXBT	'@JN'
	.SIXBT	'@JL'
	.SIXBT	'@AU'
	.SIXBT	'@SE'
	.SIXBT	'@OC'
	.SIXBT	'@NV'
	.SIXBT	'@DC'
/
	.END	TSKTM1
[\].
TSKTM2014
	.TITLE	TSKTM2
/
/  15 MAR 78 (014; PDH) WHEN TASK TIMING EVENT VARIABLE IS NEGATIVE,
/			DUMP BOTH BUFFERS AND CONTINUE, DON'T ABORT.
/  11 FEB 78 (013; PDH)	CHANGE I/O COUNT TO I*4 (INCREASES BUFFER
/			SIZE TO 26); DUMP ADDITIONAL TASK '..DOS.'
/			WHEN 'EXITFL' SET; DUMP BOTH BUFFERS IF
/			TIMING EV=3 (USED FOR CHECKPOINTING)
/  31 JAN 78 (012; PDH) DON'T LIST UNDEFINED VARIABLES; IMPROVE
/			ADDRESS REPORTING FOR '.IOERR'.
/  31 JAN 78 (011; PDH) SET ESIZE=6 FOR MULTIACCESS
/  23 JAN 78 (010) SET 'BUFPT' CORRECTLY WHEN 'EXITFL' SET
/  18 JAN 78 (009; PDH) NEED TO SAVE XR IN 'DUMP' FOR I/O
/  17 JAN 78 (008; PDH) ALLOW FOR 'DOS' AND 'SAVE' TO PREMATURELY
/			HAVE THE BUFFERS DUMPED, AND THIS TASK TO EXIT.
/  16 JAN 78 (007; PDH) INCREASE 'ENTRYS' TO 64 (DECIMAL)
/  12 JAN 78 (006; PDH) DON'T INCLUDE 'POLLER', 'NODCNT', 'AUTORM'
/  12 JAN 78 (005; PDH) USE CORRECT ADDRESS FOR 'XRADJ' CALCULATION;
/			REMOVE SNAPS
/  11 JAN 78 (004; PDH) ADD SOME SNAPS FOR DEBUGGING
/  11 JAN 78 (003; PDH) USE NEW ADDRESS FOR BUFFER DUMPING
/   9 JAN 78 (002; PDH) SET ESIZE=4 TO DEBUG WITH XVM/RSX V1A
/   5 JAN 78 - PAUL HENDERSON (DERIVED, IN PART, FROM 'SAVE 007'
/				OF THE 'ARK...' TASK)
/
/     THIS IS SECTION 2 OF THE 2-SECTION TASK TO PERFORM TASK
/  TIMING AND ACCOUNTING.  ITS FUNCTION IS TO RECORD, ON DISK,
/  THE INFORMATION STORED IN THE TASK TIMING BUFFERS BY THE
/  'EXIT' PROCESSOR OF THE EXECUTIVE.  THE 'EXIT' PROCESSOR HAS
/  BEEN MODIFIED TO INCLUDE I/O COUNT AND USER'S UIC INFORMATION,
/  AS WELL AS THE USUAL TASK NAME AND CPU TIME INFORMATION.
/     THE INFORMATION STORED IN THE TASK TIMING BLOCK IS AS FOLLOWS:
/
/	WORD 0	TASK NAME, FIRST HALF
/	     1	TASK NAME, SECOND HALF
/	WORD 2	DOUBLE INTEGER, NUMBER OF 10 USEC XM CLOCK
/	     3	TICKS OF CPU TIME FOR TASK
/	WORD 4	I/O COUNT
/	WORD 5	UIC
/
/     IT HAS BEEN ESTIMATED THAT WITH A BUFFER SIZE LARGE ENOUGH
/  TO CONTAIN 16 (DECIMAL) ENTRIES, THERE WILL BE SUFFICIENT
/  SYSTEM ACTIVITY WITH 'POLLER' (EVERY MINUTE), 'NODCNT' (EVERY
/  2 MINUTES) AND 'AUTORM' (EVERY 5 MINUTES) TO DUMP THE TIMING
/  BUFFERS ABOUT EVERY 10 MINUTES.  OBVIOUSLY WITH USER ACTIVITY,
/  THE DUMPING WILL OCCUR MORE OFTEN.
/
	.EJECT
/     THE DUMPING WILL BE DONE IN OTS BINARY, WHICH GREATLY
/  SIMPLIFIES THE FORMATTING REQUIRED BY THIS TASK.  EACH LOGICAL
/  RECORD WILL CONTAIN THE ACCOUNTING INFORMATION FOR A SINGLE
/  TASK AS FOLLOWS:
/
/ WORD	 0	13000	HEADER WORD 0
/	 1	0	HEADER WORD 1 (CHECKSUM)
/	 2	400000	OTS BINARY FLAG WORD
/ WORD	 3	24	'DATE' CPB INVOKED AT BEGINNING OF BUFFER DUMP
/	 4	0	NO EVENT VARIABLE ADDRESS
/	 5		MONTH
/	 6		DAY
/	 7		YEAR
/	10		HOUR
/	11		MINUTE
/	12		SECOND
/ WORD	13		FIRST HALF OF TASK NAME (A3)
/	14
/	15		SECOND HALF OF TASK NAME (A3)
/	16
/ WORD	17		XM CLOCK OVERFLOWS
/	20		XM CLOCK TICKS ABOVE OVERFLOW
/ WORD	21		I/O COUNT (I*4)
/	22
/ WORD	23		UIC (A3)
/	24
/	25		UNUSED WORD
/
/
/  EVERY TIME THE BUFFERS ARE DUMPED, A FILE WITH A NAME OF THE
/  FORM 'DDMMYY ACT' IS OPENED.  IF THE FILE EXISTS, ITS CURRENT
/  CONTENTS ARE COPIED FROM THE INPUT LUN TO A TEMPORARY FILE ON
/  THE OUTPUT LUN, THEN THE ABOVE INFORMATION IS APPENDED.  FINALLY,
/  THE ORIGINAL FILE IS DELETED, AND THE TEMPORARY FILE IS
/  GIVEN THE ORIGINAL FILE NAME.  IT FOLLOWS, OF COURSE, THAT THE
/  INPUT AND OUTPUT LUN'S MUST POINT TO THE SAME DISK AND UFD,
/  PREFERABLY 'SY <ACT>'.
/
	.EJECT
	.DEC
ENTRYS=64		/ NUMBER OF TASK EXIT ENTRIES PER BUFFER
ESIZE=6			/ NUMBER OF WORDS PER ENTRY (ENTRY SIZE)
/ESIZE=4			/ PROPER SIZE FOR XVM/RSX V1A	/(002)
BUFSIZ=ESIZE*ENTRYS
DKI=57
DKO=58
	.OCT
I=400000
IDX=ISZ
ECLA=641000
IRS=711000
IMP=711400
IDV=712000
ILD=713000
IST=713600
UNSWQ=715270
/
	.GLOBL	.IOERR
/
	.EJECT
/  THE FIVE ADDRESSES IN THE CONTROL TABLE ARE RELOCATED BY
/  'TSKTM1' TO POINT TO REAL ADDRESS, NOT VIRTUAL ADDRESSES.
/
CTLTB	0			/ TASK TIMING EVENT VARIABLE
	START1			/ START OF BUFFER 1
	END1
	START2			/ START OF BUFFER 2
	END2
	START1			/ BUFFER POINTER USED BY 'EXIT'
EXITFL	0	/ LOCATION SET NON-ZERO WHEN THIS TASK IS TO	/(008)
		/ PERFORM A FINAL BUFFER DUMP, THEN EXIT.	/(008)
		/ THIS LOCATION SHOULD NOT BE SET UNLESS TASK	/(008)
		/ TIMING HAS BEEN DISABLED.			/(008)
/
TSKTM2	LAC	(START1						/(005)
	AND	(070000		/ CALCULATE XR ADJUSTMENT FACTOR
	TCA
	DAC	XRADJ
/
TMWAIT	CAL	TMWTFR		/ WAIT FOR BUFFER TO FILL
	CAL	DATE		/ GET DATE AND TIME FROM SYSTEM
	LAC	EXITFL		/ CHECK 'DUMP & EXIT' FLAG	/(008)
	SNA
	JMP	NORMAL		/ CONTINUE NORMAL OPERATION.	/(008)
/
	LAW	-ENTRYS*2-1	/ DUMP BOTH BUFFERS AND		/(013)
	DAC	COUNT		/ THE 'LOGOUT' ENTRY '..DOS.'	/(013)
	CAL	ENTER		/ IN THIS SEQUENCE, WE WILL	/(008)
	JMS	WTFOR		/ WRITE OUT ONLY THE CURRENT	/(008)
	LAC	(START1		/ DATA, BEGINNING WITH BUFFER 1	/(010)
	JMP	DUMP2		/ THE FILE WILL NOT BE UPDATED	/(010)
/
	.EJECT
DBOTH	LAC	(START1-ESIZE	/ BEGINNING WITH BUFFER 1,	/(013)
	DAC	BUFPT		/ PREPARE TO DUMP BOTH BUFFERS	/(013)
	LAW	-ENTRYS*2					/(013)
	JMP	SETCNT						/(013)
/
NORMAL	LAC	CTLTB						/(008)
	DZM	CTLTB		/ ZEROING EV HERE MINIMIZES CHANCE
				/ OF LOSING ACCOUNTING DATA.
	SAD	(3		/ WE HAVE BEEN CHECKPOINTED.	/(013)
	JMP	DBOTH		/ MUST DUMP BOTH BUFFERS	/(013)
	SPA!CLL!RAR		/ VALIDATE TIMING EVENT VARIABLE
	JMP	DBOTH		/ BAD SCENE!  DUMP BOTH BUFFERS	/(014)
				/ AND CARRY ON AS BEST WE CAN	/(014)
	LAC	(START1		/ ASSUME WE DUMP BUFFER 1	/(003)
	SNL
	LAC	(START2		/ EV WAS EVEN - DUMP BUFFER 2	/(003)
	AAC	-ESIZE		/ POINTER INDEXED AT START OF LOOP
	DAC	BUFPT
	LAW	-ENTRYS
SETCNT	DAC	COUNT		/ INITIALIZE COUNTER
/
	.EJECT
	LAC	DATE+3		/ GET DAY OF MONTH
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL
	LLSS	11		/ SHIFT TO CORRECT PLACE
	DAC	S.NM1
/
	LAC	DATE+4		/ GET YEAR
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL
	LRSS	11		/ YEAR NOW LEFT JUSTIFIED IN MQ
/
	LAC	DATE+2		/ GET MONTH
	PAX
	LAC	MONTHS-1,X	/ GET 2-CHARACTER MONTH DESIGNATOR
	LRSS	6		/ INCLUDE 1 CHARACTER WITH OTHERS IN MQ
	XOR	S.NM1		/ AND OTHER WITH PREVIOUS EFFORT
	DAC	S.NM1		/ PUT IN 'SEEK' CPB
	DAC	C.NM1		/ AS WELL AS THE 'CLOSE'
	DAC	D.NM1		/ AND 'DELETE' CPB'S
	LACQ
	DAC	S.NM2		/ FILE NAMES NOW COMPLETELY READY
	DAC	C.NM2
	DAC	D.NM2
/
	CAL	ENTER		/ OPEN FILE 'TEMPRY ACT'
	JMS	WTFOR
	CAL	SEEK		/ SEE IF WE HAVE DONE SOME ACCOUNTING
	JMS	WTFOR		/ YET TO-DAY.
	SAD	(-13
	JMP	DUMP		/ NO.  NOTHING TO UPDATE
/
MOVE	CAL	READL		/ READ A RECORD FROM INPUT FILE
	JMS	WTFOR
	LAC	LINE
	AND	(7
	SAD	(5
	JMP	EOF		/ END OF INPUT FILE
	CAL	WRITEL		/ COPY RECORD TO OUTPUT FILE
	JMS	WTFOR
	JMP	MOVE
/
EOF	CAL	CLOSEI		/ CLOSE INPUT FILE
	JMS	WTFOR
/
	.EJECT
/  THIS SECTION APPENDS THE NEW ACCOUNTING INFORMATION TO THE
/  DATA ALREADY STORED PREVIOUSLY.  IF THE TASK NAME IS 'POLLER',
/  'NODCNT', 'AUTORM' OR IS AN MCR FUNCTION, DO NOT INCLUDE IT.
/
DUMP	LAC	BUFPT
	AAC	ESIZE
DUMP2	DAC	BUFPT		/ INDEX BUFFER POINTER
	TAD	XRADJ
	DAC	XRSAVE		/ SAVE XR FOR RESTORATION AFTER	/(009)
	PAX			/ I/O OPERATION
	LAC	0,X		/ GET FIRST HALF OF TASK NAME
	SNA							/(008)
	JMP	NOLIST		/ DON'T INCLUDE BLANK ENTRY	/(008)
	SAD	(400000		/ OTHER VERSION OF BLANK ENTRY	/(012)
	JMP	NOLIST						/(012)
	SAD	DOTS						/(006)
	JMP	NOLIST		/ DON'T INCLUDE MCR FUNCTION	/(006)
	SAD	POLLER						/(006)
	JMP	POLL2		/ OR 'POLLER'			/(006)
	SAD	NODCNT						/(006)
	JMP	NODE2		/ OR 'NODCNT'			/(006)
	SAD	AUTORM						/(006)
	JMP	AUTO2		/ OR 'AUTORM'			/(006)
LIST	JMS	ASCII		/ CONVERT TO A3 FORMAT AND	/(006)
	TSKNM1			/ STORE IT IN OUTPUT BUFFER
	LAC	1,X		/ SECOND HALF OF TASK NAME
	JMS	ASCII
	TSKNM2
	LAC	2,X		/ XM CLOCK OVERFLOWS
	DAC	MOSTXM
	LAC	3,X		/ XM CLOCK TICKS
	DAC	LEASTXM
	LAC	4,X		/ I/O COUNT
	DAC	IOCNT+1						/(013)
	LAC	5,X		/ UIC OF TASK
	JMS	ASCII
	UIC
	CAL	WRITE		/ WRITE DATA TO DISK
	JMS	WTFOR
NOLIST	LAC	XRSAVE		/ RESTORE XR			/(009)
	PAX							/(009)
	DZM	0,X		/ INDICATE ENTRY HAS BEEN USED	/(008)
	ISZ	COUNT
	JMP	DUMP		/ DO NEXT BUFFER ENTRY
/
	.EJECT
	CAL	CLOSE		/ CLOSE TEMPORARY OUTPUT FILE
	JMS	WTFOR
	LAC	EXITFL		/ IF 'EXITFL' IS SET, THEN	/(008)
	DZM	EXITFL		/ TASK TIMING IS BEING		/(008)
	SZA			/ TERMINATED AT THIS TIME, AND	/(008)
	CAL	(10		/ THE TASK IS TO EXIT.		/(008)
	CAL	DELETE		/ DELETE ORIGINAL INPUT FILE
	JMS	WTFOR
	CAL	RENAME		/ RENAME TEMPORARY FILE TO ORIG NAME
	JMS	WTFOR
	CAL	CLOSE		/ RENAMING OCCURS ON THE 'CLOSE'
	JMS	WTFOR
	JMP	TMWAIT		/ WE ARE DONE.  WAIT FOR BUFFERS TO FILL AGAIN.
/
POLL2	LAC	1,X		/ CHECK 2ND HALF FOR 'LER'	/(006)
	SAD	POLLER+1					/(006)
	JMP	NOLIST						/(006)
LST	LAC	0,X		/ TASK NAME IS VALID.  RETRIEVE	/(006)
	JMP	LIST		/ 1ST HALF OF NAME & PROCESS IT	/(006)
/
NODE2	LAC	1,X		/ CHECK 2ND HALF FOR 'CNT'	/(006)
	SAD	NODCNT+1					/(006)
	JMP	NOLIST						/(006)
	JMP	LST						/(006)
/
AUTO2	LAC	1,X		/ CHECK FOR 'ORM'		/(006)
	SAD	AUTORM+1					/(006)
	JMP	NOLIST						/(006)
	JMP	LST						/(006)
/
DOTS	.SIXBT	'...'		/ 1ST HALF OF MCR FUNCTION	/(006)
POLLER	.SIXBT	'POLLER'					/(006)
NODCNT	.SIXBT	'NODCNT'					/(006)
AUTORM	.SIXBT	'AUTORM'					/(006)
	.EJECT
/  SUBROUTINE TO CONVERT AN OCTAL (BINARY) NUMBER TO DECIMAL, SELECT THE
/  TWO LEAST SIGNIFICANT DIGITS, AND PLACE THEM IN THE AC & MQ
/  SO THAT SHIFTING LEFT BY 3 PLACES THEM IN THE AC (.SIXBT CODE).
/
/  CALLING SEQUENCE:
/
/	LAC	BINVAL
/	JMS	OCTDEC
/	(RETURN)		/ .SIXBT VALUES IN AC, MQ
/
OCTDEC	XX
	DAC	CHAR
	LAW	-4
	DAC	WTFOR		/ CONVERT 4 DIGITS
	LAC	(DIVISR
	DAC	FPADR1
	LAC	(ANS
	DAC	FPADR2
	ILD;	CHAR
CONVRT	IDV;FPADR1
	IST;FPADR2		/ QUOTIENT IS NEXT CONVERTED DIGIT
/***	UNSWQ;	0		/ REMAINDER IS NEXT DIVIDEND
	IMP;	I+FPADR1	/*** PROGRAM AROUND HARDWARE FAULT
	IRS;	CHAR		/***
	IST;	CHAR		/*** END OF FUDGE
	IDX	FPADR1		/ POINT TO NEXT DIVISOR
	IDX	FPADR2
	ISZ	WTFOR
	JMP	CONVRT
	LAC	ANS+3		/ GET LEAST SIGNIFICANT ANSWER DIGIT
	XOR	(60		/ CONVERT TO .SIXBT ASCII
	CLQ!LRSS 6		/ SHIFT INTO MQ
	LAC	ANS+2		/ GET OTHER DESIRED DIGIT
	XOR	(60		/ CONVERT IT TO .SIXBT ASCII
	LLSS	3
	JMP*	OCTDEC		/ LEAVE WITH ANSWER IN AC, MQ
/
	.DEC
DIVISR	1000;	100;	10;	1
ANS	.BLOCK	4;	.OCT
	.EJECT
/  SUBROUTINE TO CONVERT 3 .SIXBT CHARACTERS (1 WORD) TO 5/7
/  ASCII (A3 FORMAT), CONVERTING NULLS TO SPACES.
/
/  CALLING SEQUENCE:
/
/	LAC	.SIXBT
/	JMS	ASCII
/	RESULT		/ POINTER TO 2-WORD 5/7 ASCII BUFFER
/	(RETURN)
/
ASCII	XX
	LMQ			/ STORE .SIXBT IN MQ
	LAC*	ASCII		/ GET RESULT POINTER
	IDX	ASCII		/ INDEX PAST ARGUMENT
	DAC	CHARPT
	JMS	ONECHR		/ GET NEXT CHARACTER
	ALSS	13
	DAC*	CHARPT
	JMS	ONECHR		/ 2ND CHARACTER
	ALSS	4
	XOR*	CHARPT
	DAC*	CHARPT
	JMS	ONECHR		/ 3RD CHARACTER
	CLQ!LRSS 3
	XOR*	CHARPT
	DAC*	CHARPT
	IDX	CHARPT		/ POINT TO SECOND WORD OF ANSWER
	LACQ
	DAC*	CHARPT
	JMP*	ASCII
/
/  SUBROUTINE TO GET THE NEXT CHARACTER FROM MQ AND CONVERT TO
/  7-BIT.
/
ONECHR	XX
	ECLA!LLSS 6		/ SHIFT IN NEXT CHARACTER
	SNA
	AAC	40		/ CONVERT NULL TO SPACE
	DAC	CHAR		/ TEMPORARILY SAVE CHARACTER
	AND	(40
	SNA!CLA
	AAC	100		/ SET 7TH BIT, AS APPROPRIATE
	XOR	CHAR		/ MERGE WITH .SIXBT REPRESENTATION
	JMP*	ONECHR		/ LEAVE WITH 7-BIT ASCII IN AC
/
	.EJECT
WTFOR	XX
	LAC	EV
	SNA
	CAL	WAITFR		/ WAIT ONLY WHEN NECESSARY
	LAC	EV		/ VALIDATE EVENT VARIABLE
	SPA
	SAD	(-13		/ WE'LL LET THIS ONE PASS
	JMP*	WTFOR
	SAD	(-6		/ IGNORE UNIMPLEMENTED FUNCTION
	JMP*	WTFOR
	LAC	WTFOR		/ WE ARE ABOUT TO COMPLAIN	/(012)
	DAC*	.IOERR		/ BITTERLY AND INFORMATIVELY	/(012)
	LAC	.IOERR		/ PUT REAL TROUBLE ADDRESS	/(012)
	IAC			/ WHERE IT WILL BE REPORTED	/(012)
	DAC	WTFOR						/(012)
	LAC	EV		/ RETRIEVE EVENT VARIABLE	/(012)
	JMP*	WTFOR		/ COMPLAIN TERMINALLY		/(012)
/
	.EJECT
/  VARIABLES, CPB'S, AND BUFFERS
/
EV;XRADJ;XRSAVE;BUFPT;COUNT;CHAR;CHARPT
TMWTFR	20;	CTLTB
WAITFR	20;	EV
ENTER	3300;	EV;	DKO; .SIXBT 'TEMPRYACT'
SEEK	3200;	EV;	DKI;S.NM1;S.NM2; .SIXBT 'ACT'
READL	2600;	EV;	DKI; 0; LINE; 26			/(013)
WRITEL	2700;	EV;	DKO; 0; LINE
WRITE	2700;	EV;	DKO; 0; UDATA
CLOSEI	3400;	EV;	DKI
CLOSE	3400;	EV;	DKO;C.NM1;C.NM2; .SIXBT 'ACT'
DELETE	3500;	EV;	DKI;D.NM1;D.NM2; .SIXBT 'ACT'
RENAME	3700;	EV;	DKO; .SIXBT 'TEMPRYACT'
START1	.BLOCK	BUFSIZ-1;END1
START2	.BLOCK	BUFSIZ-1;END2
LOGOUT	.SIXBT	'..DOS.' ; 0; 0; 0; 0				/(013)
LINE	.BLOCK	26						/(013)
/
UDATA	13000;	0;	400000		/ USER DATA RECORD	(013)
DATE	24;	0;	.BLOCK 6	/ WORDS 3-12
TSKNM1	0;	0			/ WORDS 13-14
TSKNM2	0;	0			/ WORDS 15-16
MOSTXM;LEASTXM				/ WORDS 17-20		/(013)
IOCNT	0; 0				/ WORDS 21-22		/(013)
UIC	0;	0			/ WORDS 23-24
	0				/ WORD 25 UNUSED	/(013)
/
MONTHS	.SIXBT	'@JA'
	.SIXBT	'@FE'
	.SIXBT	'@MR'
	.SIXBT	'@AP'
	.SIXBT	'@MY'
	.SIXBT	'@JN'
	.SIXBT	'@JL'
	.SIXBT	'@AU'
	.SIXBT	'@SE'
	.SIXBT	'@OC'
	.SIXBT	'@NV'
	.SIXBT	'@DC'
/
	.END	TSKTM2
[\].