 TITLE '*** ERROR LOGGING PUBLIC FILE WRITER C00 CP-V ***'
         PAGE
         CSECT    1                 GENERATE PROCEDURE
*
*
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         DEF      ERR:FIL
         DEF      DATA,PATCH
         REF      J:JIT
         REF      DEVMOD#,DCT1,DCT25
         REF      BOOTFLG
         REF      F:ERF
         REF      ERRLOG9
         REF      SITEID
         REF      CORE
         REF      Y002
         REF      JULIAN
         REF      TSTACK
         REF      DCTSIZ,DCT1A,DCT1P
*
*        REGISTER ASSIGNMENTS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8,SR1   EQU      8
R9,SR2   EQU      9
R10,SR3  EQU      10
R11,SR4  EQU      11
R12,D1   EQU      12
R13,D2   EQU      13
R14,D3   EQU      14
R15,D4   EQU      15
MAXTYPE  EQU      X'53'             CURRENT MAX CODE NUMBER
         PAGE
*
*        ENTRY INITIALLY - IF FILE DOESNT EXITST BUILD IT
*
ERR:FIL  EQU      %
         CAL1,6   MASTER            GET INTO MASTER MODE
         BCS,8    EXIT1             FOULED OUT....GET OUT
         MTW,0    BOOTFLG           ARE WE REALLY UP/RUNNING
         BNEZ     EXIT1             NO - EXIT OUT OF THHE SYSTEMM
         LI,R5    COPYLOG           FAKE THE BAL INTO HERE
ERR:FIL1 EQU      %
         PSW,R5   TSTACK            REMEMBER RETURN
         M:OPEN   F:ERF,(FILE,'ERRFILE'),(KEYED),(DIRECT),(SAVE),;
                        (TRIES,10),(INOUT),(ERR,ERFERR),(ABN,ERFERR),;
                        (KEYM,8)
         PLW,R5   TSTACK            RETRIEVE THE LINK
         B        0,R5              AND EXIT W/FILE OPEN
         PAGE
*
*        GET HERE IF FILE NEEDS TO BE BUILT
*
ERR:FIL2 EQU      %
         M:OPEN   F:ERF,(FILE,'ERRFILE'),(OUT),(SAVE),(KEYED),(DIRECT),;
                        (ERR,ERFERR),(ABN,ERFERR),(KEYM,8)
         BAL,R1   NEWHOUR           SET UP KEY
         BAL,R1   TIMESTMP          PUT OUT TIME STAMP RECORD
         BAL,R1   SITID             PUT OUT SITE ID RECORD
         BAL,R1   CODE21            PUT OUT CONFIGURATION RECORD
         BAL,R1   ERR28             PUT OUT I/O ACTIVITY RECORD
         B        COPYLOG           GO ASK FOR A BUFFER
         PAGE
*
*        EACH HOUR AND AT ERR:FIL STARTUP CREATE KEY TO USE
*
NEWHOUR  EQU      %
         LCI      3
         PSM,R1   TSTACK            SAVE MINIMUN SET
         CAL1,8   TIMECAL           GET CURRENT M:TIME TIME
         LI,SR3   TEMPBLK           POINT TO IT
         BAL,SR4  JULIAN            FOR JULIAN TO FIND
         LI,SR3   8
         STB,SR3  SR1               CREATE KEY LENGTH
         STW,SR1  KEY               CREATE WORD ZERO OF KEY
         BAL,R5   ERRLOG9           GET CURRENT TIME IN MCS/2
         LI,R3    0                 PHONY UP INDEX FOR
         STW,R4   ERRLOG+1          GETIME TO USE
         BAL,R1   GETIME            GO CONVERT TIME TO HHMM
         STW,R8   KEY+1             KEY WORD ONE SET UP
         LCI      3
         PLM,R1   TSTACK
         B        0,R1              AND EXIT
         PAGE
*
*        PUT OUT THE SYSTEM CONFIGURATION RECORD
*
CODE21   EQU      %
         LCI      3
         PSM,R1   TSTACK            SAVE MINIMUM SET
         BAL,R1   NEWHOUR           RE-INIT KEY W/TIME + DATE
         LI,R5    DCTSIZ            LENGTH OF DCT TABLES
         LI,R4    0                 INITIAL INDEX
CODE21A  LI,R3    X'21'             CODE FOR CONFIG RECORD
         STB,R3   BUF3              SET
         MTB,1    KEY+2             BUMP SEQUENCE COUNTER
         LI,R6    1
CODE21B  AI,R6    1
         AI,R4    1                 NEXT DCT INDEX
         LW,R10   R4                DCT INDEX
         LH,R3    DEVMOD#,R4        MODE NUMBER FOR THIS DCT INDEX
         STH,R3   R10               PUT TOGETHER
         STW,R10  BUF3,R6           STORE IT IN RECORD
         AI,R6    1
         LH,R2    DCT1A,R4          ALTERNATE DEVICE ADDRESS
         LH,R3    DCT1P,R4          PRIMARY DEVICE ADDRESS
         STH,R2   R3                PUT TOGETHER
         STW,R3   BUF3,R6
         AI,R5    -1                DECREMENT DCT INDEX
         BLEZ     CODE21C           DONE W/RECORDS
         CI,R6    11                HOW MANY ENTRIES IN RECORD
         BL       CODE21B           GET NEXT ONE
CODE21C  EQU      %
         AI,R6    1
         LI,R1    1                 INDX TO STORE WORD COUNT
         STB,R6   BUF3,R1
         SLS,R6   2                 INTO A BYTE COUNT
         M:WRITE  F:ERF,(BUF,BUF3),(SIZE,*R6),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         CI,R5    0                 DONE
         BGZ      CODE21A           NOT YET
         LCI      3
         PLM,R1   TSTACK
         B        0,R1
         PAGE
*
*        PUT OUT I/O ACTIVITY RECORD
*
ERR28    EQU      %
         LCI      3
         PSM,R1   TSTACK
         BAL,R1   NEWHOUR           RE-INIT KEY W/TIME + DATE
         LI,R4    0
         LI,R5    DCTSIZ
ERR28A   LI,R2    X'28'
         STB,R2   BUF3              CODE SAYING ITS I/O COUNT RECOD
         MTB,1    KEY+2             SEQUENCE COUNTER
         LI,R6    1
ERR28B   AI,R6    1
         AI,R4    1                 NEXT DCT INDEX
         LW,R10   R4                DCT INDEX
         LH,R2    DCT1,R4           DEVICE ADDRESS
         STH,R2   R10               TOGETHER W/DCT INDEX
         STW,R10  BUF3,R6           STORED AWAY
         LW,R2    DCT25,R4          GET SIO COUNTER
         AI,R6    1
         STW,R2   BUF3,R6           SAVED
         AI,R5    -1                NEXT DCT INDEX
         BLEZ     ERR28C            DONE
         CI,R6    11                RECORD MAX YET
         BL       ERR28B            KEEP GOING
ERR28C   EQU      %
         AI,R6    1
         LI,R1    1
         STB,R6   BUF3,R1           STORE WORD COUNT
         SLS,R6   2                 MAX IT A BYTE COUNT
         M:WRITE  F:ERF,(BUF,BUF3),(SIZE,*R6),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         CI,R5    0                 DONE YET
         BGZ      ERR28A            NOT YET
         LCI      3
         PLM,R1   TSTACK
         B        0,R1              EXIT OUT
         PAGE
*
*        CLOSE UP THE FILE AND GO TO SLEEP
*
EXIT     EQU      %
         CAL1,1   CLS:ERF
         LC       J:JIT
         BCS,4    %+2               DEFINITELY A GHOST JOB
EXIT1    CAL1,9   1                 NOT A GHOST
         CAL1,8   SLEEP
*
*
*
*        FALL THRU AND PROCESS ERRORS
*
*
         PAGE
*
*        GET A RECORD AND PROCESS IT
*
COPYLOG  EQU      %
         CAL1,6   RDELFPT           READ A RECORD
         BCS,1    EXIT              NO ERRORS TO GET
         BCS,8    EXIT              NOT :SYS OR JB:PRIV LOW..
         STCF     FLAG              REMEMBER CC'S
         BCR,6    COPYLOG1          NO READ ERRORS ENCOUNTERED
         LI,R1    1                 GOT A READ ERRROR
         B        COPYLOG2
COPYLOG1 EQU      %
         LW,R10   Y002
         CW,R10   F:ERF             IS DCB OPEN NOW
         BANZ     %+2               YEP
         BAL,R5   ERR:FIL1          NO - GO OPEN IT
         MTW,3    ERRLOG+2          BUMP WORD COUNT UP
         LI,R1    3                 ASSUME BUFFER HAS BAD COUNT
         LW,R7    ERRLOG+2          GET COUNT
         BLEZ     COPYLOG2          BAD BUFFER COUNT
         CI,R7    64                AT MAX
         BL       COPYLOG3          ITS OKAY
COPYLOG2 EQU      %
         BAL,R2   ERRWRITE          PUT OUT COPY EROR RECORD
         B        COPYLOG           ASK FOR ANOTHER BUFFER
         PAGE
*
*        LOOP POINT PROCESSING RECORDS IN BUFFER
*
COPYLOG3 EQU      %
         LI,R3    3                 INITIAL INDEX INTO BUFFER
COPYLOG4 EQU      %                 LOOP RETURN POINT
         LW,R1    ERRLOG,R3         GET ENTRY WORD ZERO
         LH,R13   R1                GET CODE AND COUNT
         STH,R13  ERRTYPE           REMEMBER BOTH OF THEM
         AND,R13  =X'FF'            MASK COUNT
         BEZ      COPYLOG6          ERROR*******
         CI,R13   24                RECORD SIZE OK
         BG       COPYLOG6          NO..
         LB,R4    ERRTYPE           GET RECORD CODE
         BLEZ     COPYLOG6          THATS A BAD CODE TO HAVE...
         BAL,R1   STAMP             CHECK FOR START-UP OR TIME STAMP
         BAL,R1   CHECKMOD          CHECK FOR DEVICE ERROR RECORD
         BAL,R1   GETIME            GET THE TIME CONVERTED
         STW,R8   KEY+1             STORE IT AWAY
         LB,R4    ERRTYPE           GET THE CODE AGAIN
         BEZ      COPYLOG6          *****ERROR*****
         CI,R4    X'15'             IS A DEVICE ERROR
         BNE      COPYLOG5          NOPE
         LW,R1    ERRLOG+11,R3      GET TAPE SN FIELD OF RECORD
         MTH,0    R1                WAS IT AN ANSS TAPE
         BEZ      COPYLOG5          NOPE
         BAL,R1   ANSTAPE           YES - CONVERT SN TO EBCDIC
COPYLOG5 EQU      %
         CI,R4    MAXTYPE           DOES CODE FALL IN RANGE
         BLE      COPYLOG7          YES
COPYLOG6 EQU      %                 NO
         LI,R1    6
         BAL,R2   ERRWRITE          PUT OUT COPY ERROR RECORD
         B        COPYLOG           AND REQUEST ANOTHER BUFFER
         PAGE
*
*        WRITE THE ENTRY INTO THE FILE
*
COPYLOG7 EQU      %
         MI,R13   4                 CHANGE WORD CNT INTO BYTE COUNT
         LI,R14   ERRLOG            BUFFER BASE ADDRESS
         AW,R14   R3                PLUS INDEX EQUAL BUF TO WRITE FROM
         MTB,1    KEY+2             BUMP SEQUENCE COUNTER
         M:WRITE  F:ERF,(BUF,*R14),(SIZE,*R13),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         LB,R6    ERRTYPE           GET CODE AGAN
         CI,R6    X'18'             JUST DO A START-UP RECORD
         BNE      COPYLOG8          NO
         BAL,R1   NEWHOUR           REBUILD KEY
         BAL,R1   TIMESTMP          BUILD TIME STAMP
         B        COPYLOG9
COPYLOG8 EQU      %
         CI,R6    X'23'             WAS IT A TIME STAMP
         BNE      COPYLOG9
         BAL,R1   NEWHOUR           REBUILD KEY
         BAL,R1   ERR28             PUT I/O ACTIVITY RECORD
COPYLOG9 EQU      %
         LH,R13   ERRTYPE
         AND,R13  =X'FF'
         AW,R3    R13               NEXT INDEX INTO BUFFER
         CW,R3    ERRLOG+2          STILL FITS...
         BL       COPYLOG4          YES - GET ANOTHER RECORD
         B        COPYLOG           READ ANOTHER BUFFER
         PAGE
*
*        CONVERT MCS INTO HHMM FORMAT
*
GETIME   EQU      %
         LCI      3
         PSM,R1   TSTACK
         LW,R4    ERRLOG+1,R3       GET MCS/S
         SLS,R4   1                 INTO MCS
         STW,R4   ERRLOG+1,R3       REPLACE IT IN RECORD
         STW,R4   BUF3+1            PUT IT AWAY FOR INTERNAL RECORDS
         LW,R3    R4
         LI,R4    0
         LI,R5    0
         LI,R2    0
         AI,R3    1000              ROUND UP
         DW,R2    =1000             AND DIVIDE IT
GETIME1  LW,R1    TMTABLE,R5
         LI,R2    0
         DW,R2    R1
         STW,R2   TMCELL            REMEMBER REMAINDER
         LI,R2    0
         DW,R2    =10
         AI,R2    X'F0'
         AI,R3    X'F0'             BOTHH INTO EBCDIC NUMBERS
         STB,R3   RELTIME,R4        STORE FIRST BYTE
         AI,R4    1
         STB,R2   RELTIME,R4
         AI,R5    1
         AI,R4    1
         LW,R3    TMCELL
         CI,R5    2
         BL       GETIME1
         LW,R8    RELTIME
         CW,R8    MAXTIME
         BL       %+2               IS OKAY
         LW,R8    MAXTIME           NOT OKAY
         LCI      3
         PLM,R1   TSTACK
         B        0,R1
         PAGE
*
*        BUST ANSS SERIAL NUMBER INTO EBCDIC
*
ANSTAPE  EQU      %
         LCI      3
         PSM,R1   TSTACK
         LW,R2    ERRLOG+10,R3      GET SN
         SLD,R2   -20
         SLS,R3   -12
         LW,R5    R3
         LI,R6    6                 6 BYTES OF SERIAL NUMBER
ANSTAPE1 SLD,R2   -2
         SLS,R3   -26               SHIFT INTO PERSPECTIVE
         LI,R4    0
         DW,R4    =10
         OR,R3    R4                INSERT BITS
         BEZ      %+2               OKA
         AI,R3    X'80'
         AI,R3    X'40'
         SLD,R8   -8
         STB,R3   R8
         BDR,R6   ANSTAPE1          FINISH SIX BYTE SN
         LCI      3
         PLM,R1   TSTACK
         STW,R8   ERRLOG+10,R3      STORE EBCDIC SN IN RECORD
         LW,R8    R9
         SLS,R8   -16
         LW,R9    ERRLOG+11,R3
         STH,R8   R9
         STW,R9   ERRLOG+11,R3      REPLACE LAST TWO BYTES OF SN
         B        0,R1              AND EXIT
         PAGE
*
*        TIME STAMP AND STARTUP RECOD`RDS NEED YEAR AND
*        DAY ADDED TO THEM
*
STAMP    EQU      %
         PSW,R3   TSTACK
         CI,R3    0                 INTERNAL TIME STAMP
         BLZ      STAMP1            YEP - GO DO IT
         LB,R4    ERRTYPE           CODE OF RECORD
         LB,R2    STMPTBL           GET LENGTH OF ENTRIES
         CB,R4    STMPTBL,R2        SEE IF CODE APPEARS IN LIST
         BE       STAMP1            GOTCHA
         BDR,R2   %-2
         B        STAMP2            NOPE
STAMP1   CAL1,8   TIMECAL1          GET M:TIME IN TIMS
         STW,R8   ERRLOG+2,R3       STORE YEAR AND DAY
         STW,R8   BUF3+2            SAVE IT FOR INTERNAL CODES
STAMP2   EQU      %
         PLW,R3   TSTACK
         B        0,R1              AND RETURN
         PAGE
*
*        INSERT COPY ERROR RECORD
*
ERRWRITE EQU      %
         PSW,R2   TSTACK
         LI,R6    3
         STB,R1   CEREC,R6          INSERT TYPE OF ERROR
         STW,R3   CEREC+2           PUT INDEX INTO COPY ERR RECORD
         LI,R6    0                 ASSUME ERROR
         CI,R3    64                TRUE
         BG       %+2               YES - INDEX IS NO GOOD
         LW,R6    ERRLOG+1,R3       IS OK - GET TIME FROM RECORD
         STW,R6   CEREC+1
         M:WRITE  F:ERF,(BUF,CEREC),(SIZE,12),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         MTB,1    KEY+2
         M:WRITE  F:ERF,(BUF,ERRLOG),(SIZE,64*4),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         PLW,R2   TSTACK
         B        0,R2
         PAGE
*
*        CHECK ERROR RECORD TO SEE IF IT NEEDS THE MMODEL#
*
CHECKMOD EQU      %
         LB,R2    MODTBL            LENGTH OF TABLE
         CB,R4    MODTBL,R2         SCAN LIST
         BE       CHECKMOD1         GOTCHA
         BDR,R2   %-2
         B        0,R1              NOPE
CHECKMOD1 EQU     %
         PSW,R3   TSTACK
         LW,R4    ERRLOG,R3         GET WORD ZERO
         AND,R4   =X'FF'            EXTRACT DCT INDEX
         LH,R2    DEVMOD#,R4        GET MODDEL NUMBER
         SLS,R3   1                 WORD INDEX INTO HALF WORD INDEX
         AI,R3    1                 PLUS ONE
         STH,R2   ERRLOG,R3         SET IN MODEL NUMBER
         PLW,R3   TSTACK
         B        0,R1              RETURN
         PAGE
*
*        GOT AN ERROR/ABNORMAL FROMM F:ERF DCB
*
ERFERR   EQU      %
         LB,R9    R10               GET I/O ERROR CODE
         CI,R9    3                 FILE DOESNT EXITST CODE
         BE       ERR:FIL2          YEP - GO CREATE FILE
         CI,R9    X'75'             IS THE FILE BROKEN
         BE       ERFBRK            YEP - TELL OPERATOR ABOUT IT
         CI,R9    X'2E'             OPENING AN OPEN FILE
         BE       *R8               YEP
         CI,R9    X'57'             DISC SATURATED
         BE       EXIT              YES - EXIT
         CI,R9    10                CLOSING A CLOSED FILE
         BE       *R8               YES - IGNORE
         CI,R9    X'16'             DUPLICATE KEY
         BNE      ERFERR2           NO
         MTB,0    KEY+2             WRAPPED AROUND YET
         BEZ      *R8               YES - SKIP RECORD
         MTB,1    KEY+2             NO BUMP IT
ERFERR1  AI,R8    -1                POINT BACK TO CAL
         B        *R8               AND RE-EXECUTE IT
ERFERR2  CI,R9    X'14'             FILE BUSY
         BE       ERFERR1           YES - REEXECUTE CAL
         B        *R8               JUST SKIP WHATEVER IT WAS
         PAGE
*
*        PUT OUT SITE ID RECORD
*
SITID    EQU      %
         LCI      3
         PSM,R1   TSTACK
         LI,R2    X'2205'           CODE AND COUNT
         STH,R2   BUF3
         LI,R2    CORE              SIZE OF CORE IN WORDS
         AI,R2    8192              ROUND UP
         SLS,R2   -13               TO NUMBER OF 8K BLOCKS
         LI,R1    2
         STB,R2   BUF3,R1           STORE IT
         LI,R1    3
         LI,R2    1                 TIME RESOLUTION = MCS
         STB,R2   BUF3,R1
         LW,R2    X'2B'             SYSTEM ID FLAG
         STW,R2   BUF3+2            INTO RECORD
         LCI      2
         LM,R2    SITEID            GET EBCDIC ID CELL
         STM,R2   BUF3+3            SAVED
         MTB,1    KEY+2             BUMP SEQUENCE COUNTER
         M:WRITE  F:ERF,(BUF,BUF3),(SIZE,20),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         LCI      3
         PLM,R1   TSTACK
         B        0,R1
         PAGE
*
*        PUT OUT TIME STAMP RECORD
*
TIMESTMP EQU      %
         LCI      3
         PSM,R1   TSTACK
         LI,R2    X'2303'           CODE AND COUNT
         STH,R2   BUF3              STORED
         BAL,R1   NEWHOUR           UPDATE KEY
         LI,R3    -1
         BAL,R1   STAMP             INSERT YEAR AND DAY
         MTB,1    KEY+2             BUMP COUNTER
         M:WRITE  F:ERF,(BUF,BUF3),(SIZE,3*4),(KEY,KEY),;
                        (ERR,ERFERR),(ABN,ERFERR),(NEWKEY)
         LCI      3
         PLM,R1   TSTACK
         B        0,R1
         PAGE
*
*        ERRFILE IS BROKEN - TELL OPERATOR AND EXIT
*
ERFBRK   EQU      %
         M:TYPE   (MESS,BRKMSG)
         B        EXIT1             EXIT AWAY
BRKMSG   TEXTC    '** ERR:FIL:    ERRFILE IS INACESSIBLE'
         PAGE
*
*        DATA AREA AND CONSTANTS
*
DATA     CSECT    0
TIMECAL  GEN,8,24 16,TEMPBLK
TIMECAL1 GEN,8,1,23 16,1,TEMPBLK
STMPTBL  DATA,1   2,X'18',X'23',0
CLS:ERF  GEN,8,24 X'15',F:ERF
         PZE      *0
         DATA     2
BUF3     DO1      12
         DATA     0
RELTIME  DATA     0
TMTABLE  DATA     3600,60
TMCELL   DATA     0
MODTBL   DATA,1   4,X'11',X'12',X'13',X'15'
         BOUND    4
ERRTYPE  DATA     0
MASTER   GEN,8,24 8,0
MAXTIME  TEXT     '2359'
ERFKEY   GEN,8,24 8,0
         DATA     0,0
KEY      DATA     0,0,0
CEREC    DATA     X'10300000',0,0
FLAG     DATA     0
RDELFPT  GEN,8,24 0,ERRLOG
SLEEP    XPSD,0   10
         PAGE
*
*        BUFFER TO READ INTO
*
ERRLOG   EQU      %
         DATA     0,0,26
************************
         DATA     X'150D0000'
         DATA     14*60*60*500+1000
         DO1      11
         DATA     0
****************************
         DATA     X'23030000'
         DATA     14*60*60*500+1500
         DATA     0
******************************
         DATA     X'11060000'
         DATA     14*60*60*500+2500
         DO1      4
         DATA     0
**********************************
         DATA     X'18040000'
         DATA     14*60*60*500+3500
         DATA     0,0
         DO1      39
         DATA     0
         PAGE
*
*        TEMPBLK IS USED FOR M:TIME BUFFER
*
TEMPBLK  DO1      4
         DATA     0
*
*        PATCH IS USED FOR ON THE FLY PATCHES OR GENMD'S
*
PATCH    DO1      16
         DATA     0
         END      ERR:FIL

