IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Get system related infos in PL/I


IBM Mainframe Forums -> PL/I & Assembler
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Tue Dec 09, 2008 8:56 pm
Reply with quote

Hello,

i want to get jobid,stepname,jobname,system symbols etc. in an enterprise pli program.
There´s no api for that, so i have to extract these information from control-blocks.

I´m looking for sample code.
if sombody is doing this in pl/1 already please post it here. thanks
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Wed Dec 10, 2008 12:13 am
Reply with quote

I have an Assembler Sub-Program on my home machine which you CALL from PL/I (or COBOL) and it will return this information.

I'll post it as soon as I have some free time.

Regards,

Bill
Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Wed Dec 10, 2008 1:38 am
Reply with quote

I have these info from withion a PL/I program.

For me too give me one day to post or I can mail it to you if you want it.

Cheers
Pierre
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Wed Dec 10, 2008 2:32 pm
Reply with quote

Bill O'Boyle wrote:
I have an Assembler Sub-Program on my home machine which you CALL from PL/I (or COBOL) and it will return this information.

I'll post it as soon as I have some free time.

Regards,

Bill


thanks, but i try to avoid asm.
we use such asm programs too. but for new projects i try to use native pl/I
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Wed Dec 10, 2008 2:33 pm
Reply with quote

PeD wrote:
I have these info from withion a PL/I program.

For me too give me one day to post or I can mail it to you if you want it.

Cheers
Pierre


thanks, please post.
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Wed Dec 10, 2008 4:47 pm
Reply with quote

I understand management's "fear" of Assembler. icon_wink.gif

But, for the benefit of others, please see attached....

Regards,

Bill
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Wed Dec 10, 2008 4:50 pm
Reply with quote

Because GETJOBI is in .txt format (doesn't format too good), here it is again, unattached -
Code:

*PROCESS RENT                      PROGRAM IS RE-ENTRANT               
***********************************************************************
*---------------------------------------------------------------------*
*                          < G E T J O B I >                          *
*                        (GET JOB INFORMATION)                        *
*---------------------------------------------------------------------*
*                                                                     *
*        THIS SUB-PROGRAM IS CALLED TO OBTAIN THE JOB-NAME, PROCSTEP  *
*        NAME, STEP-NAME AND JOB-NUMBER (IN THIS ORDER). NOTE THE     *
*        REQUIRED 128-BYTE WORKAREA (FOR REENTRANCY PURPOSES).        *
*                                                                     *
*        EXAMPLE SYNTAX:                                              *
*                                                                     *
*        03  WS-GETJOBI-PARM-REC.                                     *
*            05  WS-GETJOBI-JOB-NAME                                  *
*                                  PIC  X(08).                        *
*            05  WS-GETJOBI-PROCSTEP-NAME                             *
*                                  PIC  X(08).                        *
*            05  WS-GETJOBI-STEP-NAME                                 *
*                                  PIC  X(08).                        *
*            05  WS-GETJOBI-JOB-NBR                                   *
*                                  PIC  X(08).                        *
*            05  WS-GETJOBI-WORKAREA                                  *
*                                  PIC  X(128).                       *
*                                                                     *
*        CALL WS-GETJOBI               USING WS-GETJOBI-PARM-REC      *
*        END-CALL                                                     *
*                                                                     *
*        THANK YOU FOR YOUR SUPPORT....                               *
*                                                                     *
*---------------------------------------------------------------------*
***********************************************************************
PRMDSECT DSECT                     PRMDSECT-DSECT                       
         USING *,R7                INFORM ASSEMBLER                     
PARMAREA EQU   *                   BEGIN PARMAREA                       
PARMJNME DS    CL8                 JOB-NAME                             
PARMPSTP DS    CL8                 PROCSTEP-NAME                       
PARMSTPN DS    CL8                 STEP-NAME                           
PARMJNBR DS    CL8                 JOB-NUMBER                           
PARMLGTH EQU   *-PARMAREA          CALCULATE PARM-LGTH                 
STGDSECT DSECT                     CALLER-STORAGE DSECT                 
         USING *,R9                INFORM ASSEMBLER                     
STGAREA  DS    0XL128              BEGIN STORAGE-AREA                   
FWORD    DS    F                   ALIGNED-FULLWORD WORKAREA           
REGSAVEA DS    XL72                72-BYTE REGISTER SAVEAREA           
EXTRPLST EXTRACT MF=L              EXTRACT PARAMETER-LIST (XL12)       
STGRMDR  EQU   STGAREA+L'STGAREA-* REMAINING-STORAGE                   
         DS    XL(STGRMDR)         STORAGE-REMAINDER                   
GETJOBI  CSECT                     PROGRAM IS RE-ENTRANT               
         USING *,R3                INFORM ASSEMBLER                     
         SAVE  (14,12)             SAVE REGISTERS                       
         LA    R3,0(,R15)          CSECT ADDRESSABILITY                 
         J     CHKRNENV            CHECK RUN-ENVIRONMENT               
EYECTCHR DC    CL47' <<< ASSEMBLY DATE/TIME: &SYSDATC/&SYSTIME..00 >>>'
         ORG   EYECTCHR+6          REDEFINITION                         
         DC    X'A2A285948293A8'   LOWER-CASE 'SSEMBLY'                 
         ORG   EYECTCHR+15         REDEFINITION                         
         DC    X'81A385'           LOWER-CASE 'ATE'                     
         ORG   EYECTCHR+20         REDEFINITION                         
         DC    X'899485'           LOWER-CASE 'IME'                     
         ORG   EYECTCHR+L'EYECTCHR RESET LOCATION-COUNTER               
CHKRNENV DS    0H                  ENSURE ALIGNMENT                     
         XR    R10,R10             ENSURE X'00'S                       
         LLGT  R15,540             ADDRESS CURRENT TCB                 
         L     R15,208(,R15)       ADDRESS TCB EXTN                     
         L     R15,20(,R15)        ADDRESS AFCB                         
         LTR   R15,R15             BATCH ENVIRONMENT?                   
         JZ    ADDRPLST            YES, ADDRESS THE PARMLIST           
         CLC   =CL3'AFC',0(R15)    BATCH ENVIRONMENT?                   
         JNE   ADDRPLST            YES, ADDRESS THE PARMLIST           
         LA    R10,4095            INVALID FOR USE IN CICS             
ADDRPLST EQU   *                                                       
         L     R7,0(,R1)           ADDRESS THE PARMLIST                 
         LA    R7,0(,R7)           CLEAR TOP-BIT                       
         MVI   PARMAREA,C' '       ENSURE ALL SPACES                   
         MVC   PARMAREA+1(PARMLGTH-1),PARMAREA                         
         LA    R9,PARMLGTH(,R7)    ADDRESS CALLER'S WORKAREA           
         XC    STGAREA,STGAREA     ENSURE X'00'S                       
         LA    R15,REGSAVEA        POINT TO OUR SAVEAREA               
         ST    R13,4(,R15)         BACKWARD-CHAIN                       
         ST    R15,8(,R13)         FORWARD-CHAIN                       
         LR    R13,R15             POINT TO OUR SAVEAREA               
         LTR   R15,R10             BATCH ENVIRONMENT?                   
         JNZ   RTN2CLLR            NO, RETURN TO CALLER                 
         LA    R10,FWORD           POINT TO FWORD                       
         EXTRACT (R10),'S',FIELDS=TIOT,MF=(E,EXTRPLST)                 
         L     R10,FWORD           LOAD FROM FWORD                     
         MVC   PARMAREA(PARMLGTH-L'PARMJNBR),0(R10)                     
         LLGT  R10,540             CURRENT TCB                         
         L     R10,180(,R10)       POINT TO JFCB                       
         L     R10,316(,R10)       POINT TO SSID                       
         MVC   PARMJNBR,12(R10)    POPULATE JOB-NUMBER                 
         XR    R15,R15             ENSURE X'00'S                       
RTN2CLLR EQU   *                                                       
         L     R13,4(,R13)         RESTORE CALLER'S R13                 
         XC    STGAREA,STGAREA     ENSURE X'00'S                       
         RETURN (14,12),RC=(15)    RESTORE AND RETURN                   
         YREGS ,                   MVS REGISTER-MACRO                   
         LTORG ,                                                       
GETJOBI  AMODE 31 ,                                                     
GETJOBI  RMODE ANY ,                                                   
         END   ,                   END 'GETJOBI'                       

Regards,

Bill
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Thu Dec 11, 2008 12:56 am
Reply with quote

Hello,

To download/ view a .txt attachment, it is often necessary to right-click and Save Target As to the local hard drive. Trying to open in the browser often loses formatting and everything is run together.
Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Thu Dec 11, 2008 2:32 am
Reply with quote

Here in PL/I.

What is incomplete or missing : all info on allocated datasets in JFCB, because I need to translate in PL/I the SWAREQ macro.
( If interested, tell me - I will pass when done ).

Cheers
Pierre

PS : this version ( which is an exercise version ) is not really documented , but is , I believe, selfspeaking.

Code:

 PED827: PROC OPTIONS(MAIN);

 /*-------------------------------------------------------------------*/
 /*                                                                   */
 /* DESCRIP :  TEST DATA AREAS    FROM PED827                         */
 /*                                                                   */
 /* CREATION:  PIERRE DEVILLERS         DATE : SEPT  2005             */
 /*                                                                   */
 /*-------------------------------------------------------------------*/
 /* MODIF      NAME                    DATE         Change ref        */
 /*-------------------------------------------------------------------*/

 /*-------------------------------------------------------------------*/
 /*         E N T R Y                                                 */
 /*-------------------------------------------------------------------*/

 DCL  SYSPRINT                FILE OUTPUT PRINT;

 /*-------------------------------------------------------------------*/
 /*   DECLARATION                                                     */
 /*-------------------------------------------------------------------*/

 DCL 01 JESNODE        CHAR(8)         INIT(' ');
 DCL 01 AVAIL          BIN FIXED(31)   INIT(0);
 DCL 01 EAVAIL         BIN FIXED(31)   INIT(0);

 /*-------------------------------------------------------------------*/
 /*   CONTROL BLOCK                                                   */
 /*-------------------------------------------------------------------*/

 DCL  FBNULL        FIXED BIN(31) INIT(0),
      PT_PSA        PTR BASED(ADDR(FBNULL)),
     01 PSA         BASED(PT_PSA),
        03 *         CHAR(540),
        03 PT_TCB PTR,
        03 *         CHAR(4),
        03 PT_ASCB1  PTR,
     01 TCB      BASED(PT_TCB),
        03 *         CHAR(12),
        03 PT_TIOT   PTR,
     01 TIOT        BASED(PT_TIOT),
        03 F_TIOT1  CHAR(8),
        03 F_TIOT2  CHAR(8),
        03 F_TIOT3  CHAR(8),
        03 S_TIOT(30),
           05 S1_TIOT   CHAR(1),
           05 S2_TIOT   CHAR(3),
           05 S3_TIOT   CHAR(8),
           05 S4_TIOT   CHAR(3),
           05 S5_TIOT   CHAR(5),
     01 JSCB     BASED(PT_TCB),
        03 *         CHAR(180),
        03 PT_JSCB   PTR,
        03 *         CHAR(060),
        03 PT_QMPL   PTR,
        03 *         CHAR(012),
        03 PT_JCT    PTR,
     01 JCT      BASED(PT_JCT),
        03 *         CHAR(36),
        03 PT_JCTX   PTR,
        03 *         CHAR(16),
        03 PT_ACT    CHAR(3),

     01 JCTX     BASED(PT_JCTX),
        03 ZJCTX     CHAR(176),

     01 QMPL     BASED(PT_QMPL),
        03 *         CHAR(24),
        03 PT_QMAT   PTR,

     01 SSIB     BASED(PT_JSCB),
        03 *         CHAR(316),
        03 PT_SSIB   PTR,
     01 SICI     BASED(PT_SSIB),
        03 *         CHAR(12),
        03 JOBNUME  CHAR(8),

     01 PSA2        BASED(PT_PSA),
        03 *         CHAR(224),
        03 PT_ASCB PTR,
     01 ASCB     BASED(PT_ASCB1),
        03 *         CHAR(48),
        03 PT_LDA    PTR,
        03 *         CHAR(56),
        03 PT_ASXB   PTR,
        03 *         CHAR(224),
        03 PT_ASSB   PTR,
     01 ASXB        BASED(PT_ASXB),
        03 *        CHAR(200),
        03 PT_ACEE   PTR,
     01 ACEE        BASED(PT_ACEE),
        03 *        CHAR(100),
        03 PT_UNAM   PTR,
     01 ACEENAM     BASED(PT_UNAM),
        03 *        CHAR(1),
        03 PGMNAM2  CHAR(20),
     01 ASSB        BASED(PT_ASSB),
        03 *        CHAR(168),
        03 PT_JSAB   PTR,
     01 JSAB        BASED(PT_JSAB),
        03 *        CHAR(44),
        03 ASUSERID CHAR(8),
     01 LDA         BASED(PT_LDA),
        03 *        CHAR(204),
        03 LDAREGRQ BIN FIXED(31),
        03 LDALIMIT BIN FIXED(31),
        03 *        CHAR(4),
        03 LDAELIM  BIN FIXED(31),
        03 *        CHAR(12),
        03 LDALOAL  BIN FIXED(31),
        03 *        CHAR(4),
        03 LDAELOAL BIN FIXED(31),

     01 CVT         BASED(PT_PSA),
        03 *         CHAR(16),
        03 PT_CVT PTR,
     /*-----serial number -----*/
     01 CVTPCCAT  BASED(PT_CVT),
        03 *         CHAR(764),
        03 PT_CVTPCCAT  PTR,
     01 PCCAVT   BASED(PT_CVTPCCAT),
        03 PT_PCCAT00P  PTR,
        03 PT_PCCAT01P  PTR,
        03 PT_PCCAT02P  PTR,
        03 PT_PCCAT03P  PTR,
        03 PT_PCCAT04P  PTR,
        03 PT_PCCAT05P  PTR,
        03 PT_PCCAT06P  PTR,
        03 PT_PCCAT07P  PTR,
        03 PT_PCCAT08P  PTR,
        03 PT_PCCAT09P  PTR,
        03 PT_PCCAT10P  PTR,
        03 PT_PCCAT11P  PTR,
        03 PT_PCCAT12P  PTR,
        03 PT_PCCAT13P  PTR,
        03 PT_PCCAT14P  PTR,
        03 PT_PCCAT15P  PTR,
     01 PCCA     BASED(PT_PCCAT00P),
        03 PCCA1     CHAR(4),
        03 PCCA2     CHAR(2),
        03 PCCA3     CHAR(1),
        03 PCCA4     CHAR(5),
        03 PCCA5     CHAR(4),

     01 CVTSYSN  BASED(PT_CVT),
        03 *         CHAR(340),
        03 SYSNAM    CHAR(8),
     01 CVTJESCT BASED(PT_CVT),
        03 *         CHAR(296),
        03 PT_CVTJESCT  PTR,
     01 SSCVT    BASED(PT_CVTJESCT),
        03 *         CHAR(24),
        03 PT_SSCVT  PTR,
     01 SSCTSUSE BASED(PT_SSCVT),
        03 *         CHAR(20),
        03 PT_SSCTSUSE   PTR,
     01 JESLVL   BASED(PT_SSCTSUSE),
        03 JESLEV    CHAR(8),
     01 SSCTSUS2 BASED(PT_SSCVT),
        03 *         CHAR(28),
        03 PT_SSCTSUS2   PTR,
     01 JESINF1  BASED(PT_SSCTSUS2),
        03 *         CHAR(532),
        03 JESN106   CHAR(8),
     01 JESINF2  BASED(PT_SSCTSUS2),
        03 *         CHAR(616),
        03 JESN107   CHAR(8),
     01 JESINF3  BASED(PT_SSCTSUS2),
        03 *         CHAR(620),
        03 JESN108   CHAR(8),
     01 JESINF4  BASED(PT_SSCTSUS2),
        03 *         CHAR(708),
        03 JESN109   CHAR(8);
 DCL 01 T_TIOT,
        03 TIOTLNGH  CHAR(1),
        03 TIOESTTA  CHAR(1),
        03 TIOERLOC,
           05 TIOEWTCT  CHAR(1),
           05 TIOELINK  CHAR(1),
        03 TIOEDDNM  CHAR(8),
        03 TIOEJFCB  CHAR(3),
        03 TIOESTTC  CHAR(1),
        03 TIOESTTB  CHAR(1),
        03 TIOEFSRT  CHAR(3),
        03 TIOFILL1  CHAR(1),
        03 TIOPNSLT  CHAR(1),
        03 TIOFILL2  CHAR(1),
        03 TIOPNSRT  CHAR(1),
        03 TIOPPOOL  CHAR(8),
        03 TIOPSTTB  CHAR(1),
        03 TIOPSLOT  CHAR(3),
        03 TIOTFEND  CHAR(4);

 DCL 01 BJFCB,
     03 BJFCB1      CHAR(1) INIT('00'X),
     03 BJFCB2      CHAR(3) INIT('000000'X);
 DCL 01 PT_BJFCB       PTR  BASED(ADDR(BJFCB));
 DCL 01 ZJFCB    BASED(PT_BJFCB),
        03 DJFCB0    CHAR(16),
        03 DJFCB1    CHAR(50),
        03 DJFCB2    CHAR(50),
        03 DJFCB3    CHAR(50),
        03 DJFCB4    CHAR(16);
 DCL 01 ZONEE        CHAR(1)   INIT('00'X);
 DCL 01 BIT1         BIT(8)    BASED(ADDR(ZONEE));
 DCL 01 BITA         BIT(8)    INIT('00000000'B);
 DCL 01 BITB         BIT(8)    INIT('00001111'B);
 DCL 01 BITC         BIT(8)    INIT('00000000'B);

 /*-------------------------------------------------------------------*/
 /* BUILTIN                                                           */
 /*-------------------------------------------------------------------*/

 DCL    ONCODE                BUILTIN;
 DCL    DECIMAL               BUILTIN;
 DCL    DATETIME              BUILTIN;
 DCL    TIME                  BUILTIN;
 DCL    NULL                  BUILTIN;
 DCL    FLOAT                 BUILTIN;
 DCL    ADDR                  BUILTIN;
 DCL    LENGTH                BUILTIN;
 DCL    INDEX                 BUILTIN;
 DCL    TRIM                  BUILTIN;
 DCL    STRING                BUILTIN;
 DCL    STORAGE               BUILTIN;
 DCL    SUBSTR                BUILTIN;
 DCL    SYSNULL               BUILTIN;

 /*----------------------------------------------------------------*/
 /*----------------------------------------------------------------*/
 /*-                                                              -*/
 /*-                     H O U S E K E E P I N G                  -*/
 /*-                                                              -*/
 /*----------------------------------------------------------------*/
 /*-----HOUSEKEEPING-----------------------------------------------*/
 /*----------------------------------------------------------------*/

     PUT SKIP LIST ('-----------------------------------------');
     PUT SKIP LIST ('JESLEV -     '||JESLEV||'-');
     SELECT (JESLEV);
     WHEN ( 'z/OS 1.9')       JESNODE = JESN109;
     WHEN ( 'z/OS 1.8')       JESNODE = JESN108;
     WHEN ( 'z/OS 1.7')       JESNODE = JESN107;
     WHEN ( 'z/OS 1.6'
          , 'z/OS 1.5'
          , 'z/OS 1.4')       JESNODE = JESN106;
     OTHERWISE;
     END;
     PUT SKIP LIST ('JESNODE-     '||JESNODE||'-');
     PUT SKIP LIST ('CPU NR -     '||PCCA1||'-'
                                   ||PCCA2||'-'
                                   ||PCCA3||'-'
                                   ||PCCA4||'-'
                                   ||PCCA5||'-');
     PUT SKIP LIST ('-----------------------------------------');
     PUT SKIP LIST (' ');
     PUT SKIP LIST ('ASUSERID -   '||ASUSERID||'-');
     PUT SKIP LIST ('PGMNAM2  -   '||PGMNAM2||'-');
     PUT SKIP LIST ('SYSNAM   -   '||SYSNAM||'-');
     PUT SKIP LIST ('-----------------------------------------');
     PUT SKIP LIST (' ');


     PUT SKIP LIST ('-----memory allocation ------------------');
     AVAIL  = LDA.LDALIMIT - LDA.LDALOAL;
     EAVAIL = LDA.LDAELIM  - LDA.LDAELOAL;

     PUT SKIP LIST ('LDALIMIT -   '||LDALIMIT||'-');
     PUT SKIP LIST ('LDALOAL  -   '||LDALOAL||'-');
     PUT SKIP LIST ('LDAELIM  -   '||LDAELIM||'-');
     PUT SKIP LIST ('LDAELOAL -   '||LDAELOAL||'-');
     PUT SKIP LIST ('AVAIL    -   '||AVAIL||'-');
     PUT SKIP LIST ('EAVAIL   -   '||EAVAIL||'-');
     PUT SKIP LIST ('-----------------------------------------');
     PUT SKIP LIST (' ');


     PUT SKIP LIST ('JOBNUME  -   '||JOBNUME||'-');
     PUT SKIP LIST ('JOBNAME  -   '||F_TIOT1||'-');
     PUT SKIP LIST ('STEPNAME -   '||F_TIOT2||'-');
     PUT SKIP LIST ('F_TIOT3  -   '||F_TIOT3||'-');
     PUT SKIP LIST ('-----------------------------------------');
     PUT SKIP LIST (' ');
     PUT SKIP LIST ('S1_TIOT 1-   '||S1_TIOT(1)||'-');
     PUT SKIP LIST ('S1_TIOT 2-   '||S1_TIOT(2)||'-');
     PUT SKIP LIST ('S1_TIOT 3-   '||S1_TIOT(3)||'-');
     PUT SKIP LIST ('S1_TIOT 4-   '||S1_TIOT(4)||'-');
     PUT SKIP LIST ('S1_TIOT 5-   '||S1_TIOT(5)||'-');
     PUT SKIP LIST ('S1_TIOT 6-   '||S1_TIOT(6)||'-');
     PUT SKIP LIST ('S1_TIOT 7-   '||S1_TIOT(7)||'-');
     PUT SKIP LIST ('-----------------------------------------');

 /*-------------------------------------------------------------------*/
 /*  END  OF PROGRAM                                                  */
 /*-------------------------------------------------------------------*/

 END PED827;
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Thu Dec 11, 2008 11:15 pm
Reply with quote

thanks PeD!
this sample code is exactly what i need!
Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Thu Dec 11, 2008 11:24 pm
Reply with quote

Do you need more regarding the files used in a program?
I will try to decode during my "forced" vacation period of end of year.

Cheers
Pierre
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Fri Dec 12, 2008 12:08 am
Reply with quote

Hi Pierre,

Quote:
Do you need more regarding the files used in a program?
DDnames and their DSNs would be helpful to several who have looked in the past.

Enjoy the holidays!

icon_smile.gif

d
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Fri Dec 12, 2008 1:20 am
Reply with quote

PeD wrote:
Do you need more regarding the files used in a program?
I will try to decode during my "forced" vacation period of end of year.

Cheers
Pierre

i´m quite happy with this code.
but would be helpful for others icon_smile.gif
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Fri Jan 30, 2009 10:20 pm
Reply with quote

PeD wrote:
Here in PL/I.

What is incomplete or missing : all info on allocated datasets in JFCB, because I need to translate in PL/I the SWAREQ macro.
( If interested, tell me - I will pass when done ).



i´d be interested :-)
(because FILEDDWORD only returns the first dataset in a concatenation)
Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Fri Jan 30, 2009 10:24 pm
Reply with quote

Not yet done.
I wil work on that. Give me days with 30 hours.

Cheers
Pierre
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Fri Jan 30, 2009 10:30 pm
Reply with quote

Ped,

Moving to Mars may help as a Mars day is 25.5 hours. icon_lol.gif
Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Fri Jan 30, 2009 10:34 pm
Reply with quote

Good icon_lol.gif

Connected thru a MAinframe Remote System
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Fri Jan 30, 2009 11:23 pm
Reply with quote

PeD wrote:
Not yet done.
I wil work on that. Give me days with 30 hours.

Cheers
Pierre


Thanks
Dont worry, days are getting longer
This will solve your problem in the long term icon_biggrin.gif
www.slate.com/id/2133359/
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Thu Feb 19, 2009 9:40 pm
Reply with quote

i´ve found a gold-nugget (bpxwdyn)
if you loop through all allocation with 'INFO INRELNO' you get all allocations

this is the code in rexx (tested, displays all allocations)
drawback: if you want to return the dsn of a special ddname, you have to go through all allocations until you find it

Code:

/* REXX */                                                         
do i=1 by 1 until last<>0                                           
 IF BPXWDYN('info inrelno('i') inrtddn(dd) inrtdsn(ds)',           
            ' inrtpath(path) inrtlst(last)')^=0 THEN INRTLST(LAST);
   if path<>'' then                                                 
      say left(dd,8) path                                           
   else                                                             
      say left(dd,8) ds                                             
end             


this is a SAMPLE for calling bpxwdyn in pl/1 (not tested)

Code:

dyntst: proc(parm) options(main);
         dcl bpxwdyn external entry options(asm inter retcode);
         on endfile($tmp) goto eof;
         dcl parm    char(255) var;
         dcl dynstr  char(255) var;
         dcl datastr char(255) var;
         dynstr = 'ALLOC FI($TMP) DA(''' || parm || ''') SHR REUSE';
         call bpxwdyn(dynstr);
         do while('1'b);
            read file($tmp) into(datastr) ;
         end ;
 eof:    dynstr = 'FREE  FI($TMP)' ;
         call bpxwdyn(dynstr);
         return ;
 never_call_me: proc;
         release bpxwdyn;
 end never_call_me ;
 end dyntst ;


so it should be possible to get all allocated dataset-names in pl/1 without doing ugly things (swareq etc.)
Back to top
View user's profile Send private message
bauer

New User


Joined: 03 Mar 2009
Posts: 28
Location: germany

PostPosted: Tue Mar 10, 2009 3:41 am
Reply with quote

Pls have a look here:



Complete PL/1 code for accessing the JFCB Job File Control Block



regards,
bauer
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Tue Mar 10, 2009 6:01 am
Reply with quote

Hello and welcome to this forum,

Thank you for the code icon_smile.gif

d
Back to top
View user's profile Send private message
bauer

New User


Joined: 03 Mar 2009
Posts: 28
Location: germany

PostPosted: Tue Mar 10, 2009 12:47 pm
Reply with quote

Try this:


Code:


 TEST:                                                                         
 PROC  OPTIONS(MAIN) REORDER  ;                                                 
                                                                               
                                                                               
    /* Some information in this structure is only avialable if                 
       the jcl provides the DCB parameter or the associated                     
       dataset is open                                                         
    */                                                                         
    DEFINE STRUCTURE                                                           
       1 tDSInfo                                                               
         ,  2 DD          CHAR(8)        /* DD Name from JCL */                 
         ,  2 DSN         CHAR(44)       /* Datasetname */                     
         ,  2 MEMBER      CHAR(8)        /* Membername */                       
         ,  2 DISP        CHAR(3)        /* Disposition */                     
         ,  2 DSORG       CHAR(2)        /* Datasetorganisation */             
         ,  2 RECFM       CHAR(3)        /* Recordformat */                     
         ,  2 LRECL       BIN FIXED(15)  /* Logical Recordlength */             
         ,  2 RESERVED    CHAR(442)      /* For future use */                   
         ;                                                                     
                                                                               
                                                                               
                                                                               
 MyCallback:                                                                   
    PROC(pDSInfo,pUserData) RETURNS(BIT(1));                                   
    DCL pDSInfo   PTR ;                                                         
    DCL pUSerData PTR ;                                                         
    DCL 1 DSInfo TYPE tDSInfo BASED(pDSInfo) ;                                 
    PUT SKIP EDIT('DSInfo.DD     = ' ||      DSInfo.DD     ) (A);               
    PUT SKIP EDIT('DSInfo.DSN    = ' ||      DSInfo.DSN   ) (A);               
    PUT SKIP EDIT('DSInfo.Member = ' ||      DSInfo.Member ) (A);               
    PUT SKIP EDIT('DSInfo.Disp   = ' ||      DSInfo.Disp   ) (A);               
    PUT SKIP EDIT('DSInfo.DSORG  = ' ||      DSInfo.DSORG  ) (A);               
    PUT SKIP EDIT('DSInfo.RECFM  = ' ||      DSInfo.RECFM  ) (A);               
    PUT SKIP EDIT('DSInfo.LRECL  = ' || CHAR(DSInfo.LRECL )) (A);               
    PUT SKIP EDIT('')(A);                                                       
    PUT SKIP EDIT('')(A);                                                       
    RETURN('1'B) ;    /* Continue Processing */                                 
    END;                                                                       
                                                                               
                                                                               
 CALL DSInfo(MyCallback,NULL());   
                                                                               
                                                                               
                                                                               
 DSInfo:                                                                       
    /* Loops over the MVS Control blocks to get information                     
       for all DD names associated with the current job.                       
       For each DD Name the filenames and some other                           
       data is fetched from then JFCB (Job File                                 
       Control Block).                                                         
                                                                               
       A callback function is invoked for each file.                           
       The callbackfunction is passed from the calling module.                 
       */                                                                       
                                                                               
    PROC(pEntry,pUserdata);                                                     
                                                                               
    DCL pEntry  ENTRY                                                           
          (  PTR    /* Data for each DDName / Dataset */                       
           , PTR    /* Userdata  */                                             
          ) RETURNS(BIT(1)) VARIABLE ;                                         
                                                                               
    DCL pUserData  PTR ; /* any data passed from the calling modul             
                            an routed to the callback function */               
                                                                               
    DCL 1 DSInfo TYPE tDSInfo AUTO;                                             
                                                                               
    DCL pPSA            PTR  AUTO INIT(SYSNULL());                             
    DCL 1 PSA           BASED(pPSA)  /* Prefixed Save Area */                   
          , 2 FILLER1   CHAR(540)                                               
          , 2 pTCB      PTR                                                     
          ;                                                                     
    DCL 1 TCB           BASED(pTCB)  /* Task Control Block */                   
          , 2 FILLER1   CHAR(12)                                               
          , 2 pTIOT     PTR                                                     
          ;                                                                     
                                                                               
   DCL pTIOTSEG PTR ;                                                           
   DCL 1 TIOTSEG      BASED (pTIOTSEG)   /* Task Input/Output Table */         
        ,2 TIOELNGH   BIN FIXED(7)       /* Length of this entry */             
        ,2 FILLER2    CHAR(3)                                                   
        ,2 TIOEDDNM   CHAR(8)            /* DD Name of Dateset */               
        ,2 TIOEJFCB   CHAR(3)            /* JFCB per SWAREQ MACRO */           
        ;                                                                       
                                                                               
    DCL pJFCB PTR;                                                             
    DCL 1 JFCB        BASED(pJFCB)       /* Job File Control Block */           
          ,2 JFCBDSNM CHAR(44)           /* DSN Name */                         
          ,2 JFCBELNM CHAR(8)            /* Member */                           
          ,2 FILLER1  CHAR(35)                                                 
          ,2 JFCBIND2 CHAR(1)            /* Indicator2 */                       
          ,2 FILLER2  CHAR(10)                                                 
          ,2 JFCDSRG1 CHAR(1)            /* DSORG, Byte 1*/                     
          ,2 FILLER3  CHAR(1)                                                   
          ,2 JFCRECFM CHAR(1)            /* RECFM */                           
          ,2 FILLER4  CHAR(3)                                                   
          ,2 JFCLRECL BIN FIXED(15)      /* LRECL */                           
          ;                                                                     
                                                                               
    DCL Continue BIT(1) AUTO INIT('1'B) ;                                       
                                                                               
   /* Build address of first TIOT Segement by skipping */                       
   /* bytes for jobname, stepname */                                           
   pTIOTSEG = TCB.PTIOT + 24 ;                                                 
                                                                               
   /* Loop over all TIOT Segments */                                           
   DO WHILE ((TIOTSEG.TIOELNGH ^= 0) & (CONTINUE));                             
                                                                               
      /* Convert SWA virtual address token to JFCB address */                   
      pJFCB = SWAREQ(TIOEJFCB) ;                                               
                                                                               
      /* extract/prepare data from controlblocks to pass                       
         to the callback function for the calling modul */                     
      CALL PLIFILL(ADDR(DSInfo),'00'X,CSTG(DSInfo));/* Fill with '0'x */       
      DSInfo.DD      = TIOTSEG.TIOEDDNM ;                                       
      DSInfo.DSN     = JFCB.JFCBDSNM    ;                                       
      DSInfo.Member  = JFCB.JFCBELNM    ;                                       
      SELECT (JFCB.JFCBIND2) ;                                                 
         WHEN('40'x, '41'x) DSInfo.DISP = 'OLD' ;                               
         WHEN('C0'x, 'C1'x) DSInfo.DISP = 'NEW' ;                               
         WHEN('80'x, '81'x) DSInfo.DISP = 'MOD' ;                               
         WHEN('48'x, '49'x) DSInfo.DISP = 'SHR' ;                               
         OTHER              DSInfo.DISP = ''    ;                               
      END;                                                                     
      SELECT (JFCB.JFCDSRG1) ;                                                 
         WHEN('80'x, '81'x) DSInfo.DSORG = 'IS' ;                               
         WHEN('40'x, '41'x) DSInfo.DSORG = 'PS' ;                               
         WHEN('20'x, '21'x) DSInfo.DSORG = 'DA' ;                               
         WHEN('02'x, '03'x) DSInfo.DSORG = 'PO' ;                               
         OTHER              DSInfo.DSORG = ''   ;                               
      END;                                                                     
      SELECT (JFCB.JFCRECFM) ;                                                 
         WHEN('C0'x) DSInfo.RECFM = 'U'  ;                                     
         WHEN('80'x) DSInfo.RECFM = 'F'  ;                                     
         WHEN('40'x) DSInfo.RECFM = 'V'  ;                                     
         WHEN('90'x) DSInfo.RECFM = 'FB' ;                                     
         WHEN('50'x) DSInfo.RECFM = 'VB' ;                                     
         OTHER       DSInfo.RECFM = ''   ;                                     
      END;                                                                     
      DSInfo.LRECL   = JFCB.JFCLRECL  ;                                         
                                                                               
      /* Pass data to callback function in calling module */                   
      Continue = pEntry(ADDR(DSInfo),pUserdata);                               
                                                                               
      /* Get next TIOTSEG */                                                   
      pTIOTSEG = pTIOTSEG + TIOTSEG.TIOELNGH ;                                 
                                                                               
   END ;                                                                       
                                                                               
                                                                               
 SWAREQ:                                                                       
    /* Convert SWA virtual address token to 31 Bit address */                   
    /* This submodule replaces assembler macro SWAREQ */                       
    PROC(SWA) RETURNS(PTR);                                                     
                                                                               
    DCL SWA CHAR(3) ;  /* parameter SWA Virtual address token */               
                                                                               
    DCL 1 SVAS AUTO                                                             
          ,2 SVA1  CHAR(1) INIT(LOW(1))                                         
          ,2 SVA2  CHAR(3) INIT(SWA)                                           
          ;                                                                     
    DCL SVAP PTR BASED(ADDR(SVAS)) ;                                           
    DCL SVAB BIN FIXED(31) BASED(ADDR(SVAS));                                   
                                                                               
    DCL pPSA            PTR  AUTO INIT(SYSNULL());                             
    DCL 1 PSA           BASED(pPSA)  /* Prefixed Save Area */                   
          , 2 FILLER1   CHAR(540)                                               
          , 2 pTCB      PTR                                                     
          ;                                                                     
    DCL 1 TCB           BASED(pTCB) /* Task Control Block */                   
          , 2 FILLER1   CHAR(180)                                               
          , 2 pJSCB     PTR                                                     
          ;                                                                     
    DCL 1 JSCB          BASED(pJSCB) /* Job / Step Control Block */             
          ,2 FILLER1    CHAR(244)                                               
          ,2 pJSCBQMPI  PTR                                                     
          ;                                                                     
    DCL 1 QMPA          BASED(pJSCBQMPI) /* Queue Manager                       
                                            Parameter Area */                   
          ,2 Filler     CHAR(24)                                               
          ,2 QMAT       BIN FIXED(31)                                           
          ;                                                                     
                                                                               
    DCL l_QMAT BIN FIXED(31) AUTO NOINIT;                                       
                                                                               
                                                                               
    IF MOD(SVAB,2) = 1 THEN DO; /* 24 or 31 Bit address */                     
       l_QMAT = QMPA.QMAT ;                                                     
       DO WHILE(SVAB > 65536) ;                                                 
          l_QMAT = l_QMAT + 12 ;                                               
          SVAB = SVAB - 65536;                                                 
       END;                                                                     
       SVAB = SVAB + 1 + 16 + l_QMAT ;                                         
    END;                                                                       
    ELSE DO;                                                                   
       SVAB = SVAB + 16 ;                                                       
    END ;                                                                       
                                                                               
    RETURN(SVAP);    /* return 31 Bit address */                               
                                                                               
    END ; /* SWAREQ procedure */                                               
                                                                               
    END ; /* DSInfo */                                                         
                                                                               
                                                                               
                                                                               
 END;                                                                           

Back to top
View user's profile Send private message
PeD

Active User


Joined: 26 Nov 2005
Posts: 459
Location: Belgium

PostPosted: Tue Mar 10, 2009 1:48 pm
Reply with quote

Brillant!

For my coding here , Ein Sonnenschein zwischen den Wolken !!

Thanks

Pierre
Back to top
View user's profile Send private message
bauer

New User


Joined: 03 Mar 2009
Posts: 28
Location: germany

PostPosted: Wed Mar 11, 2009 12:53 pm
Reply with quote

Thank you. icon_biggrin.gif icon_biggrin.gif
Back to top
View user's profile Send private message
parsesource

New User


Joined: 06 Feb 2006
Posts: 97

PostPosted: Wed Mar 11, 2009 1:52 pm
Reply with quote

great stuff, i´ll try. thank you!


icon_biggrin.gif
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> PL/I & Assembler Goto page 1, 2  Next

 


Similar Topics
Topic Forum Replies
No new posts Sysplex System won't IPL at DR site I... All Other Mainframe Topics 2
No new posts How to delete a user's alias from the... JCL & VSAM 11
No new posts Insert system time/date (timestamp) u... DFSORT/ICETOOL 5
No new posts JCL Dynamic System Symbols JCL & VSAM 3
No new posts the system or user abend SF0F R=NULL COBOL Programming 0
Search our Forums:

Back to Top