Cpcstat

CPCSTAT  CSECT
         PRINT GEN,BASE
*----------------------------------------------------------------------*
****     INIT REGISTERS                                             ****
*----------------------------------------------------------------------*
         SPACE
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       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*---------------------------------------------------------------------*
         GPARMOD 31
CPCSTAT  AMODE ANY
CPCSTAT  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
         USING *,R15
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         SPACE
         USING CPCSTATA,R3,R4
CPCSTATA BASR  R3,0
         BCTR  R3,R0
         BCTR  R3,R0
         LA    R1,4095
         LA    R4,1(R3,R1)
         DROP  15
         B     BEG
SAV14    DS    F
SAVTAB   DS    5F
*---------------------------------------------------------------------*
         DS    0F
BEG      EQU   *
         XR    R2,R2
         CSTAT PGNUM=9,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=10,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=11,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=12,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=13,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=14,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=15,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CSTAT PGNUM=16,PAGE=NO
         LTR   R15,R15
         BNZ   *+8
         LA    R2,1(R2)
         CVD   R2,DOWO
         ED    MASKE,DOWO2
         MVC   CSCMD1(2),MASKE+6
CSTYPE   TYPIO MSG=CSCMD
RETCO    EQU   *
         LM    R8,R12,SAVTAB
         L     R14,SAV14
         BR    R14
*----------------------------------------------------------------------*
         DS    0F
MASKE    DC    X'4020202020202120'
DOWO     DS    D
         ORG   DOWO
DOWO1    DS    CL4
DOWO2    DS    CL4
         ORG
CSCMD    DC    Y(CSCMDE-CSCMD)
         DS    CL2
         DC    C' %  ZCP0000 CP LOADED. '
CSCMD1   DC    CL2' '
         DC    C' PAGES RESIDENT CLASS-6 MEMORY ALLOCATED.'
CSCMDE   EQU   *
         END