Title : How to find an IMS PCB list from MVS and IMS control blocks

Submitter : Frank Fleming
            Barclays Computer Operations
            Radbroke Hall
            Knutsford
            Cheshire
            WA16 9EU

Phone : 0565-621000 ext 3581

Release Submitter Details - Y

Text :-

The following code (part of which was cribbed from the IMS region
initialisation modules) places the address of an IMS application
program's PCB list in R1. The code is designed (by the use of
conditional assembly based on the contents of the IMS OPTIONS dataset)
to work for all releases of IMS up to and including 3.1 and will find
the PCB list for both online & batch regions (including those with
COMPAT=YES coded in the PSBGEN)

Note that the use of the new AIB interface which is part of the newly
closed 'Changed Data Capture' SPE is probably preferable to this method
of chasing PCBs.



* IF WE ARE NOT IN AN IMS REGION THEN WE WILL
* PROBABLY ABEND S0C4 SOMEWHERE AROUND HERE
*
         COPY  DFSLEV                  IMS LEVEL FROM OPTIONS D/SET

         USING PSA,R0                  BASE PSA ON NOTHING
         L     R2,PSATOLD              CURRENT TCB - MUST BE ME
*                                      COZ I'M RUNNING
         USING TCBRBP,R2               TELL ASSEMBLER ABOUT TCB
         DROP  R0                      FINISHED WITH NOTHING NOW
         L     R3,TCBFSA               A(FIRST SAVE AREA)
         DROP  R2                      FINISHED WITH TCB NOW
         L     R2,24(R3)               R1 IN FSA IS A(ECP OR PARMBLK)
         USING DFSECP,R2               PRETEND IT'S ECP FOR NOW
         CLC   ECPID,=C'ECP '          IS IT REALLY?
         BNE   PARMBLOK                NAH! - IT'S PARMBLOCK OR NOWT
         L     R2,ECLRCPRM             YEP - SO FIND PARMBLOCK FROM ECP
         DROP  R2                      FINISHED WITH ECP

PARMBLOK EQU   *
         USING DFSPRPX0,R2             TELL ASSEMBLER ABOUT PARMBLOCK
         L     R3,RRCPARMS             NOW POINT R2 AT REGION CNTL PRMS
         USING RCPARMS,R3              TELL ASSEMBLER ABOUT RC PARMS
         TM    RCTYP1,RCMSG+RCBMP+RCFPA ONLINE REGION ?
         BNZ   ONLINE                  YES - GO PROCESS AS ONLINE
         B     BATCH                   NO - GO PROCESS FOR DLI OR DBB

BATCH    EQU   *
         L     R4,RCPST                A(PST)
         USING PST,R4                  TELL ASSEMBLER ABOUT PST
         L     R4,PSTPSB               A(PDIR)
         DROP  R4                      AND FINISHED WITH PDIR
         USING PDIR,R4                 NOW USING PDIR
         L     R5,PDIRADDR             A(PSB)
         DROP  R4                      AND FINISHED WITH PDIR
         USING PSB,R5                  SO LETS USE PSB
         AIF   (&DFSLEV LT 310).NOT31

 note, structure of pcblist changed with ims 3.1

         L     R1,PCPCBLST             GET PCB LIST ADDRESS
         AGO   .BACK31
.NOT31   ANOP  ,
         LA    R1,PSBLIST              PCB LIST (INC IOPCB)
.BACK31  ANOP  ,
         TM    RCTYP1,RCBAT            BATCH REGION WITH IOPCB ?
         BO    GOTIT                   YES - WE WANT TO KEEP IOPCB
         TM    PSBFLAGS,PSBCOMPT       COMPAT=YES CODED ON PSB ?
         BO    GOTIT                   YES - WE WANT TO KEEP IOPCB
         LA    R1,4(R1)                SKIP PAST IOPCB POINTER
         DROP  R5                      AND FINISHED WITH PSB NOW
         B     GOTIT                   AND GO HOME

ONLINE   EQU   *
         L     R4,RCDIRCA              FIND DIRCA FROM RC PARMS
         USING DIRCA,R4                TELL ASSEMBLER ABOUT DIRCA
         LA    R1,DIRPCBL              POINTER TO PCB LIST
*                                      LIST IS SET OF FULLWORD POINTERS
*                                      TO THE PCBS. - GOT X'80' AS TOP
*                                      BIT OF LAST POINTER
         DROP  R4                      FORGET DIRCA NOW
*        B     GOTIT



GOTIT    EQU   *

                    PCB LIST ADDRESS NOW IN R1

         DROP  R2                      FORGET PXPARMS
         DROP  R3                      AND RCPARMS



                        REQUIRED DATA AREAS/DSECTS

         DFSECP IMS
         PARMBLK
         IRC   DIRCA=0
         IDLI  PSTBASE=0,PDRBASE=0,PSBBASE=0
         IHAPSA
         IKJTCB

<END>