***********************************************************************
*M*      LIST     LIST CCI CONTROL COMMANDS AND ERROR MESSAGES
************************************************************************
       CSECT       1
         SYSTEM   SIG7FDP
         SYSTEM   BPM
*P*
*P*      NAME:        LIST
*P*
*P*      PURPOSE:     TO LIST THE CCI CONTROL COMMANDS AND ERROR
*P*                   MESSAGES, SET THE CONTROL COMMAND LISTING
*P*                   FLAGS, SET THE CONTROL COMMAND ERROR POINTER
*P*                   (%) AND ERROR FLAGS, AND CHECK FOR OUTPUT
*P*                   DEVICE DUPLICATION.
*P*
*P*      DESCRIPTION: SEE FUNCTION PREAMBLES FOR SERRLF,SCCLF,
*P*                   SCCELF, ERRLFCK, CCLIST,ERRLIST AND LIST.
*P*
*P*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*P*
         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
*                 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)  TSTACK
         PEND
*                 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,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         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,TSTACK
         FIN
         FIN
         PEND
         DEF      SERRLF            SET ERROR LIST FLAGS IN JIT
         DEF      SCCLF             SET CONTROL COMMAND LIST FLAGS IN
*,*                                 THE JIT
         DEF      SCCELF            SET CONTROL COMMAND ERROR FLAGS AND
*,*                                 ERROR POINTER
         DEF      ERRLFCK           ERROR AND CONTROL COMMAND LISTING
*,*                                 FLAGS CHECK
         DEF      CCLIST            LIST CONTROL COMMAND AND ERROR BUFFER
         DEF      ERRLIST           OUTPUT ERROR MESSAGE ON SPECIFIED
*,*                                 DEVICES
         DEF      LIST              OUTPUT MESSAGE ON SPECIFIED DEVICES
         DEF      ERRCODEM          ERROR MESSAGE
         DEF      FTRMDM            INFORMATION MESSAGE
         DEF      FEXECM            INFORMATION MESSAGE
         DEF      RDERCFM           ERROR MESSAGE
         DEF      FADNDM            ERROR MESSAGE
         DEF      FBUSYM            ERROR MESSAGE
         DEF      FDEXM             ERROR MESSAGE
         DEF      CFEXAM            ERROR MESSAGE
         DEF      EXPBINM           ERROR MESSAGE
         REF      TSTACK            INPUT/OUTPUT-PRESERVE REGISTERS
         REF      ERLFMASK          MASK; BITS 25-31
         REF      CCLFMASK          MASK; BITS 25-31
         REF      KCCELMK1          MASK; BIT 22; LIST ERROR BUFFER
*,*                                 CONTROL COMMAND FLAG
         REF      KCCELMK2          MASK; BIT 21; LIST ERROR BUFFER AFTER
*,*                                 CONTROL COMMAND FLAG
         REF      KCCELMK3          MASK; BITS 21-22
         REF      CCLFM             MASK; BIT 23; NO CONTROL COMMAND LIST
*,*                                 FLAG
         REF      ERLFLAGS          MASK; BITS 25-31 IN JIT; ERROR
*,*                                 MESSAGE LISTING FLAGS
         REF      CCLTFLGS          MASK; BITS 25-31 IN JIT; CONTROL
*,*                                 COMMAND LISTING FLAGS
         REF      LISTCNT           EQU; COUNT OF OUTPUT DCBS
         REF      LISTDCBT          INPUT-TABLE CONTAINING OUTPUT DCB
*,*                                 ADDRESSES
         REF      MAXCCERCD         ERROR CODE CONSTANT
         REF      M:PO              OUTPUT-DIRECT BIT SET IF M:PO USED FOR
*,*                                 OUTPUTTING
         REF      M:OC              OUTPUT-MESSAGE OUTPUT TO OPERATOR BY
*,*                                 DEFAULT
         REF      BLANK             INPUT-BLANK OUT CONTROL COMMAND BUFFER
         REF      X1                MASK
         REF      PCCP              INPUT-OBTAIN PREVIOUS CHARACTER
*,*                                 POSITION OF LAST FIELD SCANNED
         REF      CCP               INPUT-OBTAIN CURRENT CHARACTER
*,*                                 POSITION OF LAST FIELD SCANNED
         REF      CCEBF             INPUT/OUTPUT-STORE ERROR BUFFER FLAG
         REF      CCEBFM1           INPUT-BYTE COUNT OF ERROR BUFFER
         REF      M:C               OUTPUT-LIST TO C DEVICE IF M:OC
*,*                                 ASSIGNMENT EQUAL TO M:C
         REF      GETDCBA           GET DCB ASSIGNMENT
         REF      ERRLFLGS          INPUT-FLAGS INDICATING DEVICES ON
*,*                                 WHICH TO LIST ERROR MESSAGE
         REF      CBUF              INPUT-BUFFER CONTINING CONTROL
*,*                                 COMMAND TO BE LISTED
         REF      Y4                CONSTANT
         REF      J:RNST            OUTPUT-BIT1; INDICATE M:XXX WAS
*,*                                 EXECUTED
         REF      DCBCLS            CLOSE OUTPUT DCBS BEFORE ABORTING
         REF      M:LL              OUTPUT-OUTPUT ERROR MESSAGES
         REF      X7F               MASK
         REF      HEXBCD            CONVERT HEXADECIMAL VALUE TO EBCDIC
         REF      Y03               BYTE COUNT FOR DASH INSERTION
         REF      Y04               RECORD NUMBER BYTE COUNT
         REF      Y08               MASK; BIT 4 IN JIT; CFE FLAG
         REF      RAMR              GET RECORD NUMBER FROM A/M
*,*                                 RECORD
         REF      AM:CREC           INPUT; GET RECORD NUMBER IF IN CFE
*,*                                 MODE
         REF      BINDCB            CONVERT HEXADECIMAL VALUE TO DECIMAL
*,*                                 -EBCDIC
         PAGE
K0       EQU      0
K1       EQU      1
K14      EQU      X'14'
K100     EQU      X'100'
K200     EQU      X'200'
KN1      EQU      -1
KN3      EQU      -3
KDLSGN   EQU      '%'
SECTION1 CSECT    1
GETPAGE  DATA     X'08000001'
RELPAGE  DATA     X'09000001'
Y4F      DATA     X'4F000000'
DASH     DATA     X'40604040'
         PAGE
*F*
*F*      NAME:        SERRLF
*F*
*F*      PURPOSE:     TO SET THE ERROR MESSAGE LISTING FLAGS IN THE
*F*                   JIT.
*F*
*F*      DESCRIPTION: THIS ROUTINE IS CALLED PRIOR TO OUTPUTTING
*F*                   AN ERROR MESSAGE. SPECIFIED ERROR LISTING
*F*                   FLAGS ARE SET IN THE JIT TO INDICATE THE
*F*                   DEVICE ON  WHICH THE ERROR MESSAGE IS TO BE
*F*                   OUTPUT.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        SERRLF - SET ERROR LISTING FLAGS IN JIT
*        CALLS ERRLFCK FOR DUPLICATE DEV CHECK AND THEN STORES
*        FLAGS IN JIT.
*        ENTER WITH ERROR LISTING FLAGS IN LOW ORDER BYTE OF R4(AL,PO,
*        DO,LO,SL,LL,OC), JIT POINTER IN R5
*
SERRLF   EQU      %
         PUSH     SR4
         BAL,SR4  ERRLFCK           CHECK FOR OUTPUT DEV DUPLICATION
         LW,R2    R4
         LW,R3    ERLFMASK
         STS,R2   ERLFLAGS,R5       STORE ERROR OUTPUT FLAGS IN JIT
         REF      GETLOC20
         B        GETLOC20          EXIT
*
         PAGE
*F*
*F*      NAME:        SCCLF
*F*
*F*      PURPOSE:     TO SET THE CONTROL COMMAND LISTING FLAGS IN
*F*                   THE JIT.
*F*
*F*      DESCRIPTION: THIS ROUTINE IS CALLED PRIOR TO OUTPUTTING A
*F*                   CONTROL COMMAND. SPECIFIED CONTROL COMMAND LISTING
*F*                   FLAGS ARE SET IN THE JIT TO INDICATE THE
*F*                   DEVICE ON WHICH THE CONTROL COMMAND IS TO
*F*                   BE LISTED.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        SCCLF -SET CONTROL COMMAND LISTING FLAGS IN JIT
*        CALLS CCLFCK FOR DUPLICATE DEV CHECK AND THEN STORES
*        CONTROL COMMAND LISTING FLAGS IN JIT
*        ENTER WITH CC LIST FLAGS IN LOW ORDER BYTE OF R4(AL,PO,DO,LO,
*        SL,LL,OC) , JIT POINTER IN R5
*
SCCLF    EQU      %
         PUSH     SR4
         BAL,SR4  CCLFCK            CHECK FOR OUTPUT DEV DUPLICATION
         LW,R2    R4
         LW,R3    CCLFMASK
SCCLF1   RES      0
         STS,R2   CCLTFLGS,R5       STORE OUTPUT FLAGS IN JIT
         B        GETLOC20
*
         PAGE
*F*
*F*      NAME:    SCCELF
*F
*F*      PURPOSE: TO SET THE CONTROL COMMAND ERROR POINTER (%) AND
*F*               ERROR FLAG.
*F*
*F*      DESCRIPTION: THIS ROUTINE IS CALLED PRIOR TO OUTPUTTING
*F*               AN ERRONEOUS CONTROL COMMAND. THE CONTROL COMMAND ERROR
*F*               POINTER (%) IS SET IN THE APPROPRIATE POSITION IN THE
*F*               ERROR BUFFER TO INDICATE THE CHARACTER OR FIELD IN
*F*               ERROR.
*F*
*F*      REFERENCE: DATA BASE TECHNICAL MANUAL
*F*
*        SCCELF - SET CONTROL COMMAND ERROR LISTING FLAG
*        ENTER WITH
*        (R4) =   ERROR INDICATOR,0 = CUR CHAR ERROR, 1 = FIELD ERROR
*        (R5) =   JIT POINTER
*        (R7) =   CONTROL COMMAND PARAM LIST POINTER
*        A FLAG IS SET IN JIT TO INDICATE IF CC ERR BUF IS TO BE PRINTED
*        BEFORE OR AFTER NEXT CC RECORD
*
*
SCCELF   EQU      %
         LI,R2    K14
         LW,R3    BLANK
SCCELF1  EQU      %
         STW,R3   CCEBFM1,R2        STORE BLANKS IN CONTROLCOMMAND
         BDR,R2   SCCELF1                    ERROR BUFFER
*
         LI,R0    KDLSGN
         LW,R1    PCCP,R7
         LW,R2    CCP,R7
         LW,R3    0,R5              IF IN CFE MODE ADJUST ERROR POINTER
         CW,R3    Y08
         BAZ      SCCELF1A
         AI,R1    7
         AI,R2    7
SCCELF1A EQU      %
         AI,R1    -3
         AI,R2    -3
         CI,R4    K1                CHECK IF CUR CHAR IN ERROR
         BAZ      SCCELF4
         STB,R0   CCEBF,R1          STORE % IN CC ERR BUFFER
         CW,R1    R2                CHECK IF PCCP <= CCP
         BLE      SCCELF2
         LI,R3    KCCELMK1          LIST ERR BUFF BEFORE CC
         B        SCCELF3
*
SCCELF4  AI,R2    KN1
         STB,R0   CCEBF,R2
SCCELF2  EQU      %
         LI,R3    KCCELMK2          LIST ERR BUFF AFTER CC
SCCELF3  EQU      %
         STS,R3   CCLTFLGS,R5       SET CC ERR LIST FLAG
         B        *SR4
         PAGE
*F*      NAME:        ERRLFCK (CCLFCK)
*F*
*F*      PURPOSE:     TO CHECK FOR OUTPUT DEVICE DUPLICATION.
*F*
*F*      DESCRIPTION; SPECIFIED LOGICAL DEVICE ASSIGNMENTS ARE
*F*                   CHECKED FOR OUTPUT DUPLICATION. ASSOCIATED
*F*                   LOGICAL DEVICE BITS IN THE JIT ARE RESET
*F*                   IF DEVICE DUPLICATION DOES OCCUR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        ERRLFCK, CCLFCK - ERROR AND CONTROL COMMAND LISTING FLAG CHECK
*        CHECKS WHICH DEVICES OUTPUT IS TO BE LISTED ON AND CHECKS FOR
* DEVICE DUPLICATION. FLAGS FOR DUPLICATE DEVICES ARE RESET
*        ENTER WITH FLAG INDICATOR IN LOW ORDER BYTE OF R4 (AL,PO,DO,
* LO,SL,LL,OC),LINK ADR IN SR4
*        EXITS WITH FLAGS IN R4 WITH DUPLCATE ONES RESET.
*
*
ERRLFCK  EQU      %
         LI,D3    K0                SET FLAG FOR NO OC=C DEV CHECK
         B        LFCK1
*
CCLFCK   EQU      %
         LI,D3    K1                SET FLAG FOR OC=C DEV CHECK
LFCK1    EQU      %
         PUSH     7,R6
         LW,R7    TSTACK
         AI,R7    KN3               (R7) = ADR OF TABLE
         LI,R3    LISTCNT           (R3) = LIST COUNT
LFCK2    EQU      %
         LI,R1    K0
         CI,R4    K1                CHECK IF TO OUTPUT ON CUR DEV
         BAZ      LFCK3             BRANCH IF NOT
         LW,R6    LISTDCBT,R3       (R6) = ADR OF CRRENT DCB OR ZERO
         BNEZ     LFCK11
         LI,R1    1                 FIX  OC  ASSIGNMENT
         B        LFCK3
LFCK11   RES      0
         BAL,D4   GETDCBA           GET DCB ASSIGNMENT
LFCK3    EQU      %
         STH,R1   *R7,R3            STORE ASSIGNMENT OR 0 IN TABLE
         SCS,R4   KN1               SHIFT FLAGS
         BDR,R3   LFCK2
         SCS,R4   LISTCNT
*
         LI,R0    K0
         LI,R3    LISTCNT
LFCK4    EQU      %
         LW,R2    R3
         AI,R2    KN1
         BEZ      LFCK8
         LH,R1    *R7,R3
         BEZ      LFCK7
LFCK5    EQU      %
         CH,R1    *R7,R2            CHECK FOR EQUAL ASSIGNMENTS
         BNE      LFCK6
         STH,R0   *R7,R2            SET ASSIGNMENT = 0
LFCK6    EQU      %
         BDR,R2   LFCK5
LFCK7    EQU      %
         BDR,R3   LFCK4
*
LFCK8    EQU      %
         LI,R3    LISTCNT
         LI,R4    K0
         AI,D3    0                 CHK IF REDUCING CC LIST FLAGS
         BEZ      LFCK9             BRANCH IF NO
         LI,R6    M:C
         BAL,D4   GETDCBA           GET C DCB ASSIGNMENT
         CH,R1    *R7,R3            CHECK IF C=OC
         BNE      LFCK9             BRANCH IF NOT
         STH,R4   *R7,R3            SET OC ASSIGNMENT =0
LFCK9    EQU      %
         LH,R1    *R7,R3            CHECK FOR UNIQUE ASSIGNMENTS
         BEZ      LFCK10
         OR,R4    X1                SET LIST FLAG
LFCK10   EQU      %
         SCS,R4   KN1               SHIFT LIST FLAGS
         BDR,R3   LFCK9
         SCS,R4   LISTCNT           REPOSITION SHIFT FLAGS
         BUMP     -4,R1
         PULL     3,R6
         B        *SR4
*
         PAGE
*F*
*F*      NAME:        CCLIST
*F*
*F*      PURPOSE:    TO OUTPUT THE CONTROL COMMAND AND ERROR BUFFER
*F*                                 ON THE SPECIFIED DEVICES. IF IN
*F*                                 COMMAND FILE MODE, THE CONTROL COMMAND
*F*                                 IS PRECEDED BY IT'S COMMAND FILE
*F*                                 RECORD NUMBER.
*F*
*F*      DESCRIPTION: A DETERMINATION IS MADE AS TO WHETHER THE
*F*                   ERROR BUFFER SHOULD BE OUTPUT INDICATING
*F*                   THE FIELD OR CHARACTER IN ERROR ON THE
*F*                   CONTROL COMMAND. THE CONTROL COMMAND AND,
*F*                   IF APPLICABLE, THE ERROR BUFFER ARE THEN
*F*                   OUTPUT IN THE DESIRED ORDER.
*F*
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        CCLIST  -CONTROL COMMAND LIST ROUTINE
*        SETS (R2) = ADR OF CC BUF -1,(R4) = CC LIST FLAGS
*        AND CALLS LIST ROUTINE IF NO CC LIST FLAG IS NOT SET
*        ENTER WITH  JIT POINTER IN R5
*        IF CC ERROR LIST FLAG IS SET, CC ERROR BUFFER IS LISTED ALSO
*
CCLIST   EQU      %
         LW,R4    CCLTFLGS,R5       PICK UP CC LIST FLAGS FROM JIT
         CI,R4    CCLFM             CHECK IF NO CC LIST FLAG SET
         BANZ     *SR4              BRANCH IF YES
         PUSH     SR4
         CI,R4    KCCELMK2          CHECK IF LIST CC ERR BUF AFTER CC
         BANZ     CCLIST3           BRANCH IF YES
         CI,R4    KCCELMK1          CHECK IF LIST CC ERR BUF BEFORE CC
         BAZ      CCLIST1           BRANCH IF NO
         BAL,SR4  CCLIST5           LIST CC ERR BUF
         LW,R4    CCLTFLGS,R5       PICK UP CC LIST FLAGS FROM JIT
CCLIST1  EQU      %
         BAL,SR4  CCLIST10          LIST CC
CCLIST2  EQU      %
         LI,R2    K0
         LI,R3    KCCELMK3
         B        SCCLF1            EXIT
CCLIST3  EQU      %
         BAL,SR4  CCLIST10          LIST CC
         LI,SR4   CCLIST2           SET RETURN
         LW,R4    CCLTFLGS,R5       PICK UP CC LIST FLAGS FROM JIT
*
CCLIST5  EQU      %
         LI,R2    CCEBFM1
         B        CCLIST30
*
CCLIST10 EQU      %
         LW,R0    *R5               ARE WE IN COMMAND FILE MODE
         CW,R0    Y08
         BAZ      CCLIST25          MUST PRECEDE CC WITH LINE NUMBER
*
         PUSH     2,SR1             SAVE LAST CHAR. SCND AND COMPARE CHAR.
         CAL1,8   GETPAGE
         BCS,8    CCLIST24          COULDN'T GET BUFFER, PRINT AS IS
         PUSH     SR4
         BAL,SR4  RAMR              READ A/M RECORD FOR LINE NUMBER
         MTW,0    SR3
         BNEZ     CCLIST20          COULDN'T READ A/M, PRINT AS IS
*
         PUSH     2,D1
         LI,R1    AM:CREC           GET RECORD NUMBER
         LW,D1    *SR2,R1
         AI,D1    -1                DECREMENT AS IT POINTS TO NEXT REC'D
         BAL,SR4  BINDCB            CONVERT TO DECIMAL EBCDIC VALUE
         LI,SR1   D2**2             SOURCE ADDRESS
         SLS,SR2  2                 DESTINATION ADDRESS - USE A/M BUFFER
         AI,SR2   1
         PUSH     SR2
         OR,SR2   Y04               FOUR CHARACTERS TO MOVE
         MBS,SR1  0                 MOVE REC'D NUMBER TO BYTES 1-4
*
         LI,SR1   BA(DASH)          INSERT DASH AFTER REC'D NUMBER
         OR,SR2   Y03
         MBS,SR1  0
*
         LW,SR1   CBUF,R7           MOVE CC AFTER BLANK
         SLS,SR1  2
         OR,SR2   Y4F
         MBS,SR1  1
*
         PULL     R2                GET OUTPUT ADDRESS
         PULL     2,D1
         SW,SR2   R2                CALCULATE OUTPUT SIZE
         STW,SR2  R3
         SLS,R2   -2
         LI,D4    1                 BYTE DISPLACEMENT
         BAL,SR4  LIST+1            LIST THE CC
         CAL1,8   RELPAGE
         PULL     SR4
         PULL     2,SR1             RESTORE LAST CHAR. SCND AND COMP. CHAR.
         B        *SR4
CCLIST20 EQU      %
         PULL     SR4
         CAL1,8   RELPAGE
         PULL     2,SR1             RESTORE LAST CHAR. SCND AND COMP. CHAR.
         B        CCLIST25
CCLIST24 EQU      %
         PULL     2,SR1             RESTORE LAST CHAR. SCND AND COMP. CHAR.
CCLIST25 EQU      %
         LW,R2    CBUF,R7           GET CCBUF ADDRESS
*
CCLIST30 EQU      %
         LI,D4    1                 SET BTD
         LI,R3    79                SET UP OUTPUT SIZE FOR CC
         B        LIST+1
         PAGE
*F*
*F*      NAME:        ERRLIST
*F*
*F*      PURPOSE:     TO OUTPUT AN ERROR MESSAGE ON THE SPECIFIEID
*F*                   DEVICES.
*F*
*F*      DESCRIPTION: A SPECIFIED ERROR CODE IS CONVERTED TO THE
*F*                   ADDRESS OF AN ERROR MESSAGE AND THE LIST
*F*                   ROUTINE CALLED TO OUTPUT THE SPECIFIED
*F*                   ERROR MESSAGE. IF THE ERROR IS A CONTROL
*F*                   COMMAND ERROR, THE MESSAGE 'ABOVE CONTROL
*F*                   COMMAND IN ERROR' IS OUTPUT PRIOR TO THE
*F*                   ERROR MESSAGE.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        ERRLIST - ERROR LIST
*        CONVERTS ERROR CODE IN SR3 TO ADR OF ERROR MESSAGE
*        AND CALLS LIST TO LIST MESSAGE ON SPECIFIED DEVICES
*        ENTER WITH ERROR CODE IN SR3, JIT POINTER IN R5
*
ERRLIST  EQU      %
         PUSH     SR4
         LW,R2    SR3
         LW,R4    ERRLFLGS,R5       (R4) = ERROR LIST FLAGS
         CI,SR3   MAXCCERCD         CHK IF < MAX CC ERR CD
         BG       ERRLIST1
         LI,R2    ACCIEM            (R2) = ADR OF MESSAGE
         LI,D4    1                 BTD
         PUSH     SR3               PRESERVE ERROR CODE
         BAL,SR4  LIST
         PULL     SR3               RESTORE ERROR CODE
         LW,R2    SR3
         LW,R4    ERRLFLGS,R5       HAS TO RESTORE FLGS FOR ERRLIST LL
         CI,SR3   K100
         BL       ERRLIST2
         CI,SR3   K200
         BL       ERRLIST3
         LW,R2    MESSTBL2-K200,R2
         B        ERRLIST1
ERRLIST3 EQU      %
         LW,R2    MESSTBL1-K100,R2
         B        ERRLIST1
ERRLIST2 EQU      %
*
         LW,R2    MESSTBL,R2
ERRLIST1 EQU      %
         PULL     SR4
         LI,D4    1                 BTD
         B        LIST
*
*        ERROR MESSAGE ADR TABLE
*
         BOUND    4
MESSTBL  EQU      %-1
         DATA     BLNKERM           ADR OF BLANK       ERR MESSAGE
         DATA     COMERM            ADR OF COMMA       ERR MESSAGE
         DATA     LPERM             ADR OF LEFT PAREN  ERR MESSAGE
         DATA     RPERM             ADR OF RIGHT PAREN ERR MESSAGE
         DATA     TERMERM           ADR OF TERM        ERR MESSAGE
         DATA     0                 DUMMY ENTRY
         DATA     ILCHERM
         DATA     SYNTXERM
         DATA     0                 DUMMY ENTRY
         DATA     0                 DUMMY ENTRY
         DATA     WSNERR
MESSTBL1 EQU      %
         DATA     KWERM             ADR OF KEYWORD     ERR MESSAGE
         DATA     CHSTERM           ADR OF CHAR STRING ERR MESSAGE
         DATA     ALPHERM           ADR OF ALPHANUM.   ERR MESSAGE
         DATA     DECERM            ADR OF DECIMAL NO. ERR MESSAGE
         DATA     HEXERM            ADR OF HEXIDECIMAL ERR MESSAGE
         DATA     DUPERM            ADR OF DUPLICATION ERR MESSAGE
         DATA     VALERM            ADR OF VALUE       ERR MESSAGE
         DATA     INSFERM           ADR OF INSUF PARAM ERR MESSAGE
         DATA     MRWERM            ADR OF MAX R/W ACT ERR MESSAGE
         DATA     ILSEGNM           ADR OF ILL. SEG NAME   ERR MESSAGE
         DATA     ILLRMNM                                               903
         DATA     DVER       10B
         DATA     BIGER      10C
         DATA     OUTER
         DATA     GETER
         DATA     PUTER
         DATA     OPERM             ADR OF ILL. OPTION ERR MESSAGE
         DATA     OPERRX
         DATA      ACCERM
         DATA     TSTORM1           TSTORE RAD ERR MSG
         DATA     TSTORM2           TSTORE PACK ERR MSG
         DATA     PSTORM1           PSTORE RAD ERR MSG
         DATA     PSTORM2           PSTORE PACK ERR MSG
         DATA     PARAMERM          ADR OF ILLEGAL PARAMETER ERR MSG
         DATA     IDCBNAMM
         DATA     MUNSATER          MAX UNSAT ERR MSG
         DATA     MEXECER           MAX EXECUTE ERR MSG
         DATA     RPROERM
         DATA     CCORDM            CC OUT OF ORDER ERR MSG
         DATA     INVPASS           INVALID PASSWORD
*
MESSTBL2 EQU      %
         DATA     INVTRM            LOAD MODULE HAS INVALID TREE RECD.
         DATA     SDCBNAM
         DATA     LDEXSTM           LOAD MODULE DOESN'T EXIST ERR MSG
         DATA     LDBUSYM           LOAD MODULE BUSY ERR MSG
         DATA     ILLASGM
         DATA     DUPSEGNM          DUPLICATE SEGMENT NAMES
         DATA     ROMTOVM           ADR OF ROMT OVERFLOW   ERR MESSAGE
         DATA     NOROMM            ROM IN EF NOT IN TREE
         DATA     OPNERM
         DATA     MXMODM            MAX MODIFY LOCATIONS EXCEEDED
         DATA     INVHDM            LOAD MODULE HAS INVALID HEAD RECD.
         DATA     RUNERM
         DATA     RDBIEM            READ BI I/O ERR MESSAGE
*                                                                    CM
         DATA     INSTARM           ADDR OF USER BARRED BY INSTN. LL
         DATA     0                 DUMMY ENTRY
         DATA     NOPGERRM
         DATA     0                 DUMMY ENTRY
         DATA     LMXCEDM           LIMIT EXCEEDS MAX.
         DATA     ILLCFM            ILLEGAL CC FOR COMMAND FILE
         DATA     RDEXM             RECORD DOESN'T EXIST
*
         PAGE
**********************************************************************
*                                                                    *
*        CONTROL  COMMAND ERROR  MESSAGES                            *
*                                                                    *
**********************************************************************
ACCIEM   TEXTC    'ABOVE CONTROL COMMAND IN ERROR'
BLNKERM  TEXTC    'EXPECTED BLANK MISSING'
COMERM   TEXTC    'EXPECTED COMMA MISSING'
LPERM    TEXTC    'EXPECTED LEFT PARENTHESIS MISSING'
RPERM    TEXTC    'EXPECTED RIGHT PARENTHESIS MISSING'
TERMERM  TEXTC    'EXPECTED TERMINATOR MISSING'
ILCHERM  TEXTC    'ILLEGAL CHARACTER'
SYNTXERM TEXTC    'SYNTAX ERROR'
WSNERR   TEXTC    'INVALID WORK STATION NAME'
KWERM    TEXTC    'ILLEGAL KEYWORD'
CHSTERM  TEXTC    'ILLEGAL CHARACTER STRING'
ALPHERM  TEXTC    'ILLEGAL ALPHANUMERIC NAME'
DECERM   TEXTC    'ILLEGAL DECIMAL NUMBER'
HEXERM   TEXTC    'ILLEGAL HEXADECIMAL NUMBER'
DUPERM   TEXTC    'DUPLICATION OF FIELDS'
VALERM   TEXTC    'ILLEGAL VALUE'
ILLRMNM  TEXTC    'ILLEGAL LOAD MODULE NAME'
DVER     TEXTC    'DUPLICATE OR CONFLICTING OPTION'
BIGER TEXTC 'TOO MANY ASSIGNMENTS'
OUTER    TEXTC    'TOO MANY INSNS OR OUTSNS'
GETER    TEXTC    'ERROR READING A/M'
PUTER    TEXTC    'ERROR WRITING A/M'
OPERRX   TEXTC    'OP LABEL ERROR'
ACCERM   TEXTC    'INVALID NAME OR ACCOUNT'
ILLASGM  TEXTC    'ILLEGAL ASSIGNMENT'
INSFERM  TEXTC    'INSUFFICIENT PARAMETERS'
MRWERM   TEXTC    'MAXIMUM NUMBER OF READ AND/ WRITE ACCOUNTS EXCEEDED'
SDCBNAM  TEXTC    'SYSTEM DCB NOT-ASSIGNABLE'
LDEXSTM  TEXTC    'LOAD MODULE DOES NOT EXIST'
CCORDM   TEXTC    'CONTROL COMMAND OUT OF ORDER'
ILSEGNM  TEXTC    'ILLEGAL SEGMENT NAME'
ROMTOVM  TEXTC    'TOO MANY EFS'
OPNERM   TEXTC    'ABN. COND. IN OPENING  DCB'
RUNERM   TEXTC    'ILLEGAL OR INSUFFICIENT INFORMATION ON RUN CC'
RDBIEM   TEXTC    'I/O ERROR/ABNORMAL IN READBI SUBROUTINE'
INSTARM  TEXTC    'INSTALLATION PROHIBITS YOUR LOGGING ON'
NOPGERRM TEXTC    'CANT GET DYNAMIC PAGES'
LMXCEDM  TEXTC    'SPECIFIED LIMIT EXCEEDS MAXIMUM'
TSTORM1  TEXTC    'TSTORE EXCEEDS REMAINING RAD SPACE ALLOCATED'
TSTORM2  TEXTC    'TDISK EXCEEDS REMAINING PACK SPACE ALLOCATED'
PSTORM1  TEXTC    'PSTORE EXCEEDS REMAINING RAD SPACE ALLOCATED'
PSTORM2  TEXTC    'PDISK EXCEEDS REMAINING PACK SPACE ALLOCATED'
PARAMERM TEXTC    'ILLEGAL PARAMETER'
IDCBNAMM TEXTC    'ILLEGAL DCB NAME'
MUNSATER TEXTC    'MAXIMUM NUMBER OF UNSAT ACCOUNTS EXCEEDED'
MEXECER  TEXTC    'MAXIMUM NUMBER OF EXECUTE ACCOUNTS EXCEEDED'
RPROERM  TEXTC    'USER NOT AUTHORIZED FOR REMOTE PROCESSING'
DUPSEGNM TEXTC    'DUPLICATE SEGMENT NAMES'
NOROMM   TEXTC    'MODULE IN EF LIST NOT SPECIFIED IN TREE'
MXMODM   TEXTC    'MAXIMUM NUMBER OF MODIFICATIONS EXCEEDED'
OPERM    TEXTC    'ILLEGAL OPTION'
INVTRM   TEXTC    'LOAD MODULE HAS INVALID TREE RECORD'
INVHDM   TEXTC    'LOAD MODULE HAS INVALID HEAD RECORD'
INVPASS  TEXTC    'INVALID PASSWORD'
CFEXAM   TEXTC    'COMMAND FILE EXECUTION ABORTED DUE TO LACK OF';
                  ,' SPACE IN A/M RECORD'
FDEXM    TEXTC    'COMMAND FILE DOES NOT EXIST'
FBUSYM   TEXTC    'COMMAND FILE IS BUSY'
FADNDM   TEXTC    'COMMAND FILE ACCESS DENIED'
RDEXM    TEXTC    'SPECIFIED COMMAND FILE RECORD DOESNT EXIST'
EXPBINM  TEXTC    'EXPECTED BINARY WASNT ENCOUNTERED ON BI DEVICE'
RDERCFM  TEXTC    'READ ERROR ON COMMAND FILE'
ILLCFM   TEXTC    'ILLEGAL CONTROL COMMAND FOR COMMAND FILE'
LDBUSYM  TEXTC    'LOAD MODULE IS BUSY'
         CSECT    0
ERRCODEM TEXTC    'ERROR CODE =     '
FEXECM   TEXTC    '**** XXXXXXXXXXX    EXECUTED AT RECORD XXXX ****'
FTRMDM   TEXTC    '**** XXXXXXXXXXX  TERMINATED AT RECORD XXXX ****'
         USECT    SECTION1
         PAGE
*F*
*F*      NAME:        LIST
*F*
*F*      PURPOSE:     TO OUTPUT A MESSAGE ON SPECIFIED DEVICES
*F*
*F*      DESCRIPTION: A SPECIFIED ERROR MESSAGE IS OUTPUT ON THE
*F*                   SPECIFIED DEVICE.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        LIST     LISTS SPECIFIED OUTPUT ON THE SPECIFIED DEVICES
*        ENTER WITH
*        (R2) = ADR OF OUTPUT, 1ST WORD OF WHICH HAS BYTE COUNT
*        (R4) = DEVICE INDICATORS
*        (D4) = BYTE DISPLACEMENT
*                 BIT 25  = AL
*                 BIT 26  = PO
*                 BIT 27  = DO
*                 BIT 28  = LO
*                 BIT 29  = SL
*                 BIT 30  = LL
*                 BIT 31  = OC
*                 0 MEANS NO OUTPUT, 1 MEANS OUTPUT
LIST     EQU      %
         LB,R3    *R2
         AW,R3    D4
         LI,R1    X'40'
         B        LIST2A-1          *DEC CHAR CNT &CHK IF BLANK
LIST2    EQU      %
         CB,R1    *R2,R3            DECREMENT BYTE COUNT BY
         BNE      LIST2A
         BDR,R3   LIST2                           TRAILING BLANKS
LIST2A   EQU      %
         AI,R3    1                 *RESTORE CHAR CNT
         SW,R3    D4
         LI,R1    LISTCNT
LIST5    EQU      %
         CI,R4    1
         BAZ      LIST7
         LW,D3    LISTDCBT,R1       (D3) = DCB ADR
         BNEZ     LIST6                                                 903
         LI,D3    M:OC              DEFAULT TO OPERATOR
LIST6    EQU      %
         PUSH     SR1               SAVE LAST CHARACTER SCANNED
         CAL1,1   SETDCB            SET ERR AND ABN
         CAL1,1   LISTPLIST         OUTPUT MESSAGE
         PULL     SR1               RESTORE LAST CHARACTER SCANNED
         CI,D3    M:PO              CHECK IF M:PO DCB
         BNE      LIST7             NO
         CAL1,1   DIRPLIST          YES, SET DIRECT BIT
LIST7    EQU      %
         SLS,R4   -1                SHIFT DEVICE INDICATORS
         BDR,R1   LIST5
         B        *SR4
         PAGE
*
*        CRPLIST- CARRIAGE RETURN PLIST
*
*
*        LIST MESSAGE PLIST
*
LISTPLIST EQU     %
         GEN,8,24 X'91',D3
         DATA     X'F4000000'                                           903
         DATA     LLFIX
         DATA     LLFIX
         GEN,8,24 X'80',R2
         GEN,8,24 X'80',R3
         GEN,8,24 X'80',D4
*
*        SET DIRECT BIT PLIST
*
DIRPLIST EQU      %
         GEN,8,24 X'8B',D3
         DATA     X'10'
*
*        SETDCB   PLIST
*
SETDCB   EQU      %
         GEN,8,24 X'86',D3
         DATA     X'C0000000'
         DATA     LLFIX
         DATA     LLFIX
*
*  ON ERR OR ABN WHEN WRITING M:LL DCB
*  FORCE OUTPUT TO LOGICAL STREAM L1.
*
LLFIX    EQU      %
         CI,D3    M:LL              SEE IF M:LL
         BNE      *SR1              IF NOT,IGNORE
         LI,R1    1
         LC       M:LL,R1           SEE IF M:LL IS OPEN
         BCR,2    %+2
         M:CLOSE  M:LL              CLOSE IT
         M:LDEV   'L1',(DEV,'LP')   ASSIGN PRINTER TO LOGICAL STREAM L1
         M:OPEN   M:LL,(DEVICE,'L1'),(OUT),(CONSEC)
         M:DEVICE M:LL,(NOVFC)
         M:DEVICE M:LL,(SPACE,1)
*E*      MESSAGE: SEVERE ERROR OM M:LL DCB
*E*      DESCRIPTION: AN ERROR OCCURRED UPON ATTEMPTING TO WRITE
*E*                   THROUGH THE M:LL DCB.
         LI,R2    LLERRG1
         LI,R4    2
         LI,D4    1
         BAL,SR4  LIST              GO LIST ERROR MESSAGE
*
         LB,D1    SR3               OUTPUT ERROR CODE TO USER
         SLS,SR3  -17
         AND,SR3  X7F
         STB,SR3  D1
         SCS,D1   24
         BAL,D4   HEXBCD
         LI,R1    HA(ERRCODEM)+8
         STH,D1   0,R1
         SLS,D1   -16
         AI,R1    -1
         STH,D1   0,R1
*E*      MESSAGE: ERROR CODE =
*E*      DESCRIPTION: THE ERROR OR ABNORMAL OCCURRED WHILE ATTEMPTING TO
*E*                   WRITE THROUH THE M:LL DCB.
         LI,R2    ERRCODEM
         LI,R4    2
         LI,D4    1
         BAL,SR4  LIST
*
         LW,R5    Y4
         STS,R5   J:RNST
         BAL,SR4  DCBCLS            CLOSE OUTPUT DCBS
         CAL1,9   3                 ABORT
*
LLERRG1  TEXTC    'SEVERE ERROR ON M:LL DCB'
         END

