***   B00 UPDATES   ***
*09:47  10/02/70       TIME OF UPDATE                                   U:AC0001
         PCC      0
         PSR      0
         TITLE    'UTS ACCNTSUM - VERSION A00'                          U:AC0004
*
*
*        UTS ACCNTSUM - VERSION A00                                     U:AC0006
*
*
         PAGE
************************************************************************
*                                                                      *
*        IF RUNNING ON-LINE ON BTM, SET 'FORBTM' TO A 1                *
*        IF ASSEMBLING FOR UTS, SET IT TO A 0                          *
*        FOR BTM, 'BTMACCN' MUST BE EQUAL TO 8-CHARACTER STRING        *
*            CONTAINING THE ACCOUNT                                    *
*                                                                      *
************************************************************************
FORBTM   EQU      0                 SET FOR BTM
FORUTS   EQU      1-FORBTM          SET FOR UTS
FORSEC   EQU      0                 SET TO 1 FOR ELAP TIME IN MINS AND SEC
         DO       FORBTM
BTMACCN  EQU      'C64003'          BTM ACCOUNT IF ON-LINE
         FIN
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         PAGE
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGU4ENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 0,NAME(1),AF(1),0,TEMPSTAK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TEMPSTAK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TEMPSTAK
         FIN
         FIN
         PEND
*
*        PROC TO SEND MESSAGES TO OPERATOR
*
SEND     CNAME
         PROC
LF       RES      0
I        DO       NUM(AF)
         LI,R2    AF(I)
         DO       FORUTS
         CAL1,2   SENDOPMS          SEND MSG TO OPERATOR
         ELSE
         LB,SR4   AF(I)
         CAL1,1   FAKEOPMS          SEND IT TO USER IF ON BTM
         FIN
         FIN
         PEND
*
*        PROC TO GENERATE ZEROS OR SPACES
*
ZERO     CNAME    0
SPACES   CNAME    '    '
         PROC
LF       DATA     NAME
         LIST     0
         DO1      AF(1)-1
         DATA     NAME
         LIST     1
         PEND
*
*        PROC TO GENERATE TEXTC MESSAGES WITHOUT LISTING THE HEX
*
TXTC     CNAME
         PROC
         DISP     %
         LIST     0
LF       TEXTC    AF
         LIST     1
         PEND
*
*        PROC TO SET UP ERROR CODE MESSAGE
*
SETERROR CNAME
         PROC
LF       RES      0
         DO1      AF(1)~=R2
         LW,R2    AF(1)
         BAL,SR4  BIN2HEX
         AND,R4   =X'FFFF'
         OR,R4    ='= '**16
         STW,R4   ERRCODEM+3
         PEND
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TEMPSTAK
         PEND
         PAGE
         REF      J:JIT
         REF      P:JIT
Z        EQU      P:JIT-J:JIT
Z4       EQU      Z+Z+Z+Z           FOR BYTE FIELS
         REF      M:X1
         REF      CIC,CPO,CPPO,CUPO,CDPO
         REF      TPACCESS,DCACCESS,DPACCESS
         DEF      UNME
         REF      JB:PRIV
          DEF      SENDOPMS
         REF      J:ACCN
         REF      PRT
         REF,1    JB:TMTS,JB:PMTS
         REF      JB:MAX
         REF,1    JB:STEP,JB:ORG
         REF,1    JB:PEAK,JB:PNR,JB:FRS
         REF      TMPDCPK,TMPDPPK
         REF      PRDCRM,PRDPRM
         REF      TMDCRM,TMDPRM
         REF      JRNST
         REF      SB:RTY,TB:FLGS,SV:RSIZ,SH:RNM
         REF      TYPMNSZ
         DO       FORUTS
         REF      M:LL
         REF      M:EO                                                  U:AC0008
         REF      M:UC
         FIN
         REF      J:UTIME
         REF      J:PTIME
         DO       FORBTM
         REF      M:SO
M:UC     EQU      M:SO
M:LL     EQU      M:SO
         DEF      FAKEOPMS
         FIN
         DEF      TEMPSTAK
         DEF      TIMEVERT
         DEF      TIMBUF1           TO STORE LOGON/OFF TIME
         REF      JIT
         DEF      RECORD
         REF      TPIOT
         REF      TUIOT
         REF      J:AMR
         REF      SYSID
         REF      J:UNAME
         REF      NSWAPS
         DEF      DECBIN
         DEF      BINDCB
         DEF      ZEROBK
         DEF      CPU
         DEF      ACCOUNT
         DEF      ERRCODEM
         DEF      BIN2HEX
         DEF      ACCNTSUM
         DEF      TIMBUF
         DEF      UACCOUNT
         DEF      UPASSWD
         DEF      UEXTACC           TO STORE USER SUPPLIED INFO.
         DEF      KEYBUFF
         DEF      RECSIZE
         DEF      ERRTRY
         DEF      LISTLOC
         DEF      OPMES
         DEF      PATCH
         SREF     M:ACTERM          FOR INSTALLATION ACCOUNTING
*
*  ACCOUNTING RECORD ITEMS FORMAT
*
ACCN     EQU      ACCOUNT
UNAM     EQU      ACCOUNT+2
EXTACC   EQU      ACCOUNT+5
CHARU    EQU      ACCOUNT+11
LINE     EQU      ACCOUNT+12
JOBORG   EQU      ACCOUNT+13
DATEON   EQU      ACCOUNT+14
JTON     EQU      ACCOUNT+15
JTOFF    EQU      ACCOUNT+16
CINT     EQU      ACCOUNT+17
DATEOFF  EQU      ACCOUNT+18
DISPIN   EQU      ACCOUNT+19
CARDS    EQU      ACCOUNT+20
PAGES    EQU      ACCOUNT+21
DGNTAP   EQU      ACCOUNT+22
TAPACC   EQU      ACCOUNT+23
RADACC   EQU      ACCOUNT+24
DISACC   EQU      ACCOUNT+25
IOCAL    EQU      ACCOUNT+26
RADGRN   EQU      ACCOUNT+27
DISGRN   EQU      ACCOUNT+28
COREMS   EQU      ACCOUNT+29
PEXC     EQU      ACCOUNT+30
PSERV    EQU      ACCOUNT+31
MAXCORE  EQU      ACCOUNT+32
UEXC     EQU      ACCOUNT+33
USERV    EQU      ACCOUNT+34
TMPRAD   EQU      ACCOUNT+35
TMPDIS   EQU      ACCOUNT+36
JOBRATE  EQU      ACCOUNT+37
MAXRES   EQU      ACCOUNT+38
*
MSGDATA  EQU      8+MESSAGE
*
* ASSIGN-MERGE RECORD ITEMS
*
AMDATE   EQU      8
AMUNAM   EQU      9
AMON     EQU      12
AMBILL   EQU      13
AMXACC   EQU      14
AMRAD    EQU      20
AMDIS    EQU      21
*
* LOGON RECORD ITEMS
*
LR:RAD   EQU      18
LR:DIS   EQU      22
*
         REF      J:CALCNT
         DEF      RATEFLAG
SECTION2 DSECT    1
BLANK    TEXT     '    '
*
* ACCOUNTING OUTPUT
*
ELAPTM   TXTC     'ELAPSED JOB TIME'
MGPART   TXTC     'PARTITION NUMBER'
CHARM    TXTC     'CHARGE UNITS'
CPUM     TXTC     'TOTAL CPU TIME'
PETM     TXTC     '  PROCESSOR EXECUTION TIME'
PSTM     TXTC     '  PROCESSOR SERVICE TIME'
UETM     TXTC     '  USER EXECUTION TIME'
USTM     TXTC     '  USER SERVICE TIME'
CRM      TXTC     'CARDS:  CARDS READ'
CPM      TXTC     '        CARDS PUNCHED'
PPM      TXTC     'PAGES:  PROCESSOR PAGES'
UPM      TXTC     '        USER PAGES'
DPM      TXTC     '        DIAGNOSTIC PAGES'
MGTDRV   TXTC     'TAPES:  DRIVES ALLOCATED'
MGTMNT   TXTC     '        TAPES MOUNTED'
MGSPIN   TXTC     'PACKS:  SPINDLES ALLOCATED'
MGPMNT   TXTC     '        PACKS MOUNTED'
MGPEAK   TXTC     'CORE:   PEAK CORE(PAGES)'
MGCTIM   TXTC     '        PAGE.MINUTES'
IOIM     TXTC     'I/O:    OPERATIONS'
CALM     TXTC     '        CALS'
HDFILE   TEXT     'FILE SPACE  '
MGPRAD   TXTC     '  PEAK RAD TEMPORARY'
MGRAD    TXTC     '  NET RAD PERMANENT'
MGDCRM   TXTC     '  AVLBL RAD PERMANENT'
MGPDIS   TXTC     '  PEAK DISK TEMPORARY'
MGDIS    TXTC     '  NET DISK PERMANENT'
MGDPRM   TXTC     '  AVLBL DISK PERMANENT'
MGNSWAP  TXTC     'NUMBER OF SWAPS'
*
OFF      TXTC     'OFF'
FDERRMSG TXTC     'ERROR IN SYSTEM ACCOUNT FILE DIRECTORY'
OPNERMSG TXTC     'UNABLE TO OPEN :ACCTLG FILE FOR ACCOUNTING'
OPNLGNM  TXTC     'UNABLE TO OPEN USERS FILE FOR UPDATE'
RWLOGONM TXTC     'BAD LOGON RECORD'
AMERMSG  TXTC     'UNABLE TO READ ASSIGN-MERGE RECORD'
RESALOC  TXTC     'RESOURCES ALLOCATED'
         DO       FORBTM
TIMEMSG  TXTC     '12:00 JUN 03,''70'
         FIN
         REF      J:INTER
M:SL    EQU   M:EO
KBUF     EQU      10
LOGRECSZ EQU      126               LOGON REC. NOW EXPANDED
SYSACCNT EQU      ':SYS    '        SYSTEM ACCOUNT NAME                 U:AC0012
         REF      PUF
Y0038    DATA     X'00380000'
X7F      DATA     X'7F'
         BOUND    8
PGES     TEXT     ' (PAGES)'
         DO       FORUTS
SYSACCN  TEXT     SYSACCNT
         ELSE
SYSACCN  TEXT     BTMACCN
         FIN
         PAGE
**********************************************************************
*                                                                    *
*        ACCNTSUM - PERFORMS LOGOFF/ENDJOB FUNCTIONS                 *
*        ENTER WITH RETURN LINK IN SR4                               *
*                                                                    *
**********************************************************************
ACCNTSUM RES      0
         PUSH     16,R0             SAVE REGISTERS
         M:TIME   TIMBUF,TUN
         DO1      FORSEC
         BAL,SR4  TIMEVERT
         STW,SR1  TIMBUF+4          JULIAN DATE TO ACCT RECORD
         LI,R0    Z
         BEZ      ACCT1
         LCI      2                 GET ACCOUNT OUT OF CURRENT JIT      U:AC0014
         LM,R0    J:ACCN                                                U:AC0015
         LW,R2    J:JIT+PRDCRM      GET PERM. RAD SPACE REMAINING
         LW,R3    J:JIT+PRDPRM      GET PERM.DISC SPACE REMNG
         LW,R4    J:JIT+TMDCRM      GET TEMP. RAD SPACE REMNG
         LW,R5    J:JIT+TMDPRM      GET TEMP.DISC SPACE REMNG
         LW,R6    J:AMR             GET DISC ADDR. OF A-M TABLE
*
         PUSH     7,R0
*
         LCI      2                 PUT ACCOUNT FROM OBJECT JIT INTO    U:AC0018
         LM,R0    J:ACCN+Z             CURRENT JIT                      U:AC0019
         STM,R0   J:ACCN                                                U:AC0020
*
         LCI      4
         LM,R0    J:JIT+PRDCRM+Z    MOVE RAD,PACK FIGURES
         STM,R0   J:JIT+PRDCRM
         LW,R0    J:AMR+Z           MOVE A-M DISC ADDR.
         STW,R0   J:AMR
         LI,R5    1                 SET A/M RECORD STATUS (RECVRY.=1)
         STB,R5   MAXRES
ACCT1    EQU      %
*
         LI,R5    J:JIT+Z
         BAL,SR4  RELSTARF          RELEASE ALL TEMP FILES
         CAL1,8   GETPAGE           GET 1 PAGE FOR A-M REC.
         BCR,8    %+2
         B        %-2
         LI,R1    M:EO              SET ERROR/ABNORMAL ADDR. IN M:EO
         LI,D3    AMERR
         LI,D4    AMERR
         CAL1,1   SETDCB
         CAL1,1   RAMREC            READ A-M RECORD
*   CHECK IF SYS IDS IN JIT & A-M TABLE MATCH,
*  IF NOT, DO NOT STORE INFO. FROM A-M INTO ACCOUNTING REC.
*
         LW,R7    SR2               ADDR. OF AREA
         LI,R1    1
         LH,D1    J:JIT+Z,R1        SID IN JIT
         LW,D2    AMBILL,R7
         LH,D2    D2,R1             SID IN A-M TABLE
         CW,D1    D2
         BNE      BYPASS
*STORE INF0. FROM A-M REC INTO ACCOUNTING REC. IMAGE
**FORMAT IS BINARY WHEREVER APPROPRIATE
***DATE AT START TIME: YEAR,DAY AND MINUTES FROM MIDNIGHT
         LW,D1    AMDATE,R7
         AND,D1   Y007F
         STW,D1   DATEON
         LW,D1    AMON,R7
         STW,D1   JTON
**BILLING
         LW,D1    AMBILL,R7
         LH,D1    D1
         STH,D1   JOBRATE           IN LEFT HF WD
**EXT. ACC. INFO.
         LCI      6
         LM,R1    AMXACC,R7
         STM,R1   EXTACC
**FOR THE MOMENT,STORE RAD,DISK RMNG SPACE FIG. AT LOGON TIME
         LW,D1    AMRAD,R7
         STW,D1   RADGRN
         LW,D1    AMDIS,R7
         STW,D1   DISGRN
*
         B        PASSED
Y007F    DATA     X'007F01FF'
*
BYPASS   EQU      %
*  SINCE INFO. IN A-M REC IS NOT GOING TO BE STORED INTO ACCT. REC.
*  HAVE TO PUT APPRO. VALUE IN ACCT.REC. SO THAT ACCT. CAN BE DONE RIGHT
*  THIS SITUATION CAN BE DETECTED BY EXAMINING ACCT. REC.
*
         LI,D1    0
         STW,D1   JTON              SET START TIME TO 0
         STW,D1   DATEON            SET START DATE TO 0
         STH,D1   JOBRATE           BILLING SET TO 0
         STW,D1   EXTACC            1ST WD OF XACC. SET TO 0
         LW,D1    JIT+PRDCRM
         STW,D1   RADGRN            USED NO RAD SPACE
         LW,D1    JIT+PRDPRM
         STW,D1   DISGRN            USED NOO PACK SPACE
*
PASSED   EQU      %
         CAL1,8   RELPAGE           RELEASE THE PAGE
         LI,R5    J:JIT+Z
         LI,R0    Z
         BEZ      ACCT2
         PULL     7,R0
         LCI      2
         STM,R0   J:ACCN                                                U:AC0029
         LCI      4
         STM,R2   J:JIT+PRDCRM
         STW,R6   J:AMR
ACCT2    EQU      %
         LB,R1    J:UNAME+Z  GET USER NAME OUT OF CURRENT JIT
         CI,R1    ' '
         BE       ACCT3             DONT UPDATE FILE IF NOT LOGGED ON
         LCF      J:JIT+Z           DON'T UPDATE FILE
         BCS,4    ACCT3              IF USER WAS A GHOST
         CI,R1    0                 CHK IF LOGGED ON
         BE       ACCT3              NOT LOGGED
         BAL,SR4  UPDATE            UPDATE LOGON FILE
         BAL,SR4  DISPLY            DISPLAY ACCOUTING INFORMATION
ACCT3    EQU      %
*
COPOUT   EQU      %
         PULL     16,R0             RESTORE REGISTERS
         B        *SR4              EXIT
         PAGE
**********************************************************************
*                                                                    *
*        DISPLY   DISPLAYS JOB ACCOUNTING INFORMATION                *
*          AND PREPARES THE ACCOUNTING RECORD IMAGE******
**********************************************************************
DISPLY   RES      0
         PUSH     SR4               SAVE RETURN ADDRESS
         BAL,SR4  BANNER            OUTPUT TOP BANNER AND UPSPACE
         LI,R5    2                 2 LINES
         BAL,SR4  UPSPACE
         DO       FORBTM
         LI,D2    BA(TIM)           SIMULATE M:TIME CAL
         LB,D1    TIMEMSG
         STB,D1   D2
         LI,D1    BA(TIMEMSG)
         MBS,D1   1
         FIN
         LCI      4                 MOVE DATE AND TIME TO MESSAGE
         LM,D1    TIMBUF            BUFFER,TIME CALL DONE AT LOGOFF
         STM,D1   MESSAGE
         LW,D1    =' ID='           USER ID ON ACCOUNTING PAGE
         STW,D1   MESSAGE+4
         LW,R2    J:JIT+Z
         AND,R2   =X'FFFF'
         BAL,SR4  BIN2HEX           CONVERT TO HEX
         STW,R4   MESSAGE+5
         LI,R4    16+8              BUFFER SIZE
         LH,D1    J:JIT+Z           SKIP OUTPUT IF NOT BATCH            U:AC0034
         CI,D1    X'C000'                                               U:AC0036
         BANZ     %+3
         M:SETDCB   M:LL,(ERR,LERR),(ABN,LERR)      CAT. 1&2
         CAL1,1   BLIST             OUTPUT TO PRINTER
* ACCOUNT
         LCI      2
         LM,D1    J:ACCN+Z          GET USERS ACCT FROM JIT
         STM,D1   ACCN              PUT ACCT INTO STORAGE AREA
         LCI      3
         LM,D1    J:UNAME+Z         GET USERS NAME
         STM,D1   UNAM              PUT NAME INTO THE STORAGE AREA
* COMPUTE JOB ELAPSED TIME
* STORE DATE AND TIME AT OFF TO ACCT. REC. IMAGE
         DO1      FORSEC=0
         BAL,SR4  TIMEVERT          BRANCH TO LOGOFF. SAVE LOGON IN D3.
         LW,D2    TIMBUF1
         STW,D2   JTOFF
         LW,SR1   TIMBUF+4          (TIMBUF+4)=YEAR,DAY AT LOGOFF
         STW,SR1  DATEOFF
         LW,D3    JTON              ACCT. REC'D. SHOULD CONTAIN ON-TIME BY NOW
         BNEZ     DISPLY5           IF NOT, PROBABLY A/M ERROR
         LW,D3    JTOFF             SET TIME OFF=TIME ON
         B        DISPLY8
DISPLY5  RES      0
         CW,D2    D3                COMPARE LOGON TIME WITH LOGOFF TIME
         BGE      %+2               IS LOGOFF TIME LESS THAN LOGON TIME
         DO       FORSEC
DAY      EQU      24*60*60
         ELSE
DAY      EQU      24*60
         FIN
         AI,D2    DAY
*
*
DISPLY8  RES      0
         DO       FORSEC=0
         SW,D2    D3                SUBTRACT LOGON TIME FROM LOGOFF TIME
         STW,D2   MINUTES           SAVE MINUTES
         LI,D1    0                 SETUP D1 FOR DIVIDE INSTRUCTION.
         DW,D1   =60                GET TIME IN HRS AND MINUTES.
         STW,D1   CONV              SAVE MINUTES
         LW,D1    D2                CONVERT HOURS TO EBCDIC
         BAL,SR4  BINDCB
         LW,D1    CONV              GET MINUTES
         STW,D2   CONV              SAVE HOURS
         BAL,SR4  BINDCB            CONVERT MINUTES TO EBCDIC
         LI,D1    ' :'
         STH,D1   D2                D2 = ' :MM'
         LW,D1    CONV              GET HOURS AGAIN (IN EBCDIC)
         BAL,SR4  ZEROBK            CONVERT LEADING ZEROS TO BLANKS
         SCS,D2   8                 D2 = ':MM '
         SCD,D1   -8                D1,D2 = '   H','H:MM'
         STW,D1   CONV              PUT MINS + HRS TIME IN MESSAGE BUFF
         STW,D2   CONV+1            IN LOGON TO BE PRINTED OUT LATER
         ELSE
         SW,D2    D3
         LI,D1    0
         DW,D1    =60               D1:=BIN SECS; D2:=BIN TOT MINS
         STW,D2   CONV+1            SAVE BIN TOT MINS
         STW,D2   MINUTES
         BAL,SR4  BINDCB            CVRT D1 (BIN SECS) TO EBC SECS
         XW,D2    CONV+1            SAVE EBC SECS & RESTORE BIN MINS
         LI,D1    0
         DW,D1    =60               D1:=BIN MINS; D2:=BIN HRS
         STW,D2   CONV+4            SAVE BIN HRS
         BAL,SR4  BINDCB            CVRT D1 (BIN MINS) TO EBC MINS
         LI,D1    ':'               ':' TO PRECEDE 'MM' IN OUTPUT
         SLS,D2   16                SHIFT EBC MINS NEXT TO ':'
         LI,2     3                 SET UP MBS (3 BYTES)
         SLS,2    24                SHIFT COUNT INTO PLACE
         LI,3     BA(CONV)+2        DEST ADDRESS
         OR,3     2                 RU1 NOW SET UP
         LI,2     51                SOURCE (BYTE 3 OF D1)
         MBS,2    0
         LW,D1    CONV+4            RESTORE BIN HRS
         BAL,SR4  BINDCB            CVRT D1 (BIN HRS) TO EBC HRS
         STH,D2   CONV              SAVE EBC HRS
         LI,1     1                 INDEX FOR POSTITION IF ':' IN CONV+1
         LI,D1    ':'               ':' BETWEEN MM & SS
         STB,D1   CONV+1,1
         LW,D1    CONV
         LW,D2    CONV+1
         FIN
         LI,R0    ELAPTM            GET ADDR OF MSGE "ELAPSED JOB TIME"
         BAL,R7   DEC2              GO WRITE OUT THE MESSAGE
* PARTITION NUMBER
         LI,R1    JB:PNR+Z4
         LB,D1    0,R1
         LI,R5    1                 R5 = 1 IMPLIES DECIMAL NOT WANTED
         STB,D1   MAXCORE,R5
         LI,R0    MGPART
         BAL,R7   DECV
* CHARGE UNITS
         B        COMPUTECH
COMP     RES      0
         LI,R5    1                 R5 = 1 IMPLIES DECIMAL NOT WANTED
         STW,D1   CHARU             INTO ACCT. REC.
         LI,R0    CHARM             LOAD ADDRESS OF MSGE 'CHARGE UNITS'
         BAL,R7   DECV              CONVERT NO. D1 TO MIN + OTPT BTCHMSG
         STW,D1   CHGV              PUT CHRG UNITS IN MSGE BUFFER IN
         STW,D2   CHGV+1            LOGON-PRINT OUT LATER FOR ON LINE.
         LI,R5    0                 SET DEC. PT. FLAG FOR 'DECP'
* CPU=MM.MMM CON=H:MM INT=NN CHG=XXXX
         LW,D1    J:UTIME+Z         GET TOT USER EXECU TIME FOR CURR.JOB
         AW,D1    J:UTIME+Z+1       ADD TOT USER EXECU TIME TO TOTAL
         AW,D1    J:PTIME+Z         ADD TOT PROCESS EXEC TIME TO TOT
         AW,D1    J:PTIME+Z+1       ADD PROCESSOR OH TIME TO OTHER TOTAL
         LI,R0    CPUM              LOAD TOTAL CPU TIME 'MESSAGE'
         BAL,R7   DECP              GET TOT IN D1 CONVERT TO MIN,ETC.
         STW,D1   CPUV              CPU TIME FOR ON-LINE OUTPUT
         STW,D2   CPUV+1
* PROCESSOR EXECUTION TIME
         LAW,D1   J:PTIME+Z         TTL PROC EXEC TIME
         AI,D1    1                 ADJUST FOR ROUNDOFF ERRORS
         STW,D1   PEXC              #OF TICKS TO ACCT. REC.
         LI,R0    PETM              GET MESSAGE ADDRESS
         BAL,R7   DECP              GO CONV TO MIN + OTPT MSG-BATCH JOBS
* PROCESSOR SERVICE TIME
         LAW,D1   J:PTIME+Z+1       TTL PROC OVHD TIME
         AI,D1    1                 ADJUST FOR ROUNDOFF ERRORS
         STW,D1   PSERV             INTO ACCT. REC.
         LI,R0    PSTM              GET MESSAGE ADDRESS
         BAL,R7   DECP              GO CONV TO MIN + OUTPUT LINE--BATCH
* USER EXECUTION TIME
         LAW,D1   J:UTIME+Z         TTL USER EXEC TIME
         AI,D1    1                 ADJUST FOR ROUNDOFF ERRORS
         STW,D1   UEXC              INTO ACCT. REC.
         LI,R0    UETM              GET ADDR OF MSGE 'USER EXECUTIONTIME
         BAL,R7   DECP              GO CONV NO. D1 TO MIN + OTPT MSG-BTC
* USER SERVICE TIME
         LAW,D1   J:UTIME+Z+1       TTL USER OVHD TIME
         AI,D1    1                 ADJUST FOR ROUNDOFF ERRORS
         STW,D1   USERV             INTO ACCT. REC.
         LI,R0    USTM              GET ADDR OF MSGE 'USER SERVICE TIME'
         BAL,R7   DECP              GO CONV NO. D1 TO MIN ETC.
         LI,R5    1                 SET R5-NO DEC POINT PUT IN NO. FIELD
* CARDS READ
         LW,D1    CIC+JIT+Z         GET CARD INPUT COUNT
         SLS,D1  -17                SHIFT COUNT-SO RIGHT-JUSTIFIED
         STH,D1   CARDS             INTO ACCT. REC.
         LI,R0    CRM               GET ADDR OF MSGE 'CARDS READ'
         BAL,R7   DECV              CONV COUNT-BCD + DROP LEADING ZEROES
* CARDS PUNCHED
         LW,D1    CPO+JIT+Z         TOTAL NO. CARDS PUNCHED BY JOB
         SLS,D1  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         LI,R6    1
         STH,D1   CARDS,R6          INTO ACCT. REC.
         LI,R0    CPM               GET ADDR MSG 'CARDS PUNCHED'
         BAL,R7   DECV              GO CONV COUNT.DROP LEADING ZEROES'
* PROCESSOR PAGES OUTPUT
         LW,D1    CPPO+JIT+Z        NO PAGES OUTPUT BY PROCESS FOR JOB
         SLS,D1   -17               SHIFT-THE COUNT IS RIGHT JUSTIFIED
         LI,R0    PPM               GET ADDR OF MSGE 'PROCESSOR PAGES'
         STH,D1   PAGES             INTO ACCT. REC.
         BAL,R7   DECV              CONV COUNT BCD. DROP LEADING ZEROES
* USER PAGES OUTPUT
         LW,D1    CUPO+JIT+Z        NO PAGES OUTPUT USER PROG FOR JOB
        SLS,D1   -17                SHIFT COUNT- RIGHT JUSTIFIED
         LI,R0    UPM               GET ADDR OF MSGE 'USER PAGES'
         LI,R6    1
         STH,D1   PAGES,R6          INTO ACCT. REC.
         BAL,R7   DECV              CONVERT COUNT TO BCD
* DIAGNOSTIC PAGES OUTPUT
         LW,D1    CDPO+JIT+Z        NO. DIAG PAGES OUTPUT FOR THE JOB
         SLS,D1  -17                SHIFT COUNT- RIGHT JUSTIFIED
         LI,R0    DPM               GET ADDR MSGE 'DIAGNOSTIC PAGES'
         STH,D1   DGNTAP            INTO ACCT. REC.
         BAL,R7   DECV              CONVERT COUNT TO BCD
* TAPE DRIVES ALLOCATED
         BAL,SR4  NUMPT             GET MAX. TAPES ALLOCATED
         LI,R6    3
         STB,D3   DGNTAP,R6         INTO ACCT. REC.
         LW,D1    D3
         LI,R0    MGTDRV            ADDR. OF MSG.
         BAL,R7   DECV
* TAPES MOUNTED
         LI,R1    JB:TMTS+Z4        TAPES MNTED BY JOB
         LB,D1    0,R1
         LI,R6    2
         STB,D1   DGNTAP,R6         INTO ACCT. REC. IMAGE
         LI,R0    MGTMNT            ADDR. OF MSG.
         BAL,R7   DECV
* SPINDLES ALLOCATED
         BAL,SR4  NUMPT             SET MAX. SPINDLES ALLOCATED
         LI,R6    3
         STB,D4   DISPIN,R6         INTO ACCT. REC.
         LW,D1    D4
         LI,R0    MGSPIN            ADDR. OF MSG.
         BAL,R7   DECV              CONVERT
* PACKS MOUNTED
         LI,R1    JB:PMTS+Z4
         LB,D1    0,R1
         LI,R6    2
         STB,D1   DISPIN,R6         INTO ACCT. REC.
         LI,R0    MGPMNT            ADDR. OF MSG.
         BAL,R7   DECV              CONVERT
* PEAK CORE
         LI,R1    JB:PEAK+Z4
         LB,D1    0,R1
         STB,D1   MAXCORE           INTO ACCT. REC.
         LI,R0    MGPEAK            ADDR. OF MSG.
         BAL,R7   DECV              CONVERT
* CORE(PG)*MILLISECONDS
         LW,D1    JIT+TPIOT+Z       PROCESSOR
         AW,D1    JIT+TUIOT+Z       ADD USER
         STW,D1   COREMS            INTO ACCT. REC.
         LI,R0    MGCTIM            ADDR. OF MSG.
         CW,D1    =FX'3E7B31'
         BGE      1A1
         LI,R5    0
         BAL,R7   DECP
         LI,R5    1
         B        1A2
1A1      DH,D1    =X'75300000'
         BAL,R7   DECV              CONVERT
1A2      RES      0
* I/O INTERACTIONS
** TAPE,DISC,PACK ACCESS DIFFERENTIATED IN ACCT REC. ONLY
         LI,D1    X'FFFF'
         AND,D1   JIT+TPACCESS+Z
         STW,D1   TAPACC
         LW,D2    JIT+DCACCESS+Z
         STW,D2   RADACC            INTO ACCT. REC.
         AW,D1    D2
         LW,D2    JIT+DPACCESS+Z
         STW,D2   DISACC            INTO ACCT. REC.
         AW,D1    D2                NOW D1=SUM OF 3
         LI,R0    IOIM              GET MESSAGE ADDRESS
         BAL,R7   DECV              CONVERT NUMBERT TO BCD
* IO CALS
         LW,D1    J:CALCNT+Z        CALS
         STW,D1   IOCAL             INTO ACCT. REC.
         LI,R0    CALM              GET ADDR MSGE 'I/O CALS'
         BAL,R7   DECV              CONVERT THE NO. IN D1 TO BCD
* FILE SPACE (PRIVATE PACK SPACE NOT ACCOUNTED)
         LH,D1    J:JIT+Z           SKIP IT IF ON-LINE
         CI,D1    X'C000'
         BANZ     CRYON
         LCI      4                 OUTPUT FILE SPACE HEADING
         LM,D1    HDFILE
         STM,D1   MESSAGE
         LI,R4    12
         CAL1,1   BLIST
CRYON    EQU      %
** RAD USAGE
*** PEAK TEMPORARY
         LW,D1    TMDCRM+JIT+Z
         SW,D1    TMPDCPK+JIT+Z
         STW,D1   TMPRAD            INTO ACCT.REC.(SIGN EXTENDED)
         LI,R0    MGPRAD            ADDR. OF MSG.
         BAL,R7   DECV              CONVERT
*** NET PERMANENT
         LW,D1    RADGRN            ALREADY IN ACCT.REC.(DONE AT UPDATE)
         LI,R0    MGRAD             ADDR.OF MSG
         BAL,R7   DECV
*** AVAILABLE PERMANENT(NOT STORED IN ACCT. REC.)
         LW,D1    JIT+PRDCRM+Z
         LI,R0    MGDCRM            ADDR. OF MSG.
         BAL,R7   DECV              CONVERT
** DISK USAGE
*** PEAK TEMPORARY
         LW,D1    TMDPRM+JIT+Z
         SW,D1    TMPDPPK+JIT+Z
         STW,D1   TMPDIS            INTO ACCT.REC.(SIGN XTENDED)
         LI,R0    MGPDIS
         BAL,R7   DECV
*** NET PERMANENT
         LW,D1    DISGRN
         LI,R0    MGDIS
         BAL,R7   DECV
*** AVAILABLE PERMANENT(NOT STORED IN ACCT. REC.)
         LW,D1    JIT+PRDPRM+Z
         LI,R0    MGDPRM
         BAL,R7   DECV
****  NUMBER OF SWAPS(NOT STORED IN ACCT. REC.)
         LW,D1    JIT+NSWAPS+Z
         AND,D1   =X'0001FFFF'
         LI,R0    MGNSWAP
         BAL,R7   DECV
*** MAXIMUM RESOURCE ALLOCATION VALUES
         LI,R1    SV:RSIZ           INTO ACCT. REC.
DISP20   RES      0
         LB,D1    JB:MAX+Z,R1
         STB,D1   MAXRES,R1
         BDR,R1   DISP20
         LI,R0    RESALOC           GET ADDR. OF RESOURCE
         LW,D1    BLANK
         LW,D2    BLANK
         BAL,R7   DEC2              PRINT 'RESOURCES ALLOCATED'
         BAL,SR4  WRTBUF5           BLANK OUT BUFFER
         LI,R6    3                 INIT. BUFFER INDEX
         LI,R2    SV:RSIZ           GET RES. LIMIT TABLE SIZE
DISP20A  RES      0
         LB,D1    JB:MAX+Z,R2       CHECK IF RES. ALLOCATED
         BNEZ     DISP20B
         BDR,R2   DISP20A
         B        DISP20M           NO MORE RES'S.
DISP20B  RES      0
         LH,D2    SH:RNM,R2         GET RESOURCE NAME
         AND,D2   =X'FFFF'
         CI,D2    'CO'              IF 'CO' NEED MORE BUFFER SPACE, DONT
         BNE      DISP20C           INSERT BEYOND COL. 24
         CI,R6    24
         BG       DISP20D
DISP20C  RES      0
         CI,R6    31                OTHERWISE NOT BEYOND COL.31
         BLE      DISP20E
DISP20D  RES      0
         BAL,SR4  WRTBUF            PRINT THE LINE
         LI,R6    3                 RESET THE INDEX
DISP20E  RES      0
         LI,R7    2
         BAL,SR4  PUTBUF            RES. NAME TO BUFFER
         LI,D2    '='
         LI,R7    1
         BAL,SR4  PUTBUF            EDIT IN '='
         BAL,SR4  BINDCB            CONVERT RESOURCE VALUE
         BAL,SR4  ZEROBK            CHANGE LEADING ZEROS TO BLANKS
         LI,R7    3
         BAL,SR4  PUTBUF            STORE VALUE
         CI,R2    1                 IS THIS LAST ENTRY IN SH:RNM
         BNE      DISP20K           NO
         LD,D1    PGES              YES, MUST BE 'CO', APPEND (PAGES)
         LI,R7    7
         BAL,SR4  PUTBUF
DISP20K  RES      0
         AI,R6    1                 BUMP BUFFER INDEX TO NEXT TAB
         BDR,R2   DISP20A           GET NEXT ENTRY
DISP20M  RES      0
         CI,R6    3                 PRINT LAST LINE IF ANYTHING IN BUFF.
         BE       DISP20O
         BAL,SR4  WRTBUF            PRINT THE LINE
DISP20O  RES      0
*
* STORE ALL OTHER PERTINENT INFO. INTO ACCT. REC.
         DO1      FORUTS
         MTW,0    J:JIT+Z           IS THE 'ON LINE' BIT SET?
         BGEZ     NOINT             NO;GO TO NO INTERACTION ROUTINE
         LI,D1    X'1FFFF'
         AND,D1   J:INTER+Z         STRIP OFF 1ST-1/2 WD-NO. INTERACTION
         STW,D1   CINT              INTO ACCT.REC.(SIGN XTENDED)
         BAL,11   BINDCB            CONVERT THE NUMBER TO BCD
         BAL,11   ZEROBK            GET RID OF LEADING ZEROES
         STW,D2   INTV              PUT NO. INTERACT. IN ON-LINE MSGE
* LINE NUMBER (HEX)
         REF      COCLN
         LW,R2    M:UC+COCLN+Z
         STB,R2   LINE              LINE # IN LAST BYTE
         B        NOINT1
NOINT    RES      0
         LI,R6    X'FF'             BATCH; LINE # FF
         STB,R6   LINE
         LI,6     0
         STW,6    CINT              NO INTERACTIONS FOR BTCH
NOINT1   RES      0
* PRIORITY
         LI,R6    1
         LB,D1    JIT+PRT+Z,R6
         SLS,D1   -4                SHIFT OFF SBFLAG IN THE SAME BYTE
         STB,D1   LINE,R6
* FINAL RUN STATUS
         LI,R1    JB:FRS+Z4
         LB,D1    0,R1
         LI,R6    2
         STB,D1   LINE,R6
* JOB STEPS
         LI,R1    JB:STEP+Z4
         LB,D1    0,R1
         LI,R6    3
         STB,D1   LINE,R6
* JOB ORIGIN
         LI,R1    JB:ORG+Z4
         LB,D1    0,R1
         STB,D1   JOBORG
*SYSTEM VERSION(IN EBCDIC)
VERSION  EQU      X'2B'             VERSION IS IN CELL X'2B'
         LI,R6    1
         LB,D1    VERSION,R6        GET CODED VERSION #
         SLD,D1   -4
         SLS,D2   -28
         SLS,D2   24
         LB,R2    D2                GET THE RIGHT 4 BITS OF CODE IN R2
         BAL,SR4  BIN2HEX           THEN TO PRINTABLE HEXDEC.
         LI,R6    3
         STB,R4   JOBORG,R6         STORE INTO ACCT. REC. IMAGE
         LI,R6    2
         LI,R4    X'F0'
         STB,R4   JOBORG,R6         SECOND CHAR. SET TO F0
         SLD,D1   -4
         SLS,D2   -28
         SLS,D2   24
         LB,R2    D2                GET LEFT 4 BITS OF CODE
         AI,R2    9                 DECODE
         BAL,SR4  BIN2HEX           AND CONVERT TO PRINTABLE HEXDEC.
         LI,R6    1
         STB,R4   JOBORG,R6         STORE INTO ACCT.REC. IMAGE
* SYSID (JOB SEQUENCE NUMBER)
         LI,R6    1
         LH,D1    JIT+Z,R6
         STH,D1   DISPIN
         LC       J:JIT+Z           BRANCH IF JOB NOT ON-LINE           U:AC0039
         BCR,8    ENDIT                                                 U:AC0041
         LI,SR4   Z                 DON'T OUTPUT IF RECOVERY            U:AC0043
         BNEZ     ENDIT                                                 U:AC0045
         BAL,SR4  HX                GO OUTPUT ON-LINE ACCOUNTING DISPLAY
         SEND     OFF               SEND OFF MESSAGE TO OPERATOR
ENDIT    RES      0
*  NOW THAE ACCOUNTING RECORD IS COMPLETE IN THE BUFFER,
*   ALLOW THE INSTALLATION ACCESS TO IT AND MAKE APPR. DECISION
*   BEFORE WRITING OUT THE RECORD TO THE ACCOUNTING LOG(:ACCTLG).
*  THE ADDRESS OF THE ACCOUNTING RECORD IS PUT IN R3.
*  UPON RETURN FROM THE INSTALLATION ACCOUNTING ROUTINE(M:ACTERM),
*   IF THE CONTENTS OF R3 IS ZERO, WRITING OF THE RECORD IS SUPPRESSED.
*  BRANCH AND LINK IS DONE VIA D4.
*  ALL OTHER REGISTERS ARE TO REMAIN INTACT.
         LI,D4    M:ACTERM
         BEZ      %+5               NOT THERE
         LI,R3    ACCOUNT
         BAL,D4   *D4
         MTW,0    R3
         BEZ      NOWRITE
         LI,D1    X'C0'
         STB,D1   JB:PRIV           TO BYPASS SECURITY CHECKS
         LI,R2    4                 SET MODE TO INOUT
REP      RES      0
         CAL1,1   OPNSLPL           OPEN :ACCTLG
         CAL1,1   PEOF              POSITION TO END OF FILE
         CAL1,1   WRTSLPL           UPDATE ACCOUNTING LOG
         B        DISPLYX           EXIT
DISPLY10 RES      0
         LB,SR3   SR3               GET ERROR CODE
         CI,SR3   3                 DOES THE FILE EXIST
         BNE      DISPLY12          YES;THEN IT WAS SOME OTHER ABNORMAL
         LI,R2    2                 NO; SET MODE TO 'OUT'
         B        REP               TRY TO OPEN THE FILE AGAIN
DISPLY12 RES      0
         CI,SR3   X'14'             CHECK FOR FILE BUSY AND BRANCH
         BE       FILEBUSY             TO 'FILEBUSY' IF IT IS
         CI,SR3   X'2E'
         BE       FILEBUSY
         CI,SR3   X'4C'
         BE       FILEBUSY
         CI,SR3   X'75'             CHECK FOR FILE DIRECTORY ERROR AND
         BE       FDERROR2             BRANCH IF THERE IS ONE
         SETERROR SR3
         SEND     OPNERMSG,ERRCODEM   NOTIFY OPERATOR
DISPLYX  LW,SR4   M:SL              IF THE FILE IS ALREADY OPEN,        U:AC0048
         CW,SR4   =X'00200000'         DON'T TRY TO CLOSE IT            U:AC0049
         BAZ      %+2                                                   U:AC0050
         CAL1,1   CLSSLPL           CLOSE ACCOUNTING LOG FILE           U:AC0051
NOWRITE  EQU      %
         PULL     SR4               GET RETURN ADDR BRANCH BACK-MAINPROG
         B        *SR4
*
*        FILE BUSY WHEN OPEN ATTEMPTED
*
FILEBUSY RES      0
         DO1      FORUTS
         CAL1,8   WAIT              WAIT FOR ONE SECOND
         B        REP                  AND TRY AGAIN
*
WAIT     GEN,8,24 X'F',1            DISMISS FOR 1 SECOND
*
*        ERROR IN FILE DIRECTORY
*
FDERROR2 RES      0
         SETERROR SR3
         SEND     FDERRMSG,ERRCODEM   NOTIFY OPERATOR
         B        DISPLYX           EXIT FROM DISPLY SUBROUTINE
         PAGE
*
*        OUTPUT TWO LINES OF 'XEROXEROXEROXEROXERO...'
*
BANNER   RES      0
         LH,SR2   J:JIT+Z           RETURN IF NOT BATCH                 U:AC0053
         CI,SR2   X'C000'                                               U:AC0055
         BANZ     *SR4                                                  U:AC0056
         M:SETDCB M:LL,(ERR,LERR),(ABN,LERR)
         PUSH     2,R4              SAVE R4 AND R5
         LW,R4    ='XERO'           PATTERN WORD
         LI,R5    32                NO. OF CHARS. PER LINE / 4
         STW,R4   MESSAGE-1,R5      FILL BUFFER
         BDR,R5   %-1
         LI,R5    2                 NUMBER OF BANNER LIMES
         LI,R4    128
         LI,SR2   'X'
         STB,SR2  MESSAGE,R4        APPEND X TO END OF LINE
         DO1      FORUTS
         LI,R4    129               NUMBER OF BYTES TO BE OUTPUT IN LINE
         DO1      FORBTM
         LI,R4    60
         CAL1,1   BLIST             DUMP BUFFER
         BDR,R5   %-1
         PULL     2,R4              RESTORE REGISTERS
         B        *SR4              RETURN
*
*          UPSPACE A NUMBER OF LINES
*          # OF LINES SPECIFIED IN R5
*
UPSPACE  RES      0
         LH,SR2   J:JIT+Z           RETURN IF NOT BATCH                 U:AC0058
         CI,SR2   X'C000'                                               U:AC0060
         BANZ     *SR4                                                  U:AC0061
         PUSH     2,R4              SAVE R4 AND R5
         LI,R4    ' '               PUT SPACE INTO FIRST BYTE OF
         STB,R4   MESSAGE              'MESSAGE'
         LI,R4    1                 NUMBER OF BYTES TO BE OUTPUT IN LINE
         CAL1,1   BLIST             DUMP BUFFER
         BDR,R5   %-1
         PULL     2,R4              RESTORE REGISTERS
         B        *SR4              RETURN
*
BLIST    GEN,8,24 X'11',M:LL        WRITE ONE RECORD TO M:LL DEVICE
         DATA     X'F4000000'
         DATA     LERR
         DATA     LERR
         DATA     MESSAGE           OUTPUT BUFFER ADDRESS
         GEN,1,31 1,R4              POINTER TO NUMBER OF BYTES
         DATA     0                 BTYE DISPLACEMENT
         PAGE
*
*        PLIST FOR OPENING ACCOUNTING LOG
*
OPNSLPL  RES      0
         GEN,8,24 X'14',M:SL        OPEN ACCOUNTING LOG FILE
         DATA     X'C5000219'
         DATA     DISPLY10          ERROR RETURN ADDRESS
         DATA     DISPLY10          ABNORMAL RETURN ADDRESS
         DATA     1                 CONSECUTIVE
         GEN,1,31 1,R2              MODE IN R2
         DATA     X'07000000'       NULLIFY SN THAT MIGHT BE CARRIED
         DATA     X'08000000'       OVER FROM PREV. ACT. THGH M:EO DCB
         DATA     X'01000202'       FILE NAME
         TEXTC    ':ACCTLG'
         DATA     X'02000202'       ACCOUNT                             U:AC0065
         DO       FORUTS
         TEXT     SYSACCNT
         ELSE
         TEXT     BTMACCN
         FIN
         DATA     X'05010101'       READ ACCOUNTS                       U:AC0070
         TEXT     'NONE'                                                U:AC0071
*
*        PLIST FOR WRITING ACCOUNTING RECORD
*
WRTSLPL  RES      0
         GEN,8,24 X'11',M:SL        WRITE ACCOUNTING LOG RECORD
         DATA     X'30000000'       P3,P4
         DATA     ACCOUNT           BUFFER ADDRESS
         DATA     168               42 WORDS
*
*        PLIST FOR CLOSING ACCOUNTING LOG FILE
*
CLSSLPL  RES      0
         GEN,8,24 X'15',M:SL        CLOSE ACCOUNTING LOG FILE
         DATA     X'80000000'       P1
         DATA     2                 SAVE
*
*        PLIST FOR WRITE TO USER'S TERMINAL
*
TYPE     GEN,8,24 X'11',M:UC        WRITE TO USER'S TERMINAL
         DATA     X'30000000'       P3,P4
         DATA     MESSAGE           BUFFER ADDRESS
         GEN,1,31 1,R2              SIZE IN R2
         PAGE
*
*        COMPRESS SUMMARY MESSAGE
*
HX       RES      0
         LI,R3    60                LOAD MESSAGE SIZE
         LI,R1    0                 LOAD POINTER TO PROCURING AREA
         LI,R2    0                 LOAD POINTER TO STORAGE AREA
         B        HXX
HXXL     CI,D1    ' '
         BE       HXXB
HXX      LB,D1    CPU,R1
HXXC     STB,D1   MESSAGE,R2
         AI,R2    1                 COUNT
HXXU     AI,R1    1
         BDR,R3   HXXL
         LI,R3    Z                 DON'T EXECUTE CAL FOR RECOVERY
         BNEZ     %+2
         CAL1,1   TYPE
         B        *SR4
HXXB     LB,D1    CPU,R1            NEXT
         CI,D1    ' '
         BNE      HXXC              NO
         B        HXXU              YES
*
*     INPUTS  R0=MES,R5=V,R7=EXIT,D1=ARG
*
DECP     RES      0                 ENTER HERE TO CONVERT TICS MINUTES
         DH,D1   =X'00030000'       CONVERTS TICS TO MINUTES
DECV     RES      0                 ENTER HERE WHEN NO CONVERSION WANTED
         CI,D1    0                 IS D1 NEGATIVE
         STCF     R7
         BL       DECVN             IF IT IS, NEGATE
         BAL,SR4  BINDCB            CONVERT TO EBCDIC
         AI,R5    0                 IS A DECIMAL POINT WANTED
         BNEZ     DEC1              BRANCH IF IT ISN'T
         SLS,D1   8                 ADJUST NUMBER FOR DECIMAL POINT
         AI,D1    '.'               RESULT = XXX.XXXX
DEC1     BAL,SR4  ZEROBK            CONVERT LEADING ZEROS TO SPACES
         LC       R7
         BEZ      0,R7
DEC2     RES      0                 ENTRY  FOR STORE AND MESSAGE
         LH,SR2   J:JIT+Z           RETURN IF NOT BATCH                 U:AC0073
         CI,SR2   X'C000'                                               U:AC0075
         BANZ     0,R7                                                  U:AC0076
         BAL,SR4  SETMES            OUTPUT MESSAGE TO PRINTER
         B        0,R7              RETURN TO DISPLAY ROUTINE
*
* COME HERE IF D1 IS NEGATIVE
*
DECVN    RES      0
         LCW,D1   D1                COMPLEMENT NUMBER
         BAL,SR4  BINDCB            CONVERT IT TO EBCDIC
         CI,R5    0                 IS A DECIMAL POINT WANTED
         BNE      DECVN1            BRANCH IF IT ISN'T
         SLS,D1   8                 INSERT PERIOD
         AI,D1    '.'
DECVN1   BAL,SR4  ZEROBK            CONVERT LEADING ZEROS TO SPACES
         LI,R1    7
DECVN2   LB,D4    D1,R1             CONVERT RIGHT-MOST SPACE TO MINUS
         CI,D4    ' '                  SIGN
         BE       %+2
         BDR,R1   DECVN2
         LI,D4    '-'
         STB,D4   D1,R1
         B        DEC2              CONTINUE
*
*        OUTPUT MESSAGE TO PRINTER
*
SETMES   RES      0
         LW,D3    BLANK             BLANK FILL MESSAGE AREA
         LI,R1    10
         STW,D3   MESSAGE-1,R1
         BDR,R1   %-1
         LB,R1    *R0               MOVE MESSAGE INTO MESSAGE AREA
         LB,D3    *R0,R1
         STB,D3   MESSAGE,R1
         BDR,R1   %-2
         STM,D1   MSGDATA
         CAL1,1   JLIST             WRITE MESSAGE
         B        *SR4              RETURN TO DEC2 + RETURN TO DISPLAY
*
*        PLIST FOR PRINTING MESSAGES ON M:LL DEVICE
*
JLIST    GEN,8,24 X'11',M:LL        WRITE TO M:LL DEVICE
         DATA     X'F4000000'
         DATA     LERR
         DATA     LERR
         DATA     MESSAGE           BUFFER ADDRESS
         DATA     39                SIZE OF BUFFER
         DATA     1                 BYTE DISPLACEMENT
*
         PAGE
*
*        COMPUTE  RATE IN D1
*        REG.USED R0,R5,SR3,D1,D2,D3,D4,R1,R7,SR4
*
COMPUTECH  RES    0
         MTW,0    RATEFLAG          EXIT IF NO RATE FILE
         BNEZ     NORATE
         LI,R6    RECORD            ADDRESS WHERE RATE RECORD WILL BE
         LI,D1    X'70000'          LOAD MASK
         AND,D1   JOBRATE           BILLING RATE ALREADY IN ACCT.REC.
         SLS,D1   -16               ALIGN
         BNEZ     SETRATE           IF J:RATE = 0, SET DEFAULTS
         MTW,0    J:JIT+Z           IF OFF-LINE, DEFAULT TO TABLE 0
         BGEZ     SETRATE
         AI,D1    1                 IF NOT, DEFAULT TO TABLE 1
SETRATE  AW,R6    *D1,R6            SET UP POINTER IN RATE FILE
*
         LW,D2    J:UTIME+Z         TOTAL USER EXECUTE TIME
         AW,D2    J:UTIME+Z+1       TOTAL USER OVERHEAD TIME
         AW,D2    J:PTIME+Z         TOTAL PROCESSOR EXECUTION TIME
         AW,D2    J:PTIME+Z+1       TOTAL PROCESSOR OVERHEAD TIME
         MW,D2    0,R6              MULT  TOTAL IN D2 BY CPU TIME RATE
         LW,D1    D2                PUT RESULT INTO D2
* CORE-TIME
         LW,D2    JIT+TUIOT+Z       USER CORE-TIME FACTOR
         AW,D2    JIT+TPIOT+Z       PROCESSOR CORE-TIME FACTOR
         MW,D2    1,R6              MULTIPLY CORE SIZE  TIMES CPU TIME
         AW,D1    D2                ADD RESULT TO TOTAL
* TERMINAL INTERACTIONS
         LI,D2    X'1FFFF'          LOAD MASK
         AND,D2   J:INTER+Z         GET NUMBER OF CONSOLE INTERACTIONS
         MW,D2    2,R6              MULTIPLY NO. INTERA. BY TERM INT.RTE
         AW,D1    D2                ADD RESULT TO TOTAL
* I/O CALS
         LW,D2    J:CALCNT+Z        GET NUMBER OF I/O CALS
         MW,D2    3,R6              MULTIPLY
         AW,D1    D2                ADD RESULT TO TOTAL
* ELAPSED TIME
         LW,D2    MINUTES           LOAD ELAPSED TIME
         MW,D2    4,R6              MULTIPLY
         AW,D1    D2                ADD RESULT TO THE TOTAL
* TAPES
         LI,D2    0
         LI,R5    JB:TMTS+Z4
         LB,R0    0,R5              TAPES MOUNTED
         AW,D2    R0
         LI,R5    JB:PMTS+Z4
         LB,R0    0,R5              PACKS MOUNTED
         AW,D2    R0
         BAL,SR4  NUMPT             GET MAX. NO. PACKS AND TAPES ALLOCATED
         AW,D4    D3                TOTAL THEM
         CW,D4    D2                PICK MAX.
         BLE      %+2
         LW,D2    D4
         MW,D2    5,R6              MULTIPLY
         AW,D1    D2                ADD RESULT TO TOTAL
*
*        NO PAGE-DAY STORAGE FACTOR INCLUDED
*
         LW,R0    CIC+JIT+Z         GET CARD INPUT COUNT
         SLS,R0  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         LW,D2    CPO+JIT+Z         GET CARD PUNCH OUT COUNT
         SLS,D2  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         AW,D2    R0                ADD CD INPUT COUNT TO PUNCHOUT COUNT
         LW,R0    CPPO+JIT+Z        GET CURRENT PROCESSOR PAGESOUT COUNT
         SLS,R0  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         AW,D2    R0                ADD CURRENT PROCESSOR PGS OUT TO TOT
         LW,R0    CUPO+JIT+Z        GET CURRENT USER PAGES OUT COUNT
         SLS,R0  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         AW,D2    R0                ADD RESULT TO TOTAL
         LW,R0    CDPO+JIT+Z        GET CURR DIAGNOSTIC PAGES OUT COUNT
         SLS,R0  -17                SHIFT TO RIGHT-JUSTIFY THE COUNT
         AW,D2    R0                ADD COUNT TO TOTAL
         MW,D2    7,R6              MULT. TOTAL X PERIPHERAL TO CDS+ PGS
         AW,D1    D2                ADD RESULT TO FIRST TOTAL IN D1
         B        COMP
*
NORATE   RES      0
         LI,D1    0                 CLEAR CHARGE UNITS DESTINATION
         LI,D2    0
         B        COMP
         PAGE
* THE DECBIN ROUTINE WILL CONVERT A EBCDIC DECIMAL CHARACTER STRING TO
* BINARY
*  ENTER WITH BAL,SR3 AND:
*        R2 = NUMBER OF CHARACTERS
*        R3 = WORD ADDRESS OF FIRST CHARACTER
*  EXIT WITH
*        R4 = RESULT IF CORRECT AND CC1=0.
*        CC1=1 IF RESULT IS IN ERROR I.E. MAGNITUDE GREATER THAN B1 BITS
*        R5 AND R6 ARE DESTROYED
*
DECBIN   LI,R4    0
         LI,R5    0
DECBIN1  LB,R6    *R3,R4
         AI,R6    -X'F0'            REMOVE LEADING F
         MI,R5    10                MULTIPLY BY 10
         BDP      DECBIN2           CHECK FOR ILLEGAL RESULT
         AW,R5    R6
         AI,R4    1
         BDR,R2   DECBIN1
         STW,R5   R4
         LCI      0                 SET CC1=0 FOR GOOD RESULT
         B        *SR3
DECBIN2  LCI      8                 SET CC1=1 FOR ERROR
         B        *SR3
         PAGE
* THE TIMEVERT SUB-ROUTINE PULLS THE HOUR/MINUTE TIME FROM TIMBUF AND
* CONVERTS IT INTO A BINARY, MINUTES FROM MIDNIGHT REPRESENTATION, AND
* STORES THE RESULT IN TIMBUF1
* ENTER WITH BAL,SR4. TIMBUF MUST HAVE HAD A M:TIME DONE INTO IT.
*
*
*
*  THE FIRST SECTION ASSUMES SR2 SET FROM M:TIME
*    NOTE THE SR1 IS NOT DESTROYED
*
         DO       FORSEC
TIMEVERT EQU      %
         LB,R3    SR2
         MI,R3    60*60             CVRT HRS TO SECS
         STW,R3   TIMBUF1           SAVE
         SLS,SR2  8                 GET MINS INTO PLACE
         LB,R3    SR2               GET MINS
         MI,R3    60                CVRT TO SECS
         AWM,R3   TIMBUF1           ACCRUE
         SLS,SR2  8                 GET SECS INTO PLACE
         LB,R3    SR2               GET SECS
         AWM,R3   TIMBUF1           ACCRUE
         B        *SR4              RETURN
         ELSE
TIMEVERT LI,R3    TIMBUF            CONVERT HOURS TO BINARY
         LI,R2    2
         BAL,SR3  DECBIN
         STW,R4   R3                MICKEY MOUSE FOR MI INSTRUCTION
         MI,R3    60                CONVERT HOURS TO MINUTES
         STW,R3   TIMBUF1           SAVE RESULT IN DATA AREA
         LW,D1    TIMBUF            AND GET MINUTES VALUE
         LW,D2    TIMBUF+1
         SLD,D1   24
         LI,R3    12
         LI,R2    2
         BAL,SR3  DECBIN
         AWM,R4   TIMBUF1
         B        *SR4
         FIN
* CONVERT CONVERTS A BINARY NUMBER IN REGISTER D1 TO A DECIMAL
* EBCDIC NUMBER IN REGISTERS D1 AND D2.  THE RETURN LINK IS CONTAINED
* IN REGISTER SR4.  CONTENTS OF REGISTERS R1 AND D4 ARE DESTROYED.
*
*
BINDCB   LI,R1    7                 CHARACTER COUNT AND BYTE POINTER
         LW,D4    D1                GET NUMBER
BINDCB1  LI,D3    0
         DW,D3    =10
         AI,D3    X'F0'             CONVERT REMAINDER TO EBCDIC AND
         STB,D3   D1,R1                PLACE INTO RESULT
         AI,R1    -1                LOOP UNTIL EBCDIC RESULT COMPLETED
         BGEZ     BINDCB1
         B        *SR4              RETURN
         PAGE
*        CHANGE   LEAD  ZEROS  INTO  BLANKS
*        D1-D2   = DCB   ALSO  ANSWER
*        D4,R1    USED
*
ZEROBK   LI,R1   -8                 CHARACTER COUNT AND BYTE POINTER
ZEROBK1  LB,D4    D1+2,R1           GET NEXT CHARACTER FROM LEFT
         CI,D4    '0'               IS IT A ZERO
         BNE      *SR4              IF NOT, EXIT
         LI,D4    ' '               IF IT IS, SUBSTITUTE A SPACE
         STB,D4   D1+2,R1
         CI,R1    -2                DON'T CONVERT LAST ZERO
         BE       *SR4
         BIR,R1   ZEROBK1
         B        *SR4
         PAGE
* THE BIN2HEX ROUTINE WILL CONVERT A BINARY BYTE TO THE PRINTABLE
* HEXIDECIMAL VALUE.
*   ENTER WITH RETURN LINK IN SR4 AND R2 CONTAINING THE BYTE TO BE
*   CONVERTED RIGHT-JUSTIFIED.
*   EXITS WITH THE RESULT IN R4 WITH LEADING SPACES
*
*
BIN2HEX  RES      0
         LI,R5    3                 INDEX OF RESULTANT BYTE
         LW,R4    BLANK             BLANK FILL RESULT
TAG      SLD,R2   -4                RIGHT JUSTIFY HEX NO. IN R3
         SLS,R3   -28
         LB,R3    HEX,R3
OUT      STB,R3   R4,R5             STORE BYTE INTO RESULT
         AI,R5    -1                DECREMENT INDEX
         BGEZ     TAG
         B        *SR4              OTHERWISE, EXIT
HEX      TEXT     '0123456789ABCDEF'
         PAGE
**********************************************************************
*                                                                    *
*        UPDATE LOGON FILE                                           *
*                                                                    *
**********************************************************************
UPDATE   RES      0
         PUSH     SR4               SAVE RETURN LINK
         LI,R7    1
         LI,R1    8                 BUILD KEY FOR LOGON FILE BY
         LI,R2    J:ACCN+Z             APPENDING USER NAME TO ACCOUNT
         LI,R3    0                    IN KEYBUFF. PUT KEY IN TEXTC
         BAL,SR4  APPEND               FORMAT
         LI,R1    12
         LI,R2    J:UNAME+Z         **LEFT FOR TESTING ONLY**
         LI,5     X'40'
         AI,3     1
         STB,5    KEYBUFF,3         INSERT BLANK AFTER ACCT
         BAL,SR4  APPEND
         STB,R3   KEYBUFF
         LI,D1    X'C0'
         STB,D1   JB:PRIV           TO BYPASS SECURITY CHECKS
OPENIT   RES      0
         CAL1,1   OPNLOGON          OPEN LOGON FILE
         CAL1,1   RDLOGON           KEY-READ USER'S RECORD
* UPDATE ACCUM. RAD SPACE AND ACCUM. DISK SPACE
*   SPACE USED=SPACE REMAINING AT LOGON - SPACE RMNG AT LOGOFF
*    + MEANS USED, - MEANS RELEASED
*     RAD
         REF      J:EXTENT,ALOCCT
         LB,R2    J:EXTENT+Z        SEE IF LIMIT HAS BEEN
         CI,R2    X'40'             .INCMTD BY EXIT CONTROL
         BAZ      NOEXR
         LW,R2    J:JIT+ALOCCT+Z    AMNT INCMTED SAVED THERE
         LI,R5    X'1FFFF'
         AND,R2   R5
         AW,R2    RADGRN
         B        NOEXR+1
NOEXR    EQU      %
         LW,R2    RADGRN
         SW,R2    JIT+PRDCRM+Z
         STW,R2   RADGRN            NOW ACCT.REC. HAS RAD SPACE USED BY JOB
         AWM,R2   LOGREC+LR:RAD
         BCR,1    %+3               :LOCICALLY,ACCUM. SPACE SHOULD
         LI,R2    0                 * BE >= 0,
         STW,R2   LOGREC+LR:RAD     * IF FOUND <0,SET TO 0
*     DISC
         LB,R2    J:EXTENT+Z        SAME AS ABOVE
         CI,R2    X'40'
         BAZ      NOEXD
         LW,R2    J:JIT+ALOCCT+Z
         LI,R5    X'1FFFF'
         AND,R2   R5
         AW,R2    DISGRN
         B        NOEXD+1
NOEXD    EQU      %
         LW,R2    DISGRN
         SW,R2    J:JIT+PRDPRM+Z
         STW,R2   DISGRN
         AWM,R2   LOGREC+LR:DIS
         BCR,1    %+3
         LI,R2    0
         STW,R2   LOGREC+LR:DIS
         CAL1,1   WRTLOGON          WRITE LOGREC
UPDATEX  CAL1,1   NORETURN          IGNORE ANY CLOSE ERRORS
         CAL1,1   CLSLOGON          CLOSE LOGON FILE
         PULL     SR4               GET RETURN LINK
         B        *SR4              EXIT
         PAGE
*
*        ROUTINE TO APPEND EBCDIC WORD POINTED TO BY R2 TO STRING
*        CONTAINED IN 'KEYBUFF.'  AT ENTRY, R1 CONTAINS MAX NO OF
*        BYTES IN TARGET WORD, R2 CONTAINS WA OF TARGET WORD, R3
*        CONTAINS BYTE DISPLACEMENT OF LAST CHARACTER ENTERED INTO
*        'KEYBUFF' (SHOULD BE 0 FIRST TIME THROUGH).
*        LINK IN SR4,    REGISTERS R4 AND R5 CLOBBERED
*
*
APPEND   RES      0
         LI,R4    0
APPENDLP LB,R5    *R2,R4            GET BYTE FROM SOURCE
         CI,R5    ' '               IS IT A SPACE
         BE       *SR4              IF IT IS, WE'RE DONE
         AI,R3    1                 INCREMENT INDEX, STORE CHARACTER
         STB,R5   KEYBUFF,R3
         AI,R4    1                 BUMP SOURCE INDEX
         BDR,R1   APPENDLP          LOOP
         B        *SR4              RETURN
*
*        COME HERE IF THERE IS AN ERROR WHEN OPENING LOGON FILE
*
OPENERR  RES      0
         LB,SR3   SR3               RIGHT JUSTIFY ERROR CODE
         CI,SR3   X'14'             SEE IF THE FILE WAS BUSY AND
         BE       LOGONBSY             BRANCH IF IT IS
         CI,SR3   X'2E'
         BE       LOGONBSY
         CI,SR3   X'4C'
         BE       LOGONBSY
         LI,R2    Z                 DON'T SEND MESSAGE IF RECOVERY OR   U:AC0078
         BNEZ     UPDATEX              GHOST JOB                        U:AC0079
         LH,R2    J:JIT+Z                                               U:AC0080
         CI,R2    X'4000'                                               U:AC0081
         BANZ     UPDATEX                                               U:AC0082
         SETERROR SR3
         SEND     OPNLGNM,ERRCODEM     TELL OPERATOR
         B        UPDATEX           EXIT FROM UPDATE
*
*        COME HERE IF LOGON FILE IS BUSY
*
LOGONBSY RES      0
         DO1      FORUTS
         CAL1,8   WAIT              WAIT FOR 1 SECOND
         B        OPENIT            TRY AGAIN
*
*        COME HERE IF ERROR WHILE READING OR WRITING LOGON RECORD
*
READERR  RES      0
         LH,R2    J:JIT+Z           DON'T SEND ERROR MESSAGE IF GHOST   U:AC0084
         CI,R2    X'4000'              JOB                              U:AC0085
         BANZ     UPDATEX                                               U:AC0086
         LB,R2    SR3               PUT ERROR CODE IN R2
         SETERROR R2
         SEND     RWLOGONM,ERRCODEM    TELL OPERATOR
         B        UPDATEX           EXIT FROM DISPLY
         PAGE
*
*        COME HERE IF ERROR WHILE READING ASSIGN-MERGE RECORD
*        INDICATE THE CONDITION UNDER WHICH THE ACCT. REC. WAS GENERATED.
*        FLAGS ARE SET IN BYTE 0 OF MAXRES (WORD 38 OF ACCT.
*        REC.) AS FOLLOWS.
*        AS FOLLOWS.
*        NORMAL CONDITION           VALUE=0
*        RECOVERY CONDITION              =1
*        A/M READ ERROR                  =2
*        A/M READ ERROR DURING RECOVERY  =3
*
AMERR    RES      0
         LI,R0    Z                 IS IT A/M READ ERROR DURING RECVRY.
         BNEZ     AMERR5            YES
         LI,R2    2                 NO
         STB,R2   MAXRES
         LI,D1    X'15'             MOVE MESSAGE TO BUFFER
         STB,D1   MESSAGE
         LB,R2    AMERMSG
         LB,D1    AMERMSG,R2
         STB,D1   MESSAGE,R2
         BDR,R2   %-2
         LB,R4    AMERMSG
         AI,R4    1                 INCREMENT COUNT
         M:SETDCB M:LL,(ERR,LERR),(ABN,LERR)
         CAL1,1   BLIST             MESSAGE TO USER
         B        BYPASS
AMERR5   RES      0
         LI,R2    3
         STB,R2   MAXRES
         B        BYPASS
         PAGE
**********************************************************************
*        RELSTARF - RELEASE STAR(*) FILES AND TEMPORARY FILES.       *
*                                                                    *
*                 RELEASES ALL  *SYSID  FILES AND  ALL OTHER         *
*                                                                    *
*                 TEMPORARY FILES CREATED DURING JOB                 *
*                                                                    *
*                                                                    *
**********************************************************************
RELSTARF RES      0
         PUSH     7,R5              SAVE REGS 5,6,7,8,9,10,11
         LCI      5
         LM,0     J:STAR+Z
         STM,0    J:STAR
         LI,R6    NSTARF            (R6) = NUMBER OF  *SYSID FILES
RELSTRF2 RES      0
STAR     SET      1
         DO       STAR=1
         LB,R3    STRTBL,R6         * FILE INDEX
         LW,R2    J:STAR+0,R3
         REF      J:STAR
         BEZ      RELSTRF4
         FIN
         LI,R2    1                 FUNCTION=IN MODE
         LI,R3    2                 ORGANIZATION=KEYED
         LB,R4    STARFTBL,R6       GET A FILE NAME FROM THE TABLE
         CI,R4    'N'               IS IT LOAD&LINK
         BNE      %+2               SKIP IF NOT
         STCF     J:STAR+5          SET THE ACCESS BIT
         SLD,D1   64                CLEAR ACCOUNT, PASSWORD POINTERS    U:AC0088
         STD,D1   D3                CLEAR ERROR,ABNORMAL RETURN POINTERSU:AC0090
         BAL,SR4  OPNSTARF          OPEN *SYSID  FILE
         CI,SR3   0                 CHECK IF OPENED
         BNE      RELSTRF4          NO;GO RELEASE ANOTHER FILE
         DO1      FORUTS
         CAL1,1   CLSSTARF          CLOSE AND RELEASE FILE
RELSTRF4 RES      0
         BDR,R6   RELSTRF2
*
*
         DO       STAR=1
         LW,R2    J:STAR+4+Z
         BEZ      RELTMPF8          NO T FILES
         FIN
*
         LI,R2    1                 SET FUNCTION TO IN MODE
         LI,R3    2                 SET ORG TO KEYED
         LI,R4    'T'               SET NAME TO T
         LI,D3    RELTMPFE          ERR ADR FOR DCB
         LI,D4    RELTMPFA          ABN ADR  FOR DCB
         BAL,SR4  OPNSTARF          OPEN FILE *SYSIDT
         CI,SR3   0                 CHECK IF OPENED
         DO1      FORUTS
         BNE      RELTMPF8          NO
         DO1      FORBTM
         B        RELTMPF8
RELTMPF2 RES      0
         LW,R1    Y0038
         STS,R1   J:JIT+PUF
         DO1      FORUTS
         CAL1,1   RDTMPFLT          READ FILE  *SYSIDT
         LI,R1    M:EO              ADR OF M:EO DCB
         LI,R2    1                 SET FUNC. TO IN
         LI,R3    1                 SET ORG.  TO CONSEC
         LW,R4    M:X1+KBUF         (R4) = ADR OF FILENAME TO BE REL.
         SLD,D1   64                SET ACCN ADR AND PASSW ADR = 0
         STD,D1   D3                SET ERR-ABN ADR'S = 0
         BAL,SR4  OPNF              OPEN TEMPORARY FILE
         CI,SR3   0                 CHECK IF OPENED
         BNE      RELTMPF2          NO
         DO1      FORUTS
         CAL1,1   CLSTMPF           YES, CLOSE AND RELEASE
         B        RELTMPF2
*
*
*
RELTMPFE RES      0
RELTMPFA RES      0
         LB,SR3   SR3               (SR3) = I/O ERR/ABN CODE
         CI,SR3   6                 CHECK IF EOF IN *SYSIDT
         BNE      RELTMPF2          NO
         LW,R5    Y0038
         EOR,R5   J:JIT+PUF
         STW,R5   J:JIT+PUF
         DO1      FORUTS
         CAL1,1   CLSSTARF          CLOSE AND RELEASE *SYSIDT
RELTMPF8 RES      0
         PULL     7,R5              RESTORE SAVED REGISTERS
         B        *SR4              EXIT TO MAIN PROGRAM
         PAGE
*
*        READ PLIST  FOR FILE  *SYSIDT
*
RDTMPFLT RES      0
         GEN,8,24 X'10',M:X1        READ *SYSIDT
         DATA     X'F0000010'       P1,P2,P3,P4,F8
         DATA     RELTMPFE          ERROR RETURN POINTER
         DATA     RELTMPFA          ABNORMAL RETURN POINTER
         DATA     %                 BUFFER ADDRESS (DUMMY)
         DATA     0                 BUFFER SIZE
*
*        CLOSE  PLIST  FOR   *SYSID  FILES
*
CLSSTARF RES      0
         GEN,8,24 X'15',M:X1        CLOSE *SYSIDT
         DATA     X'80000000'       P1
         DATA     1                 RELEASE FILE
*
*        CLOSE  PLIST  FOR   OTHER TEMPORARY FILES
*
CLSTMPF  RES      0
         GEN,8,24 X'15',M:EO        CLOSE FILE
         DATA     X'80000000'       P1
         DATA     1                 RELEASE FILE
*
*        STAR  FILE  NAME   TABLE
*
STARFTBL RES      0
         DATA,1   0
         DATA,1   'N'  FOR LNKTRC FILES
         DATA,1   'B'               PRESENT ONLY IF BI ON !LOAD CARD
         DATA,1   'D'               DEBUG-PMD & SNAP CARDS
         DATA,1   'G'               GO FILE=RUN FILE FOR BATCH
         DATA,1   'L'               LOAD INFORMATION
NSTARF   EQU      BA(%)-BA(STARFTBL)-1
         BOUND    4
         DO       STAR=1
STRTBL   DATA,1   0
         DATA,1   5 N
         DATA,1   0 B
         DATA,1   1 D
         DATA,1   2 G
         DATA,1   3 L
         BOUND    4
         FIN
         PAGE
*
*        PLIST FOR POSITIONING TO END OF FILE
*
PEOF     RES      0
         GEN,8,24 X'1C',M:SL        POSITION :LOG TO END OF FILE
         DATA     0                 NO PRESENCE BITS
         DO       FORBTM
*
*        PLIST FOR SIMULATING 'SENDOPMS' CAL
*
FAKEOPMS GEN,8,24 X'11',M:SO        SEND OP MSGS TO TERMINAL IF BTM
         DATA     X'34000000'       P3,P4,P6
         GEN,1,31 1,R2              BUFFER ADDRESS IN R2
         GEN,1,31 1,SR4             BUFFER SIZE IN SR4
         DATA     1                 BTD = 1
         FIN
*
* PLIST  TO SEND THE OPERATOR A MESSAGE
*
SENDOPMS GEN,8,24 X'0',0            SEND MESSAGE TO OPERATOR
         DATA     X'80000000'       P1
         GEN,1,31 1,R2              BUFFER ADDRESS IN R2
*
* PLIST FOR OPENING LOGON FILE
*
OPNLOGON GEN,8,24 X'14',M:EO        OPEN LOGON FILE                     U:AC0094
         DATA     X'CF480219'       P1,2,5,6,7,8,10,13  F3,8,9,12
         DATA     OPENERR           ERROR RETURN ADDRESS
         DATA     OPENERR           ABNORMAL RETURN ADDRESS
         DATA     10                MAX RETRIES
         DATA     2                 ORGANIZATION KEYED
         DATA     2                 DIRECT ACCESS
         DATA     4                 INOUT MODE
         DATA     2                 SAVE
         DATA     21                MAX KEY LENGTH
         DATA     X'07000000'       NULLIFY SN THAT MIGHT BE CARRIED
         DATA     X'08000000'       OVER FROM PREV. ACT. THGH M:EO DCB
         DATA     X'01000202'       FILE NAME
         TEXTC    ':USERS'
         DATA     X'02000202'       ACCOUNT NUMBER
         DO1      FORUTS
         TEXT     SYSACCNT
         DO1      FORBTM
         TEXT     BTMACCN
         DATA     X'03000202'       PASSWORD
         DATA     X'DFEF803F'
         DATA     X'AFC0BF9F'
         DATA     X'05010101'       READ ACCOUNT NUMBERS
         TEXT     'NONE'
*
* PLIST FOR READING LOGON FILE
*
RDLOGON  GEN,8,24 X'10',M:EO        READ LOGON RECORD                   U:AC0096
         DATA     X'FC000010'       P1,P2,P3,P4,P5,P6,F3
         DATA     READERR           ERROR RETURN ADDRESS
         DATA     READERR           ABNORMAL RETURN ADDRESS
         DATA     LOGREC            BUFFER ADDRESS
         DATA     LOGRECSZ*4        RECORD SIZE
         DATA     KEYBUFF           KEY BUFFER
         DATA     0                 BYTE DISPLACEMENT
*
* PLIST FOR WRITING LOGON FILE
*
WRTLOGON GEN,8,24 X'11',M:EO        WRITE LOGON RECORD                  U:AC0098
         DATA     X'3C000000'       P3,P4,P5,P6
         DATA     LOGREC            BUFFER ADDRESS
         DATA     LOGRECSZ*4        RECORD SIZE
         DATA     KEYBUFF           KEY BUFFER
         DATA     0                 BYTE DISPLACEMENT
*
* PLIST FOR CLOSING LOGON FILE
*
CLSLOGON GEN,8,24 X'15',M:EO        CLOSE LOGON FILE                    U:AC0100
         GEN,1,31 1,0               P1
         DATA     2                 SAVE
*
* PLIST FOR IGNORING ERROR RETURNS
*
NORETURN GEN,8,24 X'06',M:EO        SETDCB FOR LOGON FILE DCB           U:AC0102
         DATA     X'C0000000'       P1,P2
         DATA     RETURN            ERROR RETURN
         DATA     RETURN            ABNORMAL RETURN
*
* PLIST FOR GETTING 1 PAGE
*
GETPAGE  GEN,8,24   X'08',1
*
* PLIST FOR RELEASING 1 PAGE
*
RELPAGE  GEN,8,24   X'09',1
*
* PLIST FOR READING THE ASSIGN-MERGE RECORD
*
RAMREC   GEN,8,24   X'2D',M:EO
         GEN,4,28   3,0
         GEN,1,31   1,SR2           BUFFER ADDRESS IN SR2 FROM GET PAGE
         GEN,32   512*4             BUFFER SIZE=1 PAGE
         PAGE
**********************************************************************
*                                                                    *
*        OPNSTARF -  OPEN  STAR    FILE   (*SYSIDX)                  *
*                                                                    *
*        ENTER WITH                                                  *
*                 (R2) = FUNCTION                                    *
*                 (R3) = ORGANIZATION                                *
*                 (R4) = LETTER NAME OF FILE (A,B,D,G,L,OR T)        *
*                 (R5) = JIT ADR                                     *
*                 (D3) = ERROR ADR  TO BE PUT IN DCB IF OPENED       *
*                 (D4) = ABNORMAL   ADR TO BE PUT IN DCB IF OPENED   *
*        EXIT WITH                                                   *
*                 (R1) = ADR OF M:X1  DCB                            *
*                 (R2) = FUNCTION FILE OPENED IN  IF OPENED          *
*                 (SR3) =  0  IF FILE OPENED                         *
*                 (SR3) =  I/O  ERROR OR ABNORMAL IF NOT OPENED      *
*                                                                    *
*        IF FUNCTION  SPECIFIED IS INOUT AND FILE DOES NOT EXIST,    *
*                 FILE IS OPENED IN OUT MODE                         *
*                                                                    *
*                                                                    *
*                                                                    *
OPNSTARF RES      0
         PUSH     SR4
         LI,R1    M:X1              (R1) = ADR OF M:X1 DCB
         LI,D1    X'FFFF'           GET CURRENT SYSTEM ID NUMBER
         AND,D1   SYSID+J:JIT
         AI,D1    X'30000'          ADD BYTE COUNT
         SLS,D1   8
         AW,D1    R4
         PUSH     D1
         LW,R4    TEMPSTAK
         LI,D2    0
         LI,D1    0
         BAL,SR4  OPNF              OPEN  STAR FILE
         PULL     R4
         PULL     SR4
         B        *SR4              EXIT
         PAGE
* ON ERROR OR ABNORMAL WHEN WRITING M:U DCB FORCE OUTPUT TO
* LINE PRINTER UNLESS ALREADY ATTEMPTED. OTHERWISE RETURN.
*
LERR     EQU      %
         PUSH     5
         LI,5     -1
         XW,5     RECORD
         CI,5     -1
         BE       GETOUT
         PUSH     SR1               SAVE RETURN. SR1 GETS CLOBBERED.
         LI,5     1                 #5733
         LC       M:LL,5            #5733
         BCR,2    %+2
         M:CLOSE  M:LL
         CAL1,1   OPNLP             #5733
         PULL     SR1
         PULL     5
         AI,8     -1
         B        *8
GETOUT   EQU      %
         PULL     R5
         B        *SR1
*                                                               #5733
*                                                               #5733
*                                                               #5733
OPNLP    EQU      %                                             #5733
         GEN,8,24 X'14',M:LL                                    #5733
         DATA     X'40000'                                      #5733
         DATA     X'D3D7'           LP                          #5733
         PAGE
**********************************************************************
*                                                                    *
*        OPNF -   OPEN  FILE  ROUTINE                                *
*                                                                    *
*                 OPENS SPECIFIED DCB TO SPECIFIED FILE              *
*                                                                    *
*        ENTER WITH                                                  *
*                 (R1) = ADR OF DCB                                  *
*                 (R2) = FUNCTION                                    *
*                 (R3) = ORGANIZATION                                *
*                 (R4) = ADR OF FILE NAME                            *
*                 (R5) = ADR OF JIT                                  *
*                 (D1) = ADR OF ACCOUNT NUMBER OR 0                  *
*                 (D2) = ADR OF PASSWORD OR 0                        *
*                 (D3) = ERROR ADR TO BE PUT IN DCB IF OPENED        *
*                 (D4) = ABNML ADR TO BE PUT IN DCB IF OPENED        *
*                                                                    *
*        EXIT WITH                                                   *
*                 (SR3)=  0  IF DCB  OPENED                          *
*                 (SR3)=  I/O ERROR OR ABNORMAL  CODE IF NOT OPENED  *
*                                                                    *
*        IF  FUNCTION  SPECIFIED IS INOUT AND FILE DOES NOT EXIST,   *
*                 IT IS OPENED IN THE OUT MODE                       *
*                                                                    *
*                                                                    *
OPNF     RES      0
         PUSH     2,R6
         BUMP     OPNPLSIZ,R7       RES. SPACE FOR OPEN PLIST
         LW,R7    TEMPSTAK
         AI,R7    -OPNPLSIZ+1       (R7) = ADR OF OPEN PLIST
         LI,R6    0
         PUSH     4,D1
         LI,D1    OPNPLSIZ
OPNF2    RES      0
         LW,D2    OPNFPLST,R6       MOVE STATIC PLIST
         STW,D2   *R7,R6                          TO TEMP STACK
         AI,R6    1
         BDR,D1   OPNF2
*
         LB,D1    *R4               (D1) = NO. OF BYTES IN FILE NAME
         AI,D1    4
         SLS,D1   -2                (D1) = NO.OF WORDS IN FILE NAME
         LW,D2    R7
         AI,D2    OPNPLFLN          (D2) = ADR OF FILE NAME IN PLIST
         LI,R6    2
         STB,D1   *D2,R6
         AI,D2    1
         LI,R6    0
OPNF4    RES      0
         LW,D3    *R4,R6            MOVE FILE NAME
         STW,D3   *D2,R6                            TO PLIST
         AI,R6    1
         BDR,D1   OPNF4
         STW,R3   OPNPLORG,R7       STORE  ORGANIZATION IN PLIST
         PULL     4,D1
         CI,D1    0
         BE       OPNF6
         LW,R3    *D1
         STW,R3   OPNPLACN+1,R7
         AI,D1    1
         LW,R3    *D1
         STW,R3   OPNPLACN+2,R7
         LI,R3    X'200'
         AWM,R3   OPNPLACN,R7
         CI,D2    0
         BE       OPNF6
         AWM,R3   OPNPLPSW,R7
         LW,R3    *D2
         STW,R3   OPNPLPSW+1,R7
         AI,D2    1
         LW,R3    *D2
         STW,R3   OPNPLPSW+2,R7
OPNF6    RES      0
         LI,SR3   0
         STW,R2   OPNPLFUN,R7       STORE  FUNCTION IN PLIST
         LI,D1    OPNPLSIZ
         DO       FORUTS
         CAL1,1   *R7               OPEN  DCB
         CAL1,1   SETDCB            SET ERR AND ABN ADR IN DCB
         FIN
*
OPNF8    RES      0
         BUMP     -OPNPLSIZ,D1      FREE PLIST STORAGE
         PULL     2,R6
         B        *SR4              EXIT
         PAGE
*
*        HANDLES  ERROR AND ABNORMAL  RETURNS FROM OPEN
*
*
OPNFERAB RES      0
         LB,SR3   SR3               (SR3) = I/O ERR/ABN CODE FROM OPEN
         CI,SR3   3                 CHECK IF FILE DOES NOT EXIST
         BNE      OPNF8             NO
         CI,R2    4                 YES, CHECK IF OPENING IN INOUT MODE
         BNE      OPNF8             NO
         LI,R2    2                 YES, TRY TO OPEN IN OUT MODE
         B        OPNF6
         PAGE
*
*        OPNF  PLIST
*
*
OPNFPLST RES      0
         GEN,1,7,24  1,X'14',1      CODE, DCB ADR
         DATA     X'CFC800F1'       PLIST INDICATORS
         DATA     OPNFERAB          ERR ADR
         DATA     OPNFERAB          ABN ADR
         DATA     10                TRIES
OPNPLORG EQU      %-OPNFPLST
         DATA     0                 ORG
         DATA     2                 ACCESS
OPNPLFUN EQU      %-OPNFPLST
         DATA     0                 FUNCTION
         DATA     0                 GEN
         DATA     2                 FILE
         DATA     31                KEYM
OPNPLFLN EQU      %-OPNFPLST
         DATA     X'01000008'       FILE NAME
         RES      8
OPNPLACN EQU      %-OPNFPLST
        DATA      X'02000002'       ACCOUNT
         DATA     0
         DATA     0
OPNPLPSW EQU      %-OPNFPLST
         DATA     X'03000002'       PASSWORD
         DATA     0
         DATA     0
         DATA     X'04000000'       EXPIRE DATE
         DATA     X'05000000'       READ ACCN
         DATA     X'06000000'       WRITE ACCN
         DATA     X'07000000'       INSN
         DATA     X'08010000'       OUTSN
OPNPLSIZ EQU      %-OPNFPLST
         PAGE
*
*        SETDCB   PLIST
*
*
SETDCB   RES      0
         DATA     X'86000001'       SETDCB TO DCB POINTED TO IN R1
         DATA     X'C0000000'       P1,P2
         GEN,1,31 1,D3              ERROR RETURN ADDRESS IN D3
         GEN,1,31 1,D4              ABNORMAL RETURN ADDRESS IN D4
*
*        COME HERE IF ERROR RETURNS ARE TO BE IGNORED
*
RETURN   RES      0
         B        *SR1              RETURN TO CAL + 1
         PAGE
*THE NUMPT ROUTINE PERFORMS A SEARCH ON JB:MAX,SB:RTY AND TB:FLGS TO
*DETERMINE MAX. NUMBER OF PACKS AND TAPES ALLOCATED FOR THIS JOB.
* INPUT  JB:MAX,SB:RTY,TB:FLGS,SV:RSIZ
*        OUTPUT   D3 - NUMBER OF TAPES
*                 D4 - NUMBER OF PACKS
*        ENTER    BAL,SR4  NUMPT
*        REG.USED D3,D4,R1,R7,SR3,SR4
*
NUMPT    RES      0
         PUSH     2,SR3
         LI,D3    0
         LI,D4    0
         LI,R1    SV:RSIZ           GET RESOURCE LIMIT TABLE SIZE
         LI,SR3   JB:MAX+Z          IF BATCH, USE RES. VALUES FROM JB:MAX
NUMPT2   RES      0
         LB,SR4   *SR3,R1           GET RESOURCE VALUE
         AND,SR4  X7F               AND OUT ALLOC. IN PROCESS BIT
         BEZ      NUMPT8            WAS RESOURCE ALLOCATED
         LB,R7    SB:RTY,R1         IS IT PACK OR TAPE
         CI,R7    TYPMNSZ           IGNORE PSEUDO-RESOURCES
         BG       NUMPT8
         LC       TB:FLGS,R7
         BCR,8    NUMPT8            NO
         BCS,4    NUMPT6
         AW,D3    SR4               ITS TAPE
         B        NUMPT8
NUMPT6   RES      0
         AW,D4    SR4               ITS PACK
NUMPT8   RES      0
         BDR,R1   NUMPT2            GET NEXT VALUE
         PULL     2,SR3
         B        *SR4
         PAGE
*THE PUTBUF ROUTINE STORES A SPECIFIED NO. OF BYTES IN BUFFER CALLED
*MESSAGE
*        INPUT    R6 - BUFFER INDEX
*                 D1,D2 - DATA TO BE STORED
*                 R7 - NO. CHARS TO STORE
*        OUTPUT   DATA TO BUFFER (MESSAGE)
*                 R6 - BUFFER INDEX INCREMENTED
*        ENTER    BAL,SR4  PUTBUF
*        REG.USED D3
*
PUTBUF   RES      0
         LCW,R7   R7
PUTBUF5  RES      0
         LB,D3    D1+2,R7           PICK UP CHAR.
         STB,D3   MESSAGE,R6        STORE INTO BUFFER
         AI,R6    1
         BIR,R7   PUTBUF5
         B        *SR4
         PAGE
*THE WRTBUF ROUTINE PRINTS BUFFER CONTENTS THEN BLANKS OUT BUFFER
*        INPUT    BUFFER (MESSAGE)
*        OUTPUT   LINE TO PRINTER IF BATCH
*                 BLANKS TO BUFFER
*        ENTER    BAL,SR4  WRTBUF
*        REG.USED R1,D3
*
WRTBUF   RES      0
         LC       J:JIT+Z           IS IT BATCH
         BCS,12   *SR4
         CAL1,1   JLIST             YES, PRINT THE LINE
WRTBUF5  RES      0
         LW,D3    BLANK             BLANK FILL MESSAGE AREA
         LI,R1    10
         STW,D3   MESSAGE-1,R1
         BDR,R1   %-1
         B        *SR4
         PAGE
SECTION3 DSECT    0
*
* THE FOLLOWING IS ORGANIZED AS CONTEXT AREA FOR LOG-ON. IT IS USER
* ORIENTED AND ROLLS WITH THE USER.
*
LOGSIZE  EQU      126               MAXIMUM SIZE OF RECORD BUFFER
RECORD   RES      0
         ZERO     LOGSIZE
UNME     RES      0
         ZERO     3
UACCOUNT RES      0
         ZERO     3
UPASSWD  RES      0
         ZERO     3
KEYBUFF  RES      0
         ZERO     6
TIMBUF   RES      0
         ZERO     5
RECSIZE  EQU      %-RECORD-1
MINUTES  RES      1
RATEFLAG DATA     -1                RATE TABLE INDICATOR
ERRTRY   DATA     0
LISTLOC  RES      25
MESSAGE  RES      33                MESSAGE BUFFER
OPMES    TEXT     ' LINE#  ,   '
         SPACES   6
ERRCODEM RES      0
         TEXTC    'ERROR CODE =   '
ACCOUNT  RES      0
         SPACES   32
         ZERO     1
         SPACES   5
         GEN,8,24 0,'   '
         SPACES   3
CPU      DATA,1   X'15'
         DATA,3   'CPU'
         TEXT     ' =  '
CPUV     TEXT     '    '            FILLED
         TEXT     '    '            FILLED
         TEXT     '  CO'
         TEXT     'N=  '
CONV     TEXT     '    '            FILLED
         TEXT     '    '            FILLED
         TEXT     ' INT'
         TEXT     ' =  '
INTV     TEXT     '    '
         TEXT     ' CHG'
         TEXT     ' =  '
CHGV     TEXT     '    '            FILLED
         TEXT     '    '            FILLED
         DATA     0                 END OF MESSAGE
         BOUND    8
TEMPSTAK DATA     STACK-1
         GEN,16,16  100,0                                               U:AC0104
STACK    RES      0
         ZERO     100                                                   U:AC0106
LOGREC   RES      0
         ZERO     LOGRECSZ
TIMBUF1  DATA     0
UEXTACC  RES      0
         SPACES   6
PATCH    RES      0
         ZERO     100
         END

