//FVSCHK   JOB CLASS=A,MSGCLASS=A,NOTIFY=KIMU
//A       EXEC PGM=ASMA90,PARM=OBJECT,REGION=2000K
//SYSIN    DD  *
         START
         PRINT NOGEN
VSCHK    CSECT
VSCHK    AMODE 31
VSCHK    RMODE ANY
         SAVE  (14,12),T,*
         BALR  R03,0
         USING *,R03,R04,R05             BASE REG. R03
         LAE   R04,2048(R03)               2'ND Base Reg
         LAE   R04,2048(R04)
         LAE   R05,2048(R04)               3'ND Base Reg
         LAE   R05,2048(R05)
         ST    R13,SAVEAREA+4
         LR    R12,R13
         LA    R13,SAVEAREA
         ST    R13,8(R12)
* --- Events define ---
         EVENTS ENTRIES=10               Events define
         ST    R01,EVTBL
* --- comunication ---
         EXTRACT COMADDR,FIELDS=COMM,MF=(E,EXTRACT)
         L     R09,COMADDR
         USING COM,R09
         ICM   R08,15,COMCIBPT
         USING CIB,R08
         BZ    NOCIB
         BAL   R10,DOCIB
NOCIB    EQU   *
         QEDIT ORIGIN=COMCIBPT,CIBCTR=5
         L     R01,COMECBPT
         ST    R01,MODECB
WAIT     EQU   *
         L     R02,MODECB              Events Test
         EVENTS TABLE=EVTBL,ECB=(2)
         STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=NO
EVLOP1   EQU   *
         STIMERM SET,DINTVL=INTVXX,ID=INTVID,WAIT=YES
         STIMERM TEST,ID=WAITID,TU=WAITTU
         CLC   WAITTU,=F'0'            If not Time Over
         BNE   EVLOP2                   goto @EVLOP1
*
         CALL  VSALERT
*
         STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=NO
EVLOP2   EQU   *
         EVENTS TABLE=EVTBL,WAIT=NO
         LTR   R01,R01                 If Come
         BNZ   CMDGOT                    goto MSGGOT
         B     EVLOP1                 No Time Over
*
CMDGOT   EQU   *
         STIMERM CANCEL,ID=WAITID
*
         ICM   R08,15,COMCIBPT
         USING CIB,R08
         CLI   CIBVERB,CIBMODFY
         BNE   NOTMDFY
         BAL   R10,DOCIB
*
NOTMDFY  EQU   *
         BAL   R14,DELCIB
         CLI   CIBVERB,CIBSTOP
         BE    BYE
         B     WAIT
*
DELCIB   EQU   *
         QEDIT ORIGIN=COMCIBPT,BLOCK=(R08)
         BR    R14
*
DOCIB    EQU   *
         LH    R01,CIBDATLN
         EX    R01,WTOMVC
*        MVC   MSG#0000+26(8),CIBDATA
         WTO   TEXT=MSG#A000,MF=(E,WTOINFO)
*
         CLC   CIBDATA(3),=CL3'MAP'
         BNE   SKIP01
         CALL  VSMAP
         B     SKIPXX
SKIP01   EQU   *
SKIPQQ   EQU   *
         WTO   'VSCHK : Receipted command unknown??'
         WTO   'VSCHK :  Input next either one.'
         WTO   'VSCHK :   - "MAP" : virtual storage map'
SKIPXX   EQU   *
         BR    R10
* ---
BYE      EQU   *
         L     R13,SAVEAREA+4
         RETURN (14,12),RC=0
* ---
* ---
WTOMVC   MVC   MSG#0000+26(0),CIBDATA
* ---
MAPSHOW  EQU   *
*
         DS    0F
SAVEAREA DS    18F
OUTAREA  DC    CL80' '
         DS    0F
WTOINFO  WTO   TEXT=,             WTO parameter list                   X
               DESC=(6),          descriptor code 6 is Job Status      X
               MF=L
MSG#A000 DC    AL2(L'MSG#0000)
*                   0....+....1....+....2....+....3....+....4....+....5
*              ....+....6....+....7....+....8
MSG#0000 DC    CL80'VSCHK : Command receipt : '
         DS    0F
*
         DS    0F
MODECB   DS    F
COMADDR  DS    F
EXTRACT  EXTRACT MF=L
EVTBL    DS    F                   Events table entry
WAITXX   DC    CL8'00010000'             VS check execute time (1min)
INTVXX   DC    CL8'00000200'             Delay 2Sec
WAITID   DS    XL4
INTVID   DS    XL4
WAITTU   DS    XL4
*
ALERTLIM DS    4F
         LTORG
* ---------------
VSMAP    CSECT
VSMAP    AMODE 31
VSMAP    RMODE ANY
         SAVE  (14,12),T,*
         BALR  R03,0
         USING *,R03,R04,R05             BASE REG. R03
         LAE   R04,2048(R03)               2'ND Base Reg
         LAE   R04,2048(R04)
         LAE   R05,2048(R04)               3'ND Base Reg
         LAE   R05,2048(R05)
         ST    R13,VSMAPSA+4
         LR    R12,R13
         LA    R13,VSMAPSA
         ST    R13,8(R12)
* ---
* --- cvt ---
         L     R10,CVTPTR
         USING CVTMAP,R10
* --- virtual storage address extension ---
         L     R09,CVTSMEXT
         USING CVTVSTGX,R09
* --- gda ---
         L     R11,CVTGDA
         USING GDA,R11
* === E Private ===
* --- lowest address of e Private ---
         UNPK  EBCDIC_A(9),GDAEPVT(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPVT+12(8),EBCDIC_A
* --- size of Private ---
         UNPK  EBCDIC_A(9),GDAEPVTS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPVT+32(8),EBCDIC_A
*
         L     R06,GDAEPVTS
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_EPVT+41(7),EDWORK2+09
* --- highest address of Private ---
         L     R01,GDAEPVT
         A     R01,GDAEPVTS
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPVT+23(8),EBCDIC_A
* === ECSA ===
* --- lowest address of e csa ---
         UNPK  EBCDIC_A(9),GDAECSA(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ECSA+12(8),EBCDIC_A
* --- size of e csa ---
         UNPK  EBCDIC_A(9),GDAECSAS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ECSA+32(8),EBCDIC_A
*
         L     R06,GDAECSAS
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_ECSA+41(7),EDWORK2+09
* --- highest address of e csa ---
         L     R01,GDAECSA
         A     R01,GDAECSAS
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ECSA+23(8),EBCDIC_A
* --- allocated ---
*        UNPK  EBCDIC_A(9),GDA_ECSA_ALLOC(5)
*        TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
*        MVC   O_ECSA+70(8),EBCDIC_A
* --- use% ---
         L     R06,GDA_ECSA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDAECSAS
         CVD   R07,PK_AREA
         MVC   EDWORK,EDMASK
         ED    EDWORK,PK_AREA
         MVC   O_ECSA+51(6),EDWORK+11
* === EMLPA ===
* --- lowest address of e mlpa ---
         UNPK  EBCDIC_A(9),CVTEMLPS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EMLPA+12(8),EBCDIC_A
* --- size of e mlpa ---
         L     R01,CVTEMLPE
         S     R01,CVTEMLPS
         LTR   R01,R01
         BZ    EMLPASKP1
         LA    R01,1(R01)
EMLPASKP1 EQU  *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EMLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_EMLPA+41(7),EDWORK2+09
* --- highest address of e mlpa ---
         UNPK  EBCDIC_A(9),CVTEMLPE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EMLPA+23(8),EBCDIC_A
* === EFLPA ===
* --- lowest address of e flpa ---
         UNPK  EBCDIC_A(9),CVTEFLPS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EFLPA+12(8),EBCDIC_A
* --- size of e flpa ---
         L     R01,CVTEFLPE
         S     R01,CVTEFLPS
         LTR   R01,R01
         BZ    EFLPASKP1
         LA    R01,1(R01)
EFLPASKP1 EQU  *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EFLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_EFLPA+41(7),EDWORK2+09
* --- highest address of e flpa ---
         UNPK  EBCDIC_A(9),CVTEFLPE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EFLPA+23(8),EBCDIC_A
* === EPLPA ===
* --- lowest address of e plpa ---
         UNPK  EBCDIC_A(9),CVTEPLPS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPLPA+12(8),EBCDIC_A
* --- size of e plpa ---
         L     R01,CVTEPLPE
         S     R01,CVTEPLPS
         LTR   R01,R01
         BZ    EPLPASKP1
         LA    R01,1(R01)
EPLPASKP1 EQU  *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_EPLPA+41(7),EDWORK2+09
* --- highest address of e plpa ---
         UNPK  EBCDIC_A(9),CVTEPLPE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_EPLPA+23(8),EBCDIC_A
* === ESQA ===
* --- lowest address of e sqa ---
         UNPK  EBCDIC_A(9),GDAESQA(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ESQA+12(8),EBCDIC_A
* --- size of sqa ---
         UNPK  EBCDIC_A(9),GDASQASZ(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ESQA+32(8),EBCDIC_A
*
         L     R06,GDAESQAS
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_ESQA+41(7),EDWORK2+09
* --- highest address of sqa ---
         L     R01,GDAESQA
         A     R01,GDAESQAS
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ESQA+23(8),EBCDIC_A
* --- allocated ---
*        UNPK  EBCDIC_A(9),GDA_ESQA_ALLOC(5)
*        TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
*        MVC   O_ESQA+70(8),EBCDIC_A
* --- use% ---
         L     R06,GDA_ESQA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDAESQAS
         CVD   R07,PK_AREA
         MVC   EDWORK,EDMASK
         ED    EDWORK,PK_AREA
         MVC   O_ESQA+51(6),EDWORK+11
* === ENUC ===
* --- size of nucleus ---
         L     R01,CVTERWNE
         S     R01,=X'01000000'
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ENUC+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_ENUC+41(7),EDWORK2+09
* --- highest address of e nucleus ---
         L     R01,CVTERWNE
         LAE   R01,1(R01)
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_ENUC+23(8),EBCDIC_A
* === NUC ===
* --- lowest address of nucleus ---
         UNPK  EBCDIC_A(9),CVTRWNS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_NUC+12(8),EBCDIC_A
* --- size of nucleus ---
         L     R01,=X'01000000'
         S     R01,CVTRWNS
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_NUC+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_NUC+41(7),EDWORK2+09
* === SQA ===
* --- lowest address of sqa ---
         UNPK  EBCDIC_A(9),GDASQA(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_SQA+12(8),EBCDIC_A
* --- size of sqa ---
         UNPK  EBCDIC_A(9),GDASQASZ(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_SQA+32(8),EBCDIC_A
*
         L     R06,GDASQASZ
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_SQA+41(7),EDWORK2+09
* --- highest address of sqa ---
         L     R01,GDASQA
         A     R01,GDASQASZ
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_SQA+23(8),EBCDIC_A
* --- allocated ---
*        UNPK  EBCDIC_A(9),GDA_SQA_ALLOC(5)
*        TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
*        MVC   O_SQA+70(8),EBCDIC_A
* --- use% ---
         L     R06,GDA_SQA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDASQASZ
         CVD   R07,PK_AREA
         MVC   EDWORK,EDMASK
         ED    EDWORK,PK_AREA
         MVC   O_SQA+51(6),EDWORK+11
* === PLPA ===
* --- lowest address of plpa ---
         UNPK  EBCDIC_A(9),CVTPLPAS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PLPA+12(8),EBCDIC_A
* --- size of plpa ---
         L     R01,CVTPLPAE
         S     R01,CVTPLPAS
         LTR   R01,R01
         BZ    PLPASKP1
         LA    R01,1(R01)
PLPASKP1 EQU   *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_PLPA+41(7),EDWORK2+09
* --- highest address of plpa ---
         UNPK  EBCDIC_A(9),CVTPLPAE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PLPA+23(8),EBCDIC_A
* === FLPA ===
* --- lowest address of flpa ---
         UNPK  EBCDIC_A(9),CVTFLPAS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_FLPA+12(8),EBCDIC_A
* --- size of flpa ---
         L     R01,CVTFLPAE
         S     R01,CVTFLPAS
         LTR   R01,R01
         BZ    FLPASKP1
         LA    R01,1(R01)
FLPASKP1 EQU   *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_FLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_FLPA+41(7),EDWORK2+09
* --- highest address of flpa ---
         UNPK  EBCDIC_A(9),CVTFLPAE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_FLPA+23(8),EBCDIC_A
* === MLPA ===
* --- lowest address of mlpa ---
         UNPK  EBCDIC_A(9),CVTMLPAS(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_MLPA+12(8),EBCDIC_A
* --- size of mlpa ---
         L     R01,CVTMLPAE
         S     R01,CVTMLPAS
         LTR   R01,R01
         BZ    MLPASKP1
         LA    R01,1(R01)
MLPASKP1 EQU   *
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_MLPA+32(8),EBCDIC_A
*
         L     R06,WK#F
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_MLPA+41(7),EDWORK2+09
* --- highest address of mlpa ---
         UNPK  EBCDIC_A(9),CVTMLPAE(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_MLPA+23(8),EBCDIC_A
* === CSA ===
* --- lowest address of csa ---
         UNPK  EBCDIC_A(9),GDACSA(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_CSA+12(8),EBCDIC_A
* --- size of csa ---
         UNPK  EBCDIC_A(9),GDACSASZ(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_CSA+32(8),EBCDIC_A
*
         L     R06,GDACSASZ
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_CSA+41(7),EDWORK2+09
* --- highest address of csa ---
         L     R01,GDACSA
         A     R01,GDACSASZ
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_CSA+23(8),EBCDIC_A
* --- allocated ---
*        UNPK  EBCDIC_A(9),GDA_CSA_ALLOC(5)
*        TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
*        MVC   O_CSA+70(8),EBCDIC_A
* --- use% ---
         L     R06,GDA_CSA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDACSASZ
         CVD   R07,PK_AREA
         MVC   EDWORK,EDMASK
         ED    EDWORK,PK_AREA
         MVC   O_CSA+51(6),EDWORK+11
* === Private ===
* --- lowest address of Private ---
         L     R01,GDAPVT
         A     R01,=XL4'00001000'         add  PSA
         ST    R01,WKPVT
         UNPK  EBCDIC_A(9),WKPVT(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PVT+12(8),EBCDIC_A
* --- size of Private ---
         L     R01,GDAPVTSZ
         S     R01,=XL4'00001000'
         ST    R01,WKPVTSZ
         UNPK  EBCDIC_A(9),WKPVTSZ(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PVT+32(8),EBCDIC_A
*
         L     R06,WKPVTSZ
         SRDA  R06,32
         D     R06,=F'1024'
         CVD   R07,PK_AREA
         MVC   EDWORK2,EDMASK2
         ED    EDWORK2,PK_AREA
         MVC   O_PVT+41(7),EDWORK2+09
* --- highest address of Private ---
         L     R01,WKPVT
         A     R01,WKPVTSZ
         BCTR  R01,0
         ST    R01,WK#F
         UNPK  EBCDIC_A(9),WK#F(5)
         TR    EBCDIC_A(8),=C'0123456789ABCDEF'-X'F0'
         MVC   O_PVT+23(8),EBCDIC_A
*
         MVC   MSG#0001+10(70),O_HEAD
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_EPVT
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_ECSA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_EMLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_EFLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_EPLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_ESQA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_ENUC
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),LINE16
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_NUC
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_SQA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_PLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_FLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_MLPA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_CSA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_PVT
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         MVC   MSG#0001+10(70),O_PSA
         WTO   TEXT=MSG#A001,MF=(E,WTOINFO1)
         L     R13,VSMAPSA+4
         RETURN (14,12),RC=0
* ---------------
VSMAPSA  DS    18F
*                   0....+....1....+....2....+....3....+....4....+....5
*              ....+....6....+....7....+....8
O_HEAD   DC    CL70' -------- : START    - END      SIZE               *
                Alloc%'
O_EPVT   DC    CL70' EPVT     : @@@@@@@@ - 7FFFFFFF @@@@@@@@(@@@@@@@K)'
O_ECSA   DC    CL70' ECSA     : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K) *
               @@@.@@%'
O_EMLPA  DC    CL70' EMLPA    : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_EFLPA  DC    CL70' EFLPA    : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_EPLPA  DC    CL70' EPLPA    : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_ESQA   DC    CL70' ESQA     : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K) *
               @@@.@@%'
O_ENUC   DC    CL70' ENUC     : 01000000 - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
LINE16   DC    CL70' -16 M-'
O_NUC    DC    CL70' NUC      : @@@@@@@@ - 00FFFFFF @@@@@@@@(@@@@@@@K)'
O_SQA    DC    CL70' SQA      : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K) *
               @@@.@@%'
O_PLPA   DC    CL70' PLPA     : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_FLPA   DC    CL70' FLPA     : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_MLPA   DC    CL70' MLPA     : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_CSA    DC    CL70' CSA      : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K) *
               @@@.@@%'
O_PVT    DC    CL70' PVT      : @@@@@@@@ - @@@@@@@@ @@@@@@@@(@@@@@@@K)'
O_PSA    DC    CL70' PSA      : 00000000 - 00000FFF 00001000(      4K)'
         DS    0D
PK_AREA  DS    PL16                      pack work area
*                                1
*                    6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
EDMASK   DC    XL17'40202020202020202020202021204B2020'
EDWORK   DS    XL17
EDMASK2  DC    XL16'40202020202020202020202020202120'
EDWORK2  DS    XL16
         DS    0F
EBCDIC_A DS    CL32
WK#F     DS    F
WKPVT    DS    F
WKPVTSZ  DS    F
         DS    0F
WTOINFO1 WTO   TEXT=,             WTO parameter list                   X
               DESC=(6),          descriptor code 6 is Job Status      X
               MF=L
MSG#A001 DC    AL2(L'MSG#0001)
MSG#0001 DC    CL80'VSCHK : '
         DS    0F
*
         LTORG
* ---------------
VSALERT  CSECT
VSALERT  AMODE 31
VSALERT  RMODE ANY
         SAVE  (14,12),T,*
         BALR  R03,0
         USING *,R03,R04,R05             BASE REG. R03
         LAE   R04,2048(R03)               2'ND Base Reg
         LAE   R04,2048(R04)
         LAE   R05,2048(R04)               3'ND Base Reg
         LAE   R05,2048(R05)
         ST    R13,ALERTSA+4
         LR    R12,R13
         LA    R13,ALERTSA
         ST    R13,8(R12)
* --- cvt ---
         L     R10,CVTPTR
         USING CVTMAP,R10
* --- virtual storage address extension ---
         L     R09,CVTSMEXT
         USING CVTVSTGX,R09
* --- gda ---
         L     R11,CVTGDA
         USING GDA,R11
* === ECSA ===
* --- use% ---
         L     R06,GDA_ECSA_ALLOC
         SRDA  R06,32
         M     R06,=F'100'
         D     R06,GDAECSAS
         CL    R07,=F'80'                  <- CHECK (ECSA limit = 80%)
         BL    ALERT_ECSA_X
*
         L     R06,GDA_ECSA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDAECSAS
         CVD   R07,PK_AREA3
         MVC   EDWORK3,EDMASK3
         ED    EDWORK3,PK_AREA3
         MVC   A_ECSA+47(6),EDWORK3+11
         MVC   MSG#0002+10(70),A_ECSA
         WTO   TEXT=MSG#A002,MF=(E,WTOINFO2)
ALERT_ECSA_X EQU *
* === ESQA ===
* --- use% ---
         L     R06,GDA_ESQA_ALLOC
         SRDA  R06,32
         M     R06,=F'100'
         D     R06,GDAESQAS
         CL    R07,=F'80'                  <- CHECK (ESQA limit = 80%)
         BL    ALERT_ESQA_X
*
         L     R06,GDA_ESQA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDAESQAS
         CVD   R07,PK_AREA3
         MVC   EDWORK3,EDMASK3
         ED    EDWORK3,PK_AREA3
         MVC   A_ESQA+47(6),EDWORK3+11
         MVC   MSG#0002+10(70),A_ESQA
         WTO   TEXT=MSG#A002,MF=(E,WTOINFO2)
ALERT_ESQA_X EQU *
* === SQA ===
* --- use% ---
         L     R06,GDA_SQA_ALLOC
         SRDA  R06,32
         M     R06,=F'100'
         D     R06,GDASQASZ
         CL    R07,=F'80'                  <- CHECK (SQA limit = 80%)
         BL    ALERT_SQA_X
*
         L     R06,GDA_SQA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDASQASZ
         CVD   R07,PK_AREA3
         MVC   EDWORK3,EDMASK3
         ED    EDWORK3,PK_AREA3
         MVC   A_SQA+46(6),EDWORK3+11
         MVC   MSG#0002+10(70),A_SQA
         WTO   TEXT=MSG#A002,MF=(E,WTOINFO2)
ALERT_SQA_X EQU *
* === CSA ===
* --- use% ---
         L     R06,GDA_CSA_ALLOC
         SRDA  R06,32
         M     R06,=F'100'
         D     R06,GDACSASZ
         CL    R07,=F'80'                  <- CHECK (CSA limit = 80%)
         BL    ALERT_CSA_X
*
         L     R06,GDA_CSA_ALLOC
         SRDA  R06,32
         M     R06,=F'10000'
         D     R06,GDACSASZ
         CVD   R07,PK_AREA3
         MVC   EDWORK3,EDMASK3
         ED    EDWORK3,PK_AREA3
         MVC   A_CSA+46(6),EDWORK3+11
         MVC   MSG#0002+10(70),A_CSA
         WTO   TEXT=MSG#A002,MF=(E,WTOINFO2)
ALERT_CSA_X EQU *
*
         L     R13,ALERTSA+4
         RETURN (14,12),RC=0
* ---------------
ALERTSA  DS    18F
*                   0....+....1....+....2....+....3....+....4....+....5
*              ....+....6....+....7....+....8
A_ECSA   DC    CL70'*DANGER* Used percentage of ECSA exceeds limit. (@@*
               @.@@% )'
A_ESQA   DC    CL70'*DANGER* Used percentage of ESQA exceeds limit. (@@*
               @.@@% )'
A_CSA    DC    CL70'*DANGER* Used percentage of CSA exceeds limit. (@@@*
               .@@% )'
A_SQA    DC    CL70'*DANGER* Used percentage of SQA exceeds limit. (@@@*
               .@@% )'
         DS    0D
PK_AREA3 DS    PL16                      pack work area
*                                1
*                    6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
EDMASK3  DC    XL17'40202020202020202020202021204B2020'
EDWORK3  DS    XL17
         DS    0F
WTOINFO2 WTO   TEXT=,             WTO parameter list                   X
               DESC=(2),          descriptor code 6 is Job Status      X
               MF=L
MSG#A002 DC    AL2(L'MSG#0002)
MSG#0002 DC    CL80'VSCHK : '
         DS    0F
*
         LTORG
* ---------------
PSA      DSECT
         IHAPSA LIST=NO
CVT      DSECT
         CVT   LIST=NO,DSECT=YES
         DSECT
         IHAGDA
COM      DSECT
         IEZCOM
CIB      DSECT
         IEZCIB
R00      EQU   00
R01      EQU   01
R02      EQU   02
R03      EQU   03
R04      EQU   04
R05      EQU   05
R06      EQU   06
R07      EQU   07
R08      EQU   08
R09      EQU   09
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         END   VSCHK
/*
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR
//         DD  DSN=SYS1.AMODGEN,DISP=SHR
//SYSUT1   DD  UNIT=(SYSDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1
//SYSPUNCH DD  DUMMY
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))
//SYSLIN   DD  DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(5,5,0)),
//         DCB=(BLKSIZE=400),DSN=&&LOADSET
//L       EXEC PGM=IEWL,PARM='MAP,LET,LIST,AMODE=31,RMODE=ANY',
//         REGION=1M,COND=(8,LT,A)
//SYSLIN   DD  DSN=&&LOADSET,DISP=(OLD,DELETE)
//         DD  DDNAME=SYSIN
//SYSLMOD  DD  DISP=(,PASS),UNIT=SYSDA,
//         SPACE=(CYL,(2,1,2)),DSN=&GOSET(GO)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1
//SYSPRINT DD  SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509)
//G      EXEC  PGM=*.L.SYSLMOD,COND=((8,LT,A),(4,LT,L))
