***********************************************************************
*P*      NAME:    ACCTSUM
***********************************************************************
*P*
*P*      PURPOSE: TO PERFORM THOSE FUNCTIONS NECESSARY TO TERMINATE AN
*P*               ON-LINE SESSION OR BATCH JOB. THESE FUNCTIONS INCLUDE
*P*               CLOSING AND RELEASING THE USER'S TEMPORARY AND STAR
*P*               FILES, DISPLAYING AND LOGGING THE USER'S ACCOUNTING
*P*               INFORMATION, AND UPDATING THE PERMANENT RAD AND DISK
*P*               PACK IN THE USER'S LOG-ON RECORD.
*P*
*P*      DESCRIPTION: THE ACCTSUM SUBROUTINE IS LOADED WITH TWO MODULES,
*P*               LOGON AND GHOST1 AND COMPRISED OF THREE MAIN SUBROUTINES:
*P*                RELSTARF, UPDATE, AND DISPLY. ACCTSUM GENERATES AN
*P*               ACCOUNTING RECORD FOR EACH USER IN :ACCTLG USING
*P*               INFORMATION OBTAINED FROM THE JIT,ASSIGN-MERGE RECORD
*P*               AND :RATE FILE. FOR EACH BATCH USER, AN ACCOUNTING
*P*               SUMMARY IS OUPUT TO THE DEVICE ASSIGNED TO M:LL.
*P*               INSTALLATIONS HAVE THE OPTION OF MODIFYING THE ACCOUNTING
*P*               RECORD OR DETERMINING WHETHER IT SHOULD BE INCLUDED
*P*               IN :ACCTLG VIA THE SREF M:ACTERM. ACCUMULATED
*P*               RAD AND DISK SPACE IS STORED INTO THE USER'S LOG-ON
*P*               RECORD FOR FUTURE DETERMINATION OF AVAILABLE RAD AND
*P*               PACK SPACE. ALL STAR AND TEMPORARY FILES GENERATED
*P*               DURING THE SESSION ARE RELEASED.
*P*
*P*      REFERENCE: DATA BASE TECHNICAL MANUAL
*P*               BATCH PROCESSING REFERENCE MANUAL
*P*               SYSTEM MANAGEMENT REFERENCE MANUAL
*P*
         PCC      0
         PSR      0
         TITLE    'CP-V ACCNTSUM'
         PAGE
         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)
         CAL1,2   SENDOPMS          SEND MSG TO OPERATOR
         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
         DEF      TEMPSTAK          INPUT/OUTPUT; PRESERVE REGISTERS
         DEF      TIMEVERT          CONVERT TIME TO MINUTES FROM
*,*                                 MIDNIGHT REPRESENTATION IN BINARY
         DEF      TIMBUF1           LOGON TIME
         DEF      RECORD            BUFFER FOR :USERS RECORD AT LOGON
*,*                                 TIME
*,*                                 BUFFER FOR RATES FILE AT LOGOFF TIME
         DEF      DECBIN            CONVERT DECIMAL EBCDIC VALUE TO BINARY
         DEF      BINDCB            CONVERT BINARY VALUE TO DECIMAL EBCDIC
         DEF      ZEROBK            CONVERT LEADING ZEROS TO BLANK
         DEF      CPU               CPU TIME
         DEF      ACCOUNT           ACCOUNTING RECORD BUFFER
         DEF      ERRCODEM          TEXT MESSAGE WHICH INCLUDES ERROR
*,*                                 CODE
         DEF      BIN2HEX           CONVERT BINARY VALUE TO HEXADECIMAL
         DEF      ACCNTSUM          ENTRY POINT TO MODULE
         DEF      TIMBUF            BUFFER FOR SAVING USER'S LOGON
*,*                                 TIME
         DEF      UACCOUNT          BUFFER FOR SAVING USER'S
*,*                                 ACCOUNT
         DEF      UPASSWD           BUFFER FOR SAVING USER'S PASSWORD
         DEF      UNME              CURRENT USERS NAME
         DEF      UEXTACC           BUFFER FOR SAVING USER'S EXTENDED
*,*                                 ACCOUNTING
*,*                                 ACCOUNTING
         DEF      KEYBUFF           BUFFER CONTAINING KEY FOR READING
*,*                                 :USER'S RECORD
         DEF      RECSIZE           EQU; SIZE OF CONTEXT AREA
         DEF      ERRTRY            BUFFER FOR SAVING COUNT OF LOGON
*,*                                 ATTEMPTS
         DEF      NATRYS            CELL TO RETAIN COUNT OF LOGON
*,*                                 ATTEMPTS WITH INCORRECT NAME
*,*                                 AND ACCOUNT
         DEF      PATRYS            CELL TO RETAIN COUNT OF LOGON
*,*                                 ATTEMPTS USING INCORRECT
*,*                                 PASSWORD
         DEF      USERMSG           TEXT CONTAINING USER ID AND LINE #
         DEF      LISTLOC           BUFFER USED BY LOGON FOR HOLDING
*,*                                 WRITE FPT
         DEF      OPMES             TEXT MESSAGE SENT TO OPERATOR
         DEF      PATCH             PATCH AREA
         DEF      RATEFLAG          RATE FILE READ FLAG
         DEF      SENDOPMS          SEND MESSAGE TO OPERATOR
         SREF     M:ACTERM          INPUT; ADDRESS OF INSTALLATION'S JOB
*,*                                 INITIATION ACCOUNTING ROUTINE
         REF      J:JIT             INPUT/OUTPUT; USER INFORMATION
         REF      P:JIT             EQU; EQUATED TO J:JIT IN LOGON
         REF      M:X1              DCB USED FOR READING STAR T FILE
         REF      CIC               EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 CARD INPUT COUNT FOR ACCOUNTING
         REF      CPO               EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 CARDS PUNCHED FOR ACCOUNTING
         REF      CPPO              EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 PROCESSOR PAGES OUTPUT FOR ACCOUNTING
         REF      CUPO              EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 USER PAGES OUTPUT FOR ACCOUNTING
         REF      CDPO              EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 NUMBER OF DIAGNOSTIC PAGES OF OUTPUT
*,*                                 FOR ACCOUNTING
         REF      TPACCESS          EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 TAPE ACCESSES FOR ACCOUNTING
         REF      DCACCESS          EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 DISC ACCESSES FOR ACCOUNTING
         REF      DPACCESS          EQU; DISPLACEMENT IN JIT TO OBTAIN
*,*                                 DISC PACK ACCESSES FOR ACCOUNTING
         REF      JB:PRIV           OUTPUT; PRIVILEGE INCREASED TO C0
*,*                                 FOR READING :USERS/:ACCTLG FILES
         REF      J:ACCN            OUTPUT; USED TO OBTAIN OBJECT JIT'S
*,*                                 ACCOUNT IN GHOST1
         REF      PRT               INPUT; OBTAIN PRIORITY FOR ACCOUNTING
*,*                                 RECORD
         REF      JB:ALN            GET ACTUAL LINE NUMBER FOR TIMED
*,*                                 OUT SAVED IMAGES
         REF,1    JB:TMTS           INPUT; OBTAIN TAPES MOUNTED FOR
*,*                                 ACCOUNTING RECORD AND SUMMARY
         REF,1    JB:PMTS           INPUT; PACKS MOUNTED FOR ACCOUNTING
*,*                                 RECORD AND SUMMARY
         REF      JB:MAX            INPUT; OBTAIN MAXIMUM RESOURCES
*,*                                 ALLOCATED FOR ACCOUNTING RECORD
*,*                                 AND SUMMARY
         REF,1    JB:STEP           INPUT; OBTAIN JOB STEPS FOR
*,*                                 ACCOUNTING RECORD
         REF,1    JB:ORG            INPUT; OBTAIN JOB ORIGIN FOR ACCOUNTING
*,*                                 RECORD
         REF,1    JB:PEAK           INPUT; OBTAIN PEAK CORE FOR ACCOUNTING
*,*                                 RECORD AND SUMMARY
         REF,1    JB:PNR            INPUT; OBTAIN PARTITION NUMBER FOR
*,*                                 ACCOUNTING SUMMARY AND RECORD
         REF,1    JB:FRS            INPUT; OBTAIN FINAL RUN STATUS
*,*                                 FOR ACCOUNTING RECORD
         REF      TMPDCPK           INPUT; OBTAIN PEAK TEMPORARY RAD
*,*                                 SPACE FOR ACCOUNTING RECORD AND SUMMARY
         REF      TMPDPPK           INPUT; OBTAIN PEAK TEMPORARY DISK
*,*                                 SPACE FOR ACCOUNTING RECORD AND
*,*                                 SUMMARY
         REF      PRDCRM            INPUT; OBTAIN AVAILABLE RAD PERMANENT
*,*                                 FOR :USERS RECORD AND SUMMARY
         REF      PRDPRM            INPUT; OBTAIN AVAILABLE DISK
*,*                                 PERMANENT FOR :USERS RECORD AND
*,*                                 SUMMARY
         REF      TMDCRM            INPUT; OBTAIN TEMPORARY RAD SPACE
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      TMDPRM            INPUT; OBTAIN TEMPORARY DISK SPACE
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      SB:RTY            INPUT; DETERMINE IF PACK OR TAPE
         REF      TB:FLGS           INPUT; DETERMINE IF RESOURCE IS
*,*                                 PACK OR TAPE
         REF      SV:RSIZ           EQU; RESOURCE NAME TABLE SIZE
         REF      SH:RNM            INPUT; OBTAIN RESOURCE NAMES FOR
*,*                                 SUMMARY
         REF      TYPMNSZ           EQU; IGNORE PSEUDO-RESOURCES
         REF      M:LL              DCB USED FOR WRITING ACCOUNTING
*,*                                 SUMMARY
         REF      M:EO              DCB USED FOR READING/WRITING :USERS
*,*                                 FILE AND READING ASSIGN-MERGE REC'D
         REF      M:UC              DCB USED FOR OUTPUTTING ACCOUNTING
*,*                                 DISPLAY TO USER
         REF      J:UTIME           INPUT; OBTAIN TOTAL EXECUTION TIME
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      J:PTIME           INPUT; OBTAIN PROCESSOR EXECUTION
*,*                                 TIME FOR ACCOUNTING RECORD AND SUMMARY
         REF      JIT               INPUT/OUTPUT; USER INFORMATION
         REF      TPIOT             INPUT; PROCESSOR MEMORY USE FACTOR
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      J:EXTENT          INPUT; BIT 25; DETERMINE IF GRANULE
*,*                                 LIMIT INCREMENTED BY EXIT CONTROL
         REF      ALOCCT            INPUT; EQU; BITS 15-31; DISPLACEMENT
*,*                                 IN JIT CONTAINING NUMBER OF GRANULES
*,*                                 INCREMENTED BY EXIT CONTROL
         REF      COCLN             INPUT; COC LINE NUMBER FOR ACCOUNTING
*,*                                 RECORD
         REF      J:STAR            INPUT; LIST OF STAR FILES TO BE RELEASED
         REF      J:INTER           INPUT; OBTAIN NUMBER OF INTERACTIONS
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      J:CALCNT          INPUT; OBTAIN NUMBER OF CALS EXECUTED
*,*                                 FOR ACCOUNTING RECORD AND SUMMARY
         REF      TUIOT             INPUT; USER MEMORY USE FACTOR FOR
*,*                                 ACCOUNTING RECORD AND SUMMARY
         REF      J:AMR             INPUT; ASSIGN-MERGE RECORD ADDRESS
*,*                                 FOR OBJECT JIT
         REF      SYSID             INPUT; USED TO RELEASE STAR FILES
         REF      J:UNAME           INPUT; BYTE 0; CHECK IF ILLEGAL
*,*                                 BATCH USER SO ACCOUNTING RECORD
*,*                                 ISN'T GENERATED (X'FF')
*,*                                 INPUT; BYTE 0; CHECK IF LOGGED ON
*,*                                 INPUT; USER'S NAME FOR ACCOUNTING
*,*                                 RECORD
         REF      NSWAPS            EQU; STORE NUMBER OF SWAPS FOR SUMMARY
         REF      AM:DATE           INPUT; EQU; OBTAIN CREATION YEAR AND
*,*                                 DATE
         REF      AM:LOG            INPUT; EQU; OBTAIN LOGON TIME
         REF,2    AMH:BILL          INPUT; EQU; OBTAIN BILLING RATE
         REF      AM:XACC           INPUT; EQU; OBTAIN EXTENDED ACCNTG.
*,*                                 INFORMATION
         REF      AM:ORG            INPUT; EQU; OBTAIN REMAINING RAD
*,*                                 AND DISK SPACE
         REF      S:OPTION          INPUT; BIT31; DETERMINE IF ON/OFF
*,*                                 TIME SHOULD BE IN MIN. OR SEC.
Z        EQU      P:JIT-J:JIT
Z4       EQU      Z+Z+Z+Z           FOR BYTE FIELDS
*  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
*
* LOGON RECORD ITEMS
*
LR:PW    EQU      6                 PASSWORD
LR:RAD   EQU      18
LR:DIS   EQU      22
*
SECTION2 DSECT    1
BLANK    TEXT     '    '
HNYWL    TEXT     'HONEYWELL'
*
* 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'
WRERRMSG TXTC     'UNABLE TO WRITE ACCOUNTING RECORD'
RESALOC  TXTC     'RESOURCES ALLOCATED'
M:SL    EQU   M:EO
KBUF     EQU      10
LOGRECSZ EQU      126               LOGON REC. NOW EXPANDED
SYSACCNT EQU      ':SYS    '        SYSTEM ACCOUNT NAME                 U:AC0012
SECINDAY EQU      24*60*60
Y007F    DATA     X'007F01FF'
Y09      DATA     X'09000000'
X7F      DATA     X'7F'
XFF      DATA     X'FF'
X10000   DATA     X'10000'
         BOUND    8
PGES     TEXT     ' (PAGES)'
         PAGE
**********************************************************************
*                                                                    *
*        ACCNTSUM - PERFORMS LOGOFF/ENDJOB FUNCTIONS                 *
*        ENTER WITH RETURN LINK IN SR4                               *
*                                                                    *
**********************************************************************
ACCNTSUM RES      0
         PUSH     16,R0             SAVE REGISTERS
         M:TIME   TIMBUF,TUN
         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
         LW,R7    SR2               ADDR. OF AREA
         LB,D1    J:UNAME+Z         WAS THIS AN ILLEGAL BATCH USER?
         CI,D1    X'FF'
         BE       BYPASS            YES, DUMMY UP THE ACCNTG.
*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    AM:DATE,R7        SAVE CREATION YEAR AND DATE
         AND,D1   Y007F
         STW,D1   DATEON
*
         LW,D1    AM:LOG,R7         STORE LOGON TIME
         STW,D1   JTON
**BILLING
         LI,R1    AMH:BILL
         LH,D1    *R7,R1            STORE BILLING RATE
         STH,D1   JOBRATE           IN LEFT HF WD
**EXT. ACC. INFO.
         LCI      6
         LM,R1    AM:XACC,R7        STORE EXTENDED ACCNTG. INFORMATION
         STM,R1   EXTACC
**FOR THE MOMENT,STORE RAD,DISK RMNG SPACE FIG. AT LOGON TIME
         LW,D1    AM:ORG+20,R7      STORE REMAINING RAD SPACE
         STW,D1   RADGRN
         LW,D1    AM:ORG+21,R7      STORE REMAINING DISK SPACE
         STW,D1   DISGRN
*
         B        PASSED
*
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   RELPAGES          A-M PAGE AND RELSTARF PAGE
         LI,R5    J:JIT+Z
         LI,R0    Z
         BEZ      ACCT2
         LCI      4                 STORE RAD,PACK FIGURES FROM CURRENT
         LM,R2    J:JIT+PRDCRM      JIT TO OBJECT JIT (PRDCRM,PRDPRM
         STM,R2   J:JIT+PRDCRM+Z    TMDCRM,TMDPRM)
         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
         CI,R1    X'FF'             CHECK IF ILLEGAL BATCH USER
         BE       ACCT2A            IF SO, NO LOGON FILE TO UPDATE
         BAL,SR4  UPDATE            UPDATE LOGON FILE
ACCT2A   EQU      %
         BAL,SR4  DISPLY            DISPLAY ACCOUTING INFORMATION
ACCT3    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
         M:DEVICE M:LL,(NOVFC)
         BAL,SR4  BANNER            OUTPUT TOP BANNER AND UPSPACE
         LI,R5    2                 2 LINES
         BAL,SR4  UPSPACE
         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
         LW,SR1   TIMBUF+4          (TIMBUF+4)= YEAR,DAY AT LOGOFF
         STW,SR1  DATEOFF
*
         LW,D2    TIMBUF1
         LI,R1    1
         CW,R1    S:OPTION          IS TIME ON/OFF TO BE IN SEC.
         BANZ     DISPLY5
         DW,D2    =60               NO, CONVERT ON/OFF TIME TO MIN
         STW,D2   JTOFF
         MI,D2    60
         LW,D4    JTON              TIME ON ALREADY IN ACCTG. RECD. IN SEC.
         DW,D4    =60
         STW,D4   JTON              TIME ON TO ACCTG. RECD.
         MI,D4    60
         B        DISPLY6
DISPLY5  EQU      %
         STW,D2   JTOFF             TIME OFF TO ACCTG. RECD.
         LW,D4    JTON
DISPLY6  EQU      %
         CW,D2    D4                COMPARE LOGOFF TIME WITH LOGON TIME
         BGE      DISPLY8
         AI,D2    SECINDAY          ADD SEC. IN DAY
DISPLY8  EQU      %
         SW,D2    D4
         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
         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
         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.
         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)
         LI,R2    X'FF'             L/MASK FOR LINE NUMBER IN M:UC
         AND,R2   M:UC+COCLN+Z      &/MASK W/LINE #
         CI,R2    X'FF'             C/LINE # W/.FF; SAVED IMAGE FLAG
         BNE      %+3               B/NOT SAVED IMAGE
         LI,R2    BA(JB:ALN)+Z+Z+Z+Z L/BA OF ACTUAL LINE #
         LB,R2    0,R2              L/ACTUAL LINE #
         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
* CHARGE UNITS
         LI,D1    0                 SET CHARGE UNITS=0 BY DEFAULT
         LI,D2    0
         LI,D3    0
         MTW,0    RATEFLAG          CHECK IF RATE FILE EXISTS
         BNEZ     NORATE
         BAL,SR4  COMPUTECH         COMPUTE RATE
NORATE   EQU      %
         STW,D1   CHARU             INTO ACCT. REC'D.
         PUSH     D1
         LI,R1    11
         BAL,SR4  BINDCB5           CONVERT NO. IN D1 TO DECIMAL EBCDIC
         BAL,SR4  ZEROBK            CONVERT LEADING ZEROS TO BLANKS
         PULL     R0
         CI,R0    0                 DON'T OUTPUT MESSAGE IF UNITS=0
         BE       DISP20Q
         LI,R0    CHARM
         BAL,SR4  SETMES            MOVE MESSAGE TO MESSAGE AREA
         LCI      3
         STM,D1   MSGDATA-1         STORE CHARGE UNITS INTO MESSAGE
         LH,SR2   J:JIT+Z           DON'T OUTPUT MESSAGE EXCEPT
         CI,SR2   X'C000'           FOR BATCH
         BANZ     DISP20Q
         CAL1,1   JLIST             WRITE MESSAGE
DISP20Q  EQU      %
         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
         LCI      3                 PUT CHRG UNITS IN MSGE BUFFER
         STM,D1   CHGV
         BAL,SR4  HX                GO OUTPUT ON-LINE ACCOUNTING DISPLAY
         SEND     OFF               SEND OFF MESSAGE TO OPERATOR
*O*      MESSAGE: IDžžOFF
*O*      ACTION:  NONE. INFORMATION ONLY.
*O*      MEANING: AN ON-LINE USER LOGGED OFF.
ENDIT    RES      0
         LB,D4    J:UNAME+Z         IS THIS AN ILLEGAL BATCH USER?
         CI,D4    X'FF'
         BE       NOWRITE           YES, DON'T GENERATE AN ACCTG. RECORD
*  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      DISPLY9           NOT THERE
         LI,R3    ACCOUNT
         BAL,D4   *D4
         MTW,0    R3
         BEZ      NOWRITE
DISPLY9  EQU      %
         MTW,2    PRDCRM+JIT+Z      BUMP GRANULE COUNT TO ALWAYS ALLOW
         MTW,2    PRDPRM+JIT+Z      WRITING OF :ACCTLG(EVEN IF 0 GRANULES).
         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
*O*      MESSAGE: IDžžUNABLE TO OPEN :ACCTLG FILE FOR ACCOUNTING
*O*               ERROR CODE=XX
*O*      ACTION:  DELETE :ACCTLG. THIS WILL CAUSE ALL ACCOUNTING
*O*               INFORMATION TO BE LOST.
*O*      MEANING: THE MONITOR IS UNABLE TO OPEN THE :ACCTLG FILE.
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
         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
*O*      MESSAGE: IDžžERROR IN SYSTEM ACCOUNT FILE DIRECTORY
*O*               ERROR CODE=XX
*O*      ACTION:  ACTION VARIES WITH ERROR TYPE (SEE BATCH PROCESSING
*O*               REFERENCE MANUAL FOR ERROR CODES.)
*O*      MEANING: LOGON DETECTED AN ERROR IN :SYS ACCOUNT FILE DIRECTORY.
         B        DISPLYX           EXIT FROM DISPLY SUBROUTINE
*
*        ERROR IN WRITING ACCOUNTING RECORD
*
WRERROR  RES      0
         SETERROR SR3
         SEND     WRERRMSG,ERRCODEM NOTIFY OPERATOR
*O*      MESSAGE: IDžžUNABLE TO WRITE ACCOUNTING RECORD
*O*               ERROR CODE=XX
*O*      ACTION:  ACTION VARIES WITH ERROR TYPE. CONTACT THE SYSTEMS
*O*               ANALYST.
*O*      MEANING: SYSTEM WAS UNABLE TO WRITE AN ACCOUNTING RECORD FOR
*O*               THIS USER.
         B        DISPLYX           EXIT FROM DISPLY SUBROUTINE
         PAGE
*
*        OUTPUT TWO LINES OF 'HONEYWELLHONEYWELLHONEYWELL...'
*
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)
         LI,SR2   14                NO. WDS. PER LINE
         LI,R5    BA(MESSAGE)       BUFFER ADDR
BANNER5  EQU      %
         LI,R4    BA(HNYWL)         PATTERN WORD ADDR
         OR,R5    Y09
         MBS,R4   0                 FILL THE BUFFER
         BDR,SR2  BANNER5
         LI,R4    126               NUMBER OF BYTES
         CAL1,1   BLIST
         CAL1,1   BLIST
         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
         TEXT     SYSACCNT
         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'F0000000'       P1,P2,P3,P4
         DATA     WRERROR           ERROR ADDRESS
         DATA     WRERROR           ABNORMAL ADDRESS
         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    64                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
         CAL1,1   JLIST             WRITE MESSAGE
         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
*
*        BLANK FILL AND STORE MESSAGE INTO MESSAGE AREA
*
SETMES   RES      0
         LW,D4    BLANK             BLANK FILL MESSAGE AREA
         LI,R1    10
         STW,D4   MESSAGE-1,R1
         BDR,R1   %-1
         LB,R1    *R0               MOVE MESSAGE INTO MESSAGE AREA
         LB,D4    *R0,R1
         STB,D4   MESSAGE,R1
         BDR,R1   %-2
         STM,D1   MSGDATA
         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
         PUSH     SR4
         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
* CPU TIME
         LW,D2    UEXC              TOTAL USER EXECUTE TIME
         AW,D2    USERV             TOTAL USER OVERHEAD TIME
         AW,D2    PEXC              TOTAL PROCESSOR EXECUTION TIME
         AW,D2    PSERV             TOTAL PROCESSOR OVERHEAD TIME
         MW,D1    0,R6              ACCOUNTING IN PENNIES
         LD,D3    D1
* CORE-TIME
         LW,D2    COREMS            USER+PROCESSOR CORE-TIME FACTOR
         MW,D1    1,R6
         AD,D3    D1
* TERMINAL INTERACTIONS
         LW,D2    CINT              GET NUMBER OF CONSOLE INTERACTIONS
         MW,D1    2,R6
         AD,D3    D1
* I/O CALS
         LW,D2    IOCAL             GET NUMBER OF I/O CALS
         MW,D1    3,R6
         AD,D3    D1
* ELAPSED TIME
         LW,D2    MINUTES           LOAD ELAPSED TIME
         MW,D1    4,R6              MULTIPLY
         AD,D3    D1
* 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
         PUSH     2,D3
         LC       J:JIT             IS THIS AN ONLINE USER
         BCS,8    COMPUTE5          THEN PACKS/TAPES ALLOCATED N/A
         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
COMPUTE5 EQU      %
         MW,D1    5,R6
         PULL     2,D3
         AD,D3    D1
*
*        NO PAGE-DAY STORAGE FACTOR INCLUDED
*
* PERIPHERAL I/O CARDS AND PAGES
         LH,D2    CARDS             GET CARD INPUT
         LI,R5    1
         AH,D2    CARDS,R5          ADD CARD PUNCH OUT COUNT
         AH,D2    PAGES             ADD CURRENT PROCESSOR PAGE COUNT
         AH,D2    PAGES,R5          ADD CURRENT USER PAGES COUNT
         AH,D2    DGNTAP            ADD CURRENT DIAGNOSTIC PAGES COUNT
         MW,D1    7,R6
         AD,D3    D1
         DW,D3    TENTHOU           DIV BY 10K TO GET IT IN PENNIES.
         LW,D1    D4
         PULL     SR4
         B        *SR4
         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 CONVERTS HOURS, MINUTES AND SECONDS
* INTO A BINARY, SECONDS FROM MIDNIGHT REPRESENTATION, AND
* STORES THE RESULT IN TIMBUF1
* ENTER WITH BAL,SR4 AND SR2 SET FROM M:TIME.
*    NOTE THE SR1 IS NOT DESTROYED
*
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
* 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 SR3 ARE DESTROYED.
* A MAXIMUM OF 8 NUMBERS MAY BE GENERATED UPON ENTERING AT BINDCB.
* IF ENTERING AT BINDCB5, A MAXIMUM OF 12 NUMBERS MAY BE GENERATED
* IN D1,D2 AND D3. R1 MUST CONTAIN CHARACTER COUNT-1.
*
*
BINDCB   EQU      %
         LI,R1    7                 CHARACTER COUNT AND BYTE POINTER
BINDCB5  EQU      %
         PUSH     SR4
         LW,SR4   D1                GET NUMBER
BINDCB10 EQU      %
         LI,SR3   0
         DW,SR3   =10
         AI,SR3   X'F0'             CONVERT REMAINDER TO EBCDIC AND
         STB,SR3  D1,R1             PLACE INTO RESULT.
         AI,R1    -1
         BGEZ     BINDCB10          LOOP UNTIL EBCDIC RESULT COMPLETED
         PULL     SR4
         B        *SR4              RETURN
         PAGE
*        CHANGE   LEAD  ZEROS  INTO  BLANKS
*        D1-D2-D3 = EBCDIC
*        D4,R1    USED
*
ZEROBK   EQU      %
         LI,R1    -12               CHARACTER COUNT AND BYTE POINTER
ZEROBK1  EQU      %
         LB,D4    D1+3,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+3,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
         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
         LB,R2    J:UNAME+Z         IS THIS AN ILLEGAL BATCH USER?
         CI,R2    X'FF'
         BE       UPDATEX           YES, SO DON'T UPDATE LOGREC
         CAL1,1   WRTLOGON          WRITE LOGREC
UPDATEX  CAL1,1   NORETURN          IGNORE ANY CLOSE ERRORS
         CAL1,1   CLSLOGON          CLOSE LOGON FILE
         STW,R2   LR:PW+LOGREC      CLOBBER THE PASSWORD TO PREVENT
         STW,R2   LR:PW+LOGREC+1    FUTUTE PAGE USERS FROM STEALING IT.
         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
*O*      MESSAGE: IDžžUNABLE TO OPEN USERS FILE FOR UPDATE
*O*               ERROR CODE=XX
*O*      ACTION:  TRY TO RECREATE ACCOUNT WITH SUPER.
*O*      MEANING: ERROR IN :USERS FILE.
         B        UPDATEX           EXIT FROM UPDATE
*
*        COME HERE IF LOGON FILE IS BUSY
*
LOGONBSY RES      0
         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
*O*      MESSAGE: IDžžBAD LOGON RECORD
*O*               ERROR CODE=XX
*O*      ACTION:  RECREATE ACCOUNT WITH SUPER IF RECURRING ERROR.
*O*      MEANING: AN ERROR OCCURRED WHILE READING THE :USERS FILE.
         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
*E*      MESSAGE: UNABLE TO READ ASSIGN-MERGE RECORD
         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
         LI,R6    1                 SAVE CURRENT JITS SYSID
         LH,R0    J:JIT,R6
         PUSH     R0
         LH,R0    J:JIT+Z,R6        REPLACE WITH SYSID FROM OBJECT JIT
         STH,R0   J:JIT,R6          TO PASS FMGE. CHECKS
         LCI      5
         LM,0     J:STAR+Z
         STM,0    J:STAR
         CAL1,8   GETPAGE           GET PAGE FOR FPARAM ADDR
         BCR,8    %+2
         B        %-2
         LI,R6    NSTARF            (R6) = NUMBER OF  *SYSID FILES
RELSTRF2 RES      0
         LB,R3    STRTBL,R6         * FILE INDEX
         LW,R2    J:STAR+0,R3
         BEZ      RELSTRF4
         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
         CAL1,1   CLSSTARF          CLOSE AND RELEASE FILE
RELSTRF4 RES      0
         BDR,R6   RELSTRF2
*
*
         LW,R2    J:STAR+4+Z
         BEZ      RELTMPF8          NO T FILES
*
         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
         BNE      RELTMPF8          NO
RELTMPF2 RES      0
         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          BO
         LI,R3    0                 IF PASSWORD(03) FOUND IN VLP,
         LI,D1    X'03'             DON'T RELEASE FILE
RELTMPF4 EQU      %
         LW,D2    *SR2,R3
         AI,R3    1
         CB,D1    D2
         BNE      RELTMPF5          NOT PASSWORD
         CI,D2    1                 CHECK IF JOB FILE (ONE WORD IN LENGTH)
         BANZ     RELTMPF6          YES IT IS, SO RELEASE
         CAL1,1   CLSTMPFS          NO, CLOSE AND SAVE
         B        RELTMPF2
RELTMPF5 EQU      %
         CW,D2    X10000            CHECK FOR LAST PARAMETER ENTRY
         BANZ     RELTMPF6          YES, RELEASE THE FILE
         AND,D2   XFF
         AW,R3    D2
         B        RELTMPF4          GET NEXT
RELTMPF6 EQU      %
         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
         CAL1,1   CLSSTARF          CLOSE AND RELEASE *SYSIDT
RELTMPF8 RES      0
         PULL     R0                RESTORE CURRENT JITS SYSID
         LI,R6    1
         STH,R0   J:JIT,R6
         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
*
*        CLOSE PLIST FOR TEMPORARY FILES
*
CLSTMPFS RES      0
         GEN,8,24 X'15',M:EO        CLOSE FILE
         DATA     X'80000000'       P1
         DATA     2                 SAVE 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
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
         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
*
* 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'CF680219'
         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     0                 FPARAM ADDRESS
         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
         TEXT     SYSACCNT
         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'FC000000'       P1,P2,P3,P4,P5,P6
         DATA     *SR1              ERROR RETURN ADDRESS
         DATA     *SR1              ABNORMAL RETURN ADDRESS
         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 2 PAGES
*
RELPAGES GEN,8,24 X'09',2
*
* 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                                     *
*                 (SR2) = ADR OF FPARAM BUFFER
*                 (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,R5
         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:LL DCB FORCE OUTPUT TO
* LOGICAL STREAM L1 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
         M:LDEV   'L1',(DEV,'LP')   ASSIGN LP TO LOGICAL STREAM L1
         CAL1,1   OPNLP             #5733
         M:DEVICE M:LL,(SPACE,1)    SET SPACE AS USER MAY HAVE SET OTHERWISE
         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'D3F1'           L1
         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                                  *
*                 (SR2) = ADR OF FPARAM BUFFER
*                 (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
         STW,SR2  OPNPFPRM,R7       STORE FPARAM ADDRESS 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
         CAL1,1   *R7               OPEN  DCB
         CAL1,1   SETDCB            SET ERR AND ABN ADR IN DCB
*
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'CF6800F1'       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     2                 FILE
OPNPFPRM EQU      %-OPNFPLST
         DATA     0                 FPARAM ADDRESS
         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
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
NATRYS   DATA     0                 LOGON ATTEMPTS W/BAD NAME OR ACCOUNT
PATRYS   DATA     0                 LOGON ATTEMPTS W/BAD PASSWORD
LISTLOC  RES      25
TENTHOU  DATA     10000
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
         TEXT     '    '            FILLED
         DATA     0                 END OF MESSAGE
USERMSG  TEXT     '   USER#       LINE#    '
         DATA,1   X'15'
         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
         BOUND    8
UPASSWD  RES      0
         SPACES   3
UEXTACC  RES      0
         SPACES   6
PATCH    RES      0
PATCH:   EQU      PATCH
         ZERO     100
         END

