*                 CATALOG NO. 704903 - SIGMA 5/7 BPM M:CCILIST
       CSECT       1
         SYSTEM   SIG7FDP
         SYSTEM   BPM
*
*
*        CCI LIST ROUTINES
*
*
         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
         PAGE
         DEF      SERRLF,SCCLF,SCCELF,ERRLFCK,CCLIST
         DEF      ERRLIST,LIST
         SPACE    3
         REF      TSTACK
         REF      ERLFMASK,CCLFMASK,KCCELMK1,KCCELMK2,KCCELMK3,CCLFM
         REF      ERLFLAGS,CCLTFLGS
         REF      LISTCNT,LISTDCBT,MAXCCERCD
         REF      M:PO
         REF      M:OC
         REF      BLANK,X1
         REF      PCCP,CCP
         REF      CCEBF,CCEBFM1
         REF      M:C
         REF      GETDCBA
         REF      ERRLFLGS
         REF      CBUF                                                  903
         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      '%'
         PAGE
*        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
*        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
*        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
         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
*        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     6,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     2,R6
         B        *SR4
*
         PAGE
*        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 BEFORE CC
         BANZ     CCLIST3           BRANCH IF YES
         CI,R4    KCCELMK1          CHECK IF LIST CC ERR BUF AFTER CC
         BAZ      CCLIST1           BRANCH IF NO
         BAL,SR4  CCLISTB           LIST CC ERR BUF
CCLIST1  EQU      %
         BAL,SR4  CCLISTA           LIST CC
CCLIST2  EQU      %
         LI,R2    K0
         LI,R3    KCCELMK3
         B        SCCLF1            EXIT
CCLIST3  EQU      %
         BAL,SR4  CCLISTA           LIST CC
         LI,SR4   CCLIST2           SET RETURN
         LW,R4    CCLTFLGS,R5       PICK UP CC LIST FLAGS FROM JIT
*
CCLISTB  LI,R2    CCEBFM1
         B        CCLISTC
*
CCLISTA  LW,R2    CBUF,R7
*
CCLISTC  LI,D4    1                 SET BTD
         LI,R3    80                SET UP OUTPUT SIZE FOR CC
         B        LIST+1
         PAGE
*        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
         BAL,SR4  LIST
         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     HYPNERM
         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     0                 DUMMY ENTRY
         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
*
MESSTBL2 EQU      %
         DATA     0
         DATA     SDCBNAM
         DATA     0                 DUMMY ENTRY
         DATA     0                 DUMMY ENTRY                         903
         DATA     ILLASGM
         DATA     0                 DUMMY ENTRY
         DATA     ROMTOVM           ADR OF ROMT OVERFLOW   ERR MESSAGE
         DATA     0                 DUMMY ENTRY
         DATA     OPNERM
         DATA     0                 DUMMY ENTRY
         DATA     0
         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.
*
         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'
HYPNERM  TEXTC    'EXPECTED HYPEN 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 ASSIGMENTS'
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'
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    'ABORTED BY INSTALLATION,SEE SOMEBODY'          LL
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'
         PAGE
*        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      %
         CAL1,1   SETDCB            SET ERR AND ABN
         CAL1,1   LISTPLIST         OUTPUT MESSAGE
         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 LINE PRINTER
*
         REF      Y4,J:RNST,DCBCLS,M:LL
LLFIX    EQU      %
         CI,D3    M:LL              SEE IF M:LL
         BNE      *SR1              IF NOT,IGNORE
         LB,SR3   SR3               CHECK ERROR CODE
         CI,SR3   X'49'
         BE       LLMESS
         CI,SR3   X'3F'
         BL       *SR1              ABNORMAL,IGNORE
         LI,R2    LLERRG1           ERROR MESSAGE,SEVERE
         B        LLFORCE
LLMESS   LI,R2    LLERRG2           ERROR MESSAGE,I/O ERROR 49
LLFORCE  EQU      %
         LI,R1    1
         LC       M:LL,R1           SEE IF M:LL IS OPEN
         BCR,2    %+2
         M:CLOSE  M:LL              CLOSE IT
         M:OPEN   M:LL,(DEVICE,'LL') OPEN TO OPERATIONAL LABEL LL
         LI,R4    2
         LI,D4    1
         BAL,SR4  LIST              GO LIST ERROR MESSAGE
*
         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'
LLERRG2  TEXTC    'DEVICE NOT AVAILABLE,RES.SPEC. MISSING'
         END

