WHOHAS CSECT WHOHAS AMODE 24 WHOHAS RMODE 24 R0 EQU 0 RESERVED R1 EQU 1 RESERVED 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 BASE REGISTER R13 EQU 13 R14 EQU 14 R15 EQU 15 ************************************************************** * THIS PROGRAM RECEIVES THE NAME OF A DATASET, AND PERFORMS * * A GQSCAN MACRO CALL TO RETRIEVE A LIST OF ACTIVE OWNERS * * AND REQUESTORS OF A RESOURCE. * ************************************************************** BEGIN DS 0H STM R14,R12,12(R13) LR R12,R15 USING BEGIN,R12,R11,R4 LH R4,K4VAL LA R11,0(R4,R12) LA R4,0(R4,R11) ST R13,SAVEAREA+4 LA R13,SAVEAREA L R1,0(R1) LOAD WITH CONTENTS AT R1 ADDR LH R2,0(R1) LOAD MVS LENGTH INTO R2 LTR R2,R2 TEST R2 BZ EMPTYPARM IF LENGTH IS ZERO, THEN EXIT C R2,=F'44' COMPARE LENGTH W/ 44 BNH MOVEPARMS IF LENGTH < 44, THEN BRANCH LA R2,44 ELSE, USE 44 AS THE LENGTH MOVEPARMS DS 0H ST R2,PARMLENGTH STORE R2 (LENGTH) IN STORAGE BCTR R2,R0 PERFORM THE EXECUTE EX R2,MVPARMNM AS MANY TIMES AS THERE ARE CHARS * L R2,PARMLENGTH LOAD R2 WITH LENGTH OF DSNAME LA R6,AREA POINT R6 TO GQSCAN RETURN AREA ACCESSGRS DS 0H GQSCAN AREA=(AREA,10000),RESNAME=(QNAME,PARMNAME,(R2)), X SCOPE=ALL,TOKEN=TOK ST R15,SAVR15 LTR R15,R15 CHECK THE RETURN CODE BNZ ERRORMSG IF NON ZERO, BRANCH TO ERROR ROUTINE * WTO 'GQSCAN PERFORMED',ROUTCDE=11 SCANL1 STCM R0,12,TEMP2 L R8,TEMPF STCM R0,3,TEMP2 L R9,TEMPF LR R5,R1 MVC RES_DSNAME,PARMNAME MVC WTOMSG+8(60),RESOURCE_MSG BAS R10,WTOMSG *{SECTION 1 CODE GOES HERE} RIBLOOP DS 0H USING RIB,R6 * WTO 'RIBLOOP EXECUTED',ROUTCDE=11 LR R7,R6 LA R7,40(R7) ADD FIXED SECTION OF RIB TO ADDRESS AH R7,RIBVLEN ADD VARIABLE SECTION OF RIB TO ADDR L R10,RIBNRIBE SR R3,R3 CLEAR COUNTER REGISTER RIBELOOP DS 0H A R3,=F'1' INCREMENT COUNTER REGISTER USING RIBE,R7 PROVIDE ADDRESSABILITY TO EXTENSION * WTO 'RIBELOOP EXECUTED',ROUTCDE=11 MVC JOBNAME,RIBEJBNM TM RIBESFLG,X'80' IS STATUS BIT = 1? BO OWNER YES, THEN THIS IS THE OWNER B WAITER ELSE THIS IS THE WAITER * OWNER DS 0H MVC ALLOC_JOBNAME,JOBNAME TM RIBERFLG,X'80' IS REQUEST BIT = 1? BO OWNSHR OWNOLD DS 0H MVC ALLOC_DISP,OLD_CONST MOVE OLD TO DISP= MVC WTOMSG+8(60),BLANKS BLANK OUT THE LINE MVC WTOMSG+8(45),ALLOCATED_MSG MOVE ALLOCATED LINE BAS R10,WTOMSG WRITE OUT THE LINE B EVALUATE OWNSHR DS 0H MVC ALLOC_DISP,SHR_CONST MOVE SHR TO DISP= MVC WTOMSG+8(60),BLANKS BLANK OUT THE LINE MVC WTOMSG+8(45),ALLOCATED_MSG MOVE ALLOCATED LINE BAS R10,WTOMSG WRITE OUT THE LINE B EVALUATE * WAITER DS 0H MVC WAIT_JOBNAME,JOBNAME MOVE JOBNAME TM RIBERFLG,X'80' IS REQUEST BIT = 1? BO WAITSHR YES, THIS IS A DISP=SHR REQUEST WAITOLD DS 0H MVC WAIT_DISP,OLD_CONST MOVE OLD TO DISP= MVC WTOMSG+8(60),BLANKS MOVE BLANKS TO OUTPUT LINE MVC WTOMSG+8(52),WAITING_MSG MOVE WAIT-REC TO OUTPUT BAS R10,WTOMSG EXECUTE OUTPUT ROUTINE B EVALUATE WAITSHR DS 0H MVC WAIT_DISP,SHR_CONST MOVE SHR TO DISP= MVC WTOMSG+8(60),BLANKS MOVE BLANKS TO OUTPUT LINE MVC WTOMSG+8(52),WAITING_MSG MOVE WAIT-REC TO OUTPUT BAS R10,WTOMSG EXECUTE OUTPUT ROUTINE B EVALUATE * EVALUATE DS 0H LA R7,48(R7) C R3,RIBNRIBE BL RIBELOOP B RETURN MVPARMNM MVC PARMNAME(0),2(R1) MOVE EACH BYTE OF DSNAME * EMPTYPARM DS 0H MVC WTOMSG+8(60),BLANKS BLANK OUT OUTPUT LINE WTO 'NO DATASETNAME IN THE INPUT PARM',ROUTCDE=11 B RETURN ERRORMSG DS 0H * WTO 'ERROR RETURNED',ROUTCDE=11,DESC=7 L R15,SAVR15 C R15,=F'4' WAS RC 8 RETURNED? BE NOTALLOC C R15,=F'8' BE OVERFLOW WTO 'FATAL ERROR OCCURRED',ROUTCDE=11 B RETURN NOTALLOC DS 0H WTO 'RESOURCE NOT ALLOCATED',ROUTCDE=11 B RETURN OVERFLOW DS 0H WTO 'RETURN AREA EXCEEDED',ROUTCDE=11 B RETURN * WTOMSG WTO ' X ',ROUTCDE=11 BR R10 * RETURN DS 0H L R13,4(,R13) L R14,12(R13) LM R0,R12,20(R13) SR R15,R15 CLEAR THE RETURN CODE BSM 0,R14 * DS 0F SAVEAREA DS 18F SAVR15 DS F TOK DS F PARMLENGTH DS F K4VAL DC H'4096' TEMPF DS 0F TEMP1 DC H'0' TEMP2 DC H'0' QNAME DC CL8'SYSDSN ' PARMNAME DC CL44' ' OLD_CONST DC CL3'OLD' SHR_CONST DC CL3'SHR' BLANKS DC CL60' ' BLANK LINE * ALLOCATED_MSG DS 0CL45 ALLOC_FILLER DC CL2' ' ALLOC_LINE_1 DC CL23'CURRENTLY ALLOCATED TO ' ALLOC_JOBNAME DC CL8' ' ALLOC_LINE_2 DC CL9' AS DISP=' ALLOC_DISP DC CL3' ' * WAITING_MSG DS 0CL52 WAIT_FILLER DC CL2' ' WAIT_JOBNAME DC CL8' ' WAIT_LINE_1 DC CL30' IS WAITING FOR THE RESOURCE,' WAIT_LINE_2 DC CL9' AS DISP=' WAIT_DISP DC CL3' ' * RESOURCE_MSG DS 0CL60 RES_FILLER DC CL2' ' RES_LINE_1 DC CL10'RESOURCE: ' RES_DSNAME DC CL44' ' RES_FILLER_2 DC CL6' ' * DS 0D DWORD DC D'0' * JOBNAME DS CL8 AREA DS CL10000 STORAGE FOR GQSCAN RETURN AREA ISGRIB END