*CREATED 04/19/71 AR #4813
*
*  ERROR MESSAGE WRITER
*  PROGRAMMER: R. ALLAN RAMACHER
*  THIS PROGRAM READS A DECK OF ERROR MESSAGE CARDS AND CREATES
*  OR UPDATES A CORRESPONDING KEYED RAD FILE
*
*  CARD FORMAT:
*
*
*        1 2 3 4 5 6 7 8
*        --------------------------------------------------------------
*       /  HEX CODE | TEXT OF ERROR MESSAGE.......
*      /
*      |
*      |
*      |
*      |
*      |
*      |
*      |
*      |
*      |
*
*
*
*
*  KEY FORMAT:
*
*
*        ------------------------------
*        |  03  |       HEX CODE       |
*        ------------------------------
*         0    7
         PAGE
         SYSTEM SIG7
         DEF      PATCH
         DEF      OPEN
         DEF      CARDBUF
         DEF      START
         REF      M:EO              WRITE RAD FILE DCB
         REF      M:DO              DIANOSTIC OUTPUT
         REF      M:EI                READ ERROR MESSAGES
         REF      M:LO
         REF      J:JIT
         PAGE
R        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
         PAGE
*
* P-LISTS USED BY ERROR MESSAGE WRITER
*
EMWPP    CSECT    1
         DEF      EMWPP                                              RL3
*
* HEADER P-LIST
*
HEADER   GEN,8,7,17 X'26',0,M:DO
         GEN,2,30 3,0
         DATA     HEAD
         DATA     44
*
* PAGE P-LIST
*
PAGE     GEN,8,7,17 X'04',0,M:DO
*
*
* OPEN ERROR MESSAGE FILE P-LIST
OPEN     GEN,8,7,17 X'14',0,M:EO
         DATA     X'47480001'
         PZE      *SR2              ABNORMAL ADDRESS IN SR2
         DATA     2                 KEYED FILE
         DATA     2                 DIRECT ACCESS
         PZE      *R4               MODE
         DATA     2                 SAVE
         DATA     4                 MAXIMUM KEY LENGTH
         DATA     X'01010202'
         TEXTC    'ERRMSG'          FILE NAME
*
* READ CARD P-LIST
READ     GEN,8,7,17 X'10',0,M:EI
         GEN,4,3,25 7,2,0
         DATA     EOD               ABNORMAL RETURN
         PZE      *R1               BUFFER ADDRESS IN R1 (FOR READ)
         DATA     80                MAXIMUM RECORD SIZE
         PZE      *R2               BYTE DISPLACEMENT IN R2 (FOR READ)
*
*  WRITE ERROR MESSAGE FILE P-LIST
WRITE    GEN,8,7,17 X'11',0,M:EO
         GEN,4,3,18,3,4 3,6,0,4,0
         PZE      *R1               BUFFER ADDRESS IN R1 (FOR WRITE)
         PZE      *R5               BUFFER SIZE IN R5
         DATA     KEY               KEY ADDRESS
         PZE      *R2               BYTE DISPLACEMENT IN R2 (FOR WRITE)
*
* WARNING MESSAGE P-LIST
DO       GEN,8,7,17 X'11',0,M:DO
         DATA     X'34000000'
         PZE      *R1               BUFFER ADDRESS
         PZE      *R2               BUFFER SIZE
         DATA     1
*
* LIST ERROR MESSAGE CARD FILE P-LIST
*
LO       GEN,8,7,17 X'11',0,M:LO
         DATA     X'34000000'
         PZE      *R1               BUFFER ADDRESS
         PZE      *R5
         PZE      *R2
* CLOSE ERROR MESSAGE FILE P-LIST
CLOSE    GEN,8,7,17 X'15',0,M:EO
         DATA     X'80000000'
         DATA     2                 SAVE THE FILE
*
* GO TO SLEEP P-LIST
*
WAIT     GEN,8,7,17 X'0F',0,1
         PAGE
BADCC    TEXTC    '***INVALID CONTROL '
BADHEX   TEXTC    '***INVALID HEX CODE '
NOTOPEN  TEXTC    '***UNABLE TO OPEN FILE ''ERRMSG'': JOB ABORTED '
BADCONT  TEXTC    '***ILLEGAL CONTINUATION'
HEAD     TEXTC    ' ERROR MESSAGE WRITER'
*
         BOUND    8
F0F9     DATA     '0','9'
C1C6     DATA     'A','F'
CONTCDS  DATA     '*0','*1'         LEGAL CONTROL COMMANDS
ASTER    GEN,16,8,8 0,'*',0
PC       GEN,8,16,8 X'2C',,'>'
*
EMWDD    CSECT    0
         DEF      EMWDD                                              RL3
CARDBUF  RES      40                CARD INPUT BUFFER
*
KEY      RES      1
ARS      RES      1
         PAGE
         USECT    EMWPP
START    EQU      %
         LB,R     J:JIT
         CI,R     X'80'             ON-LINE BIT SET
         BANZ     NOHDPG
         CAL1,1   HEADER
         CAL1,1   PAGE
NOHDPG   EQU      %
         LI,SR2   ABRTN
         LI,R4    4                 OPEN FILE IN 'INOUT' MODE
OPENFILE EQU      %
         CAL1,1   OPEN
         LI,R6    1                 DEFAULT IS 'NO KEY'
         CAL1,1   PC
READCARD EQU      %
         LI,R1    CARDBUF           GET BUFFER ADDRESS (FOR READ)
         LI,R2    0                 GET BYTE DISPLACEMENT (FOR READ)
         CAL1,1   READ              READ AN ERROR FILE CARD
         LW,R5    M:EI+4            DROP CR
         SLS,R5   -17
         LW,R4    R1                GET BUFFER ADDRESS
         SLS,R4   2                 CHANGE TO BYTE ADDRESS
         AW,R4    R5                ADD IN RECORD SIZE
         LB,R4    0,R4              GET LAST CHARACTER IN BUFFER
         CI,R4    X'0D'             CHECK FOR CARRIAGE RETURN
         BNE      %+3               B, IF NOT; BUFFER SIZE IS OK
         AI,R5    -1
         BEZ      EOD
         LB,R4    J:JIT
         CI,R4    X'80'
         BANZ     %+2
         CAL1,1   LO
         CI,R     ';'
         BE       CONTCARD          THIS IS A CONTINUATION CARD
         LI,R5    X'FF00'           MASK TO DETECT CONTROL CARDS
         LH,R4    CARDBUF
         CS,R4    ASTER             MASK TO DETECT CONTROL CARDS
         BNE      SCANSU
         CLM,R4   CONTCDS
         BCS,9    CONTERR
         AND,R4   =X'F'             ISOLATE CODE
         STW,R4   R6
         B        READCARD          READ ANOTHER CARD
SCANSU   EQU      %
         LI,R4    BA(CARDBUF)
         LI,R5    6                 CC1-CC6 HEX CODE
SCAN     EQU      %
         LB,R3    0,R4
         AI,R4    1
         CI,R3    ' '               FORWARD SCAN FOR A NON BLANK CHAR
         BNE      %+2
         LI,R3    '0'               BLANKS ARE TREATED AS ZEROS
         CLM,R3   F0F9
         BCR,9    CONTINUE+1        1>=R3<=9
         CLM,R3   C1C6
         BCR,9    CONTINUE          A>=R3<=F
         LI,R1    BADHEX            NON HEX NUMBER
         BAL,SR1  PRINT
         B        READCARD          READ ANOTHER CARD
*
         PAGE
*  THIS CODE CONVERTS THE EBCDIC CHARACTER TO HEX
*
CONTINUE EQU      %
         AI,R3    9                 ADD NINE BEFORE SHIFT
         SLS,R3   28                CLIP THR LEADING F OR C
         SLD,R2   4                 POSITION THE CONVERTED NUMBER
         BDR,R5   SCAN
         OR,R2    =X'03000000'      KEY IS COMPLETE
         STW,R2   KEY               PUT KEY IN WRITE FPT
         LI,R     -1
         BAL,R7   BACKSCAN
         B        SEMI:
CR       EQU      %
         AI,R5    1
         LI,R2    X'15'
         STB,R2   CARDBUF,R5        PUT CARRIAGE RETURN
         CI,R6    0
         BNE      CONTROL
         AI,R5    1
         LI,R2    0
         LI,R1    CARDBUF
         B        WRITFILE
CONTROL  EQU      %
         AI,R5    -5
         LI,R2    2
         LI,R1    CARDBUF+1
WRITFILE EQU      %
         CAL1,1   WRITE             WRITE A KEYED RECORD
         B        READCARD          READ ANOTHER CARD
         PAGE
*
*  AT THIS POINT A CARD APPENDED WITH A CONTINUATION CHARACTER HAS
*  BEEN DETECTED. THE NEXT CARD READ WILL BE APPENDED TO THIS ONE.
SEMI:    EQU      %
         STW,R5   ARS
         LI,R1    CARDBUF
         STW,R5   R2                PUT BYTE COUNT IN R2
         AND,R2   =X'3'             GET BYTE DISPLACEMENT
         SLS,R5   -2                BYTE COUNT/4 = WORD DISPLACEMENT
         AW,R1    R5                ADD TO STARTING ADDRESS
         B        READCARD+2
*
*
CONTCARD EQU      %
         LW,R     ARS
         AI,R     -1
         BAL,R7   BACKSCAN
         B        CONTNERR
         B        CR
*
*  COME HERE IF THE FILE DOES NOT EXIST OR IS CURRENTLY IN USE
ABRTN    EQU      %
         LI,SR2   SLEEP
         SLS,SR3  -17               RIGHT JUSTIFY THE ABNORMAL CODE
         CI,SR3   X'A01'            FILE BUZY
         BNE      %+3
         LI,SR4   10                TRY 10 TIMES
         B        SLEEP             GO TO SLEEP
         LI,R4    2                 CHANGE MODE TO 'OUT'
         B        OPENFILE          CREATE THE FILE
*
SLEEP    EQU      %
         CAL1,8   WAIT
         BDR,SR4  OPENFILE          TRY AGAIN
         LI,R1    NOTOPEN           COULD NOT OPEN FILE 'ERRMSG'
         BAL,SR1  PRINT
         CAL1,9   3                 ABORT JOB
*
CONTERR  EQU      %
         LI,R1    BADCC             ROTTEN CONTROL COMMAND
         BAL,SR1  PRINT
         B        READCARD          READ ANOTHER CARD
*
CONTNERR EQU      %
         LI,R1    BADCONT
         BAL,SR1  PRINT
         B        READCARD
*
EOD      EQU      %                 COME HERE AT END OF DECK
         CAL1,1   CLOSE             CLOSE AND SAVE THE FILE
         CAL1,9   1                 RETURN TO MONITOR
*
PRINT    EQU      %
         LB,R2    *R1
         CAL1,1   DO
         B        *SR1
*
BACKSCAN EQU      %
         LW,R5    M:EI+4            ARS
         SLS,R5   -17
         AW,R5    R
         LB,R     CARDBUF,R5
         CI,R     ';'               CONTINUATION
         BE       0,R7
         CI,R     X'15'             CARRIAGE RETURN
         BE       CNTBKSN
         CI,R     X'0D'
         BE       CNTBKSN
         CI,R     ' '               BLANK
         BNE      1,R7
CNTBKSN  EQU      %
         BDR,R5   BACKSCAN+3
         B        READCARD
         CSECT
PATCH    RES      50
         END      START

