         SYSTEM   BPM
         SYSTEM   SIG5
                  PCC      1
*
*
*
* PROGRAM EDITS MASTER TEXT ERROR MESSAGE FILE TO PRODUCE
* INPUT FOR ERRMWR PROCESSOR.
*
*
         TITLE    'M-T-E-M-F PROCESSOR'
         PAGE
         REF      F:2,F:3
         REF      M:UC
         REF      M:LO
         REF      M:EI
*
*
*
         DEF      START
         DEF      GETREC,EMFWRT
*
*
ONL      SET      1                 ONLINE/BATCH FLG
*  1=BATCH...........>1=>ONLINE
*
*
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
MFFFF0   DATA     X'FFFF0000'
*
F:1      DSECT
F:1      M:DCB    (FILE),(CONSEC),(IN)
         CSECT
         PAGE
*
*
*
START    EQU      %
         M:PC     '>'               SET PROMPT CHARACTER
         LI,R3    0
SRD      M:READ   M:EI,(BUF,VERBUF),(SIZE,80);
                  ,(ERR,VERR),(ABN,VERR)
         LI,R1    3
         LI,R5    VERBUF            BUF ADDR TO R5
         LB,R2    *R5,R1            LOOK FOR # CHARACTER
         CI,R2    '#'
         BE       VERS1
         CI,R3    3
         BL       %+2               TRY TO READ  AGAIN
         M:XXX                      ABORT
         AI,R3    1
         B        VERR
*
*
VERS1    EQU      %
         LW,R6    VERBUF
         SLS,R6   -8
         STW,R6   VERBUF
*
         M:OPEN   F:2,(FILE,'ERRTEXT'),(OUT);
                  ,(KEYED);
                  ,(SAVE);
                  ,(KEYM,8);
                  ,(DIRECT);
                  ,(ABN,KEYDUP),(ERR,NOOP2)
*
         M:OPEN   F:3,(FILE,'ERRCNTL'),(OUT);
                  ,(SAVE),(CONSEC);
                  ,(ABN,NOOP3),(ERR,NOOP3)
*
         BAL,SR4  FORMAT
GETREC   M:READ   F:1,(BUF,BUFFA),(SIZE,80);
                  ,(ABN,RDABN)
         LI,R2    F:1               DCB ADDR TO R2
         BAL,SR4  RECSIZE
         STB,R6   REC1
GETREC1  LB,R2    BUFFA             CHK TYPE OF REC JUST READ
         CI,R2    '*'               CONTROL CARD ???
         BE       VERS2
         CI,R2    '<'               INFO CARD ??
         BNE      VERS3             GOT A DATA CARD
         LW,R6    BUFFA+1
         LW,R7    BUFFA+2
         SCD,R6   -16
         LW,R6    R7
         LI,R7    0
         STB,R7   R6
         CW,R6    VERBUF
         BLE      VERS7
VERS6    EXU      GETREC
         BAL,SR4  CONTIN
         CI,R4    ';'               GOT CONTIN ???
         BNE      %+2
         EXU      GETREC
         EXU      GETREC
         LB,R3    BUFFA
         CI,R3    '*'
         BE       GETREC1
         CI,R3    '<'
         BE       GETREC1
         B        FILERR
*
*                                   GOOD '<' CARD,PRINT IT
*
VERS7    EQU      %
         LB,R2    REC1              RECORD SIZE FOR WRT
         CI,R2    24                MODULE NAMES PRES?
         BLE      VERS71            NO
         LI,R4    24                START BUFFA POS
         LI,R5    9                 START BUFFC POS
VERS72   LB,R6    BUFFA,R4          GET FROM 'A'
         STB,R6   BUFFC,R5          PUT TO 'C'
         AI,R4    1
         AI,R5    1
         CW,R4    R2                REC EXHAUSTED YET
         BGE      VERS73            FINISHED
         B        VERS72            KEEP GOING
VERS71   LI,R5    9
VERS73   STB,R5   BCFLG             SET FOR LATER WRITE
         LB,R2    REC1              GET BYTE COUNT
         M:WRITE  F:3,(BUF,BUFFA),(SIZE,*R2),(WAIT)
         B        GETREC
*
*
VERS2    EQU      %                 PROCESS ASTERISK (*) REC.
         MTB,1    KEYY+2
         LI,R2    2                 SIZE FOR WRT
         EXU      EMFWRT            WRITE THE ERR MSG FILE
         B        GETREC
         PAGE
*
VERS3    EQU      %
*                                   DATA CARD PROCESSING
         BAL,SR4  CONTIN            SEE IF REC IS CONTINUED?
         CI,R4    ';'               GOT CONTIN ???
         BNE      VERS4             NO!
         MTW,1    CNTUFLG
         M:READ   F:1,(BUF,BUFFB),(SIZE,80);
                  ,(ABN,RDABN)
         LI,R2    F:1
         BAL,SR4  RECSIZE
         STB,R6   REC2
VERS4    EQU      %
         LI,R1    X'4040'
         LI,R6    1
         LI,R7    X'F0F0'
         LD,R4    BUFFA
         AND,R5   MFFFF0
         SCS,R4   16
         CH,R1    R4,R6
         BE       STUFF0
         B        VERS4A
STUFF0   STH,R7   R4,R6             CHANGE BLANK GRP TO '00'
VERS4A   LI,R1    X'05'             TAB CHAR
         LI,R6    2
         STH,R4   BUFFC             GROUP CODE
         STB,R1   BUFFC,R6          TAB CHAR
         AI,R6    1
         SCS,R4   8
         STB,R4   BUFFC,R6          ERROR CODE
         AI,R6    1
         SCS,R4   8
         STB,R4   BUFFC,R6          ERROR CODE
         AI,R6    1
         STB,R1   BUFFC,R6          TAB CHAR
         LI,R6    3
         SLS,R5   -16
         STH,R5   BUFFC,R6          SUB CODE
         LI,R6    8
         STB,R1   BUFFC,R6          TAB CHAR
         LB,R2    REC1
         LB,R5    BCFLG             INDEX TO BUFFC
         LI,R6    X'05'             TAB CHAR
         STB,R6   BUFFC,R5
         AI,R5    1
         LI,R6    6
         LB,R3    BUFFA,R6
         STB,R3   BUFFC,R5
         AI,R5    1
         AI,R6    1
         CW,R6    R2                COMPARE AGAINST REC SIZE
         BL       %-5
         STW,R5   D4                *SAVE REG*
*                                   END OF BUILDING PRINT REC
*                                   BUILD FILE ERRTEXT RECORD
         LI,R3    0                 INDX
         STW,R3   KEYY+2            INITIALIZE
VERS51   LB,R4    BUFFA,R3          CNVT CODES TO KEYS
         CI,R4    X'40'             BLANK=0(ZERO)
         BNE      %+2               NOT BLANK
         LI,R4    X'F0'             DUMMY IT
         AI,R4    -X'F0'
         BGEZ     VERS5             BRCH ON DEC DIGIT
         LB,R4    BUFFA,R3          GET AGAIN
         AI,R4    -X'C0'
         CI,R4    X'07'             CHK THE RANGE
         BGE      CODERR            INVALID CODE
         LB,R4    HEXTAB,R4         TRANS TO HEX
VERS5    AI,R3    1                 1ST TIME STEP
         STB,R4   KEYY,R3               OVER KEY LENG
         CI,R3    6                 DONE W/CNVT?
         BL       VERS51            NO
         LB,R2    REC1              GET REC SIZE
EMFWRT   M:WRITE  F:2,;
                  (BUF,BUFFA),(SIZE,*R2);
                  ,(WAIT),(NEWKEY);
                  ,(KEY,KEYY)
         MTW,0    CNTUFLG           WAS CONTINUE SET?
         BEZ      VERS42
         LB,R2    REC2              REC SIZE
         MTB,1    KEYY+2
         M:WRITE  F:2,(BUF,BUFFB),(SIZE,*R2),(NEWKEY);
                  ,(KEY,KEYY),(WAIT)
VERS42   LW,R2    D4                SIZE FROM *SAVE REG*
         M:WRITE  M:LO,(BUF,BUFFC),(SIZE,*R2),(WAIT)
         MTW,0    CNTUFLG           REC CONTINUED
         BEZ      VERS41
         M:DEVICE M:LO,(DATA,34)
         LB,R2    REC2
         M:WRITE  M:LO,(BUF,BUFFB),(SIZE,*R2),(WAIT)
         M:DEVICE M:LO,(DATA,0)
         M:DEVICE M:LO,(TAB,5,9,13,34)
         MTW,-1   CNTUFLG
VERS41   EXU      GETREC            RD THE NEXT REC
         LB,R2    BUFFA             LOOK AT FLAG BYTE
         CI,R2    '*'               IS * CARD ???
         BE       GETREC+1
         CI,R2    '<'               IS INFO CARD??
         BE       GETREC+1
         B        FILERR            ERROR IN DATA STRUCTURE
         PAGE
CRLF     EQU      %                 CR/LF ROUTINE
         LI,R1    CRBUF
         LI,R2    2
         CAL1,1   WRITE
         B        *SR4
*
*
*
VERR     EQU      %
         DO       ONL>1
         BAL,SR4  CRLF
         FIN
         LI,R1    VMESS
         LI,R2    40
         CAL1,1   WRITE
         DO       ONL>1
         BAL,SR4  CRLF
         FIN
         B        SRD
*
*
*
*
NOOP1    LI,R5    X'F1'
         B        NOOP
NOOP2    LI,R5    X'F2'
         B        NOOP
NOOP3    LI,R5    X'F3'
NOOP     LI,R4    13
         STB,R5   FMESS,R4
         DO       ONL>1
         BAL,SR4  CRLF
         FIN
         LI,R1    FMESS
         LI,R2    14
         CAL1,1   WRITE
         M:XXX
*
         PAGE
*
FORMAT   EQU      %                 SET UP TITLE &HEADINGS
         LI,R1    9                 INDEX INTO TOF
         LW,R2    VERBUF
         LI,R4    ' '               BLANK
         STB,R4   R2                LEADING BLANK FOR PRINT OUT
         STW,R2   TOF,R1
         M:DEVICE M:LO,(PAGE)
         M:WRITE  M:LO,(BUF,TOF),(SIZE,40),(WAIT)
         M:DEVICE M:LO,(TAB,5,9,13,34)
         M:DEVICE M:LO,(HEADER,1,HDPAGE)
         M:DEVICE M:LO,(PAGE)
         B        *SR4
*
         PAGE
*ENTRY  R2:  DCB ADDRESS
*
*
RECSIZE  EQU      %
         LI,R1    4
         LW,R6    *R2,R1
         SLS,R6   -17
         B        *SR4
*
CONTIN   EQU      %
         LI,R1    4                 INDX TO ARS
         LI,R2    F:1               ADDR OF DCB
         LW,R6    *R2,R1            GET ARS WORD
         SLS,R6   -17               SHIFT TO ARS
         AI,R6    -2                LOOK AT LAST 2 BYTES
         LB,R4    BUFFA,R6          GET LAST BYTE READ
         CI,R4    ';'               REC CONTINUED
         BE       %+3
         AI,R6    1                 GET LAST BYTE
         LB,R4    BUFFA,R6          TRY LAST BYTE
         B        *SR4
*
FILERR   EQU      %
         DO       ONL>1
         BAL,SR4  CRLF
         FIN
         LI,R1    FERR
         LI,R2    21
         CAL1,1   WRITE
         M:XXX
*
*
RDABN    EQU      %
         DO       ONL>1
         BAL,SR4  CRLF
         FIN
         LI,R1    X'07'             ABORT CODE
         CB,R1    SR3
         BNE      %+4
         LI,R1    BADRD             ABORT MESSG
         LI,R2    39
         CAL1,1   WRITE
         LI,R1    EOJ
         LI,R2    20
         CAL1,1   WRITE
         M:CLOSE  F:2,(SAVE)
         M:CLOSE  F:3,(SAVE)
         M:EXIT
*
*
KEYDUP   EQU      %
         LB,R6    SR3
         CI,R6    X'16'
         BNE      NOOP2
         B        GETREC
*
CODERR   EQU      %
         LI,R1    CERR              MSG TO R1
         LI,R2    37                SIZE OF MSG
         CAL1,1   WRITE
         M:XXX
         BOUND    4                 FPT'S BEGIN HERE
*
*
         DO       ONL>1
WRITE    GEN,8,24 X'11',M:UC
         ELSE
WRITE    GEN,8,24 X'11',M:LO
         FIN
         GEN,4,28 X'3',X'10'        BUF,SIZE,WAIT
         GEN,1,31 1,R1
         GEN,1,31 1,R2
*
*
CRBUF    DATA,2   X'0D15'
*
*
VMESS    TEXT     '   UNABLE TO READ VERSION XXX#  RECORD '
*
CERR     TEXT     '     BAD ERROR/SUB CODE...JOB ABORTED'
BADRD    TEXT     '          INPUT RECORD EXCEEDS 80 CHARS.'
*
FMESS    TEXT     'ERR/ABN ON F: '
*
TOF      TEXT     'MONITOR ERROR MESSAGE FILE VERSION      '
BCFLG    DATA     0
REC1     DATA     0
REC2     DATA     0
         BOUND    4
*
VERBUF   RES,1    80
*
         BOUND    8
BUFFA    RES,1    80                BUFFER 'A'
BUFFB    RES,1    80                BUFFER 'B'
*
BUFFC    RES,1    100               PRINT BUFF
*
         BOUND    8
KEYY     DATA     X'08000000'       KEY BUF-LENG 1ST BYTE
         DATA     0
         DATA     0
CNTUFLG  DATA     0
*
HEXTAB   EQU      %
         DATA,1   0,X'0A',X'0B',X'0C'
         DATA,1   X'0D',X'0E',X'0F'
         BOUND    4
*
HDPAGE   TEXTC    'GRP ERR SUB MODULE';
                  ,'                        MESSAGE'
*
*
FERR     TEXT     'FILE MST:ERR-BAD DATA'
EOJ      TEXT     '          END-OF-JOB'
         END      START
