**************************************************************** * AUTHOR - BILL SWEENEY * * SSC, INC. (703) 777-2771 * * WHSWEENEY@SSCMAINFRAME.COM * * WWW.SSCMAINFRAME.COM * * DATE - (C) COPYRIGHT 1997 * * * * THIS PROGRAM IS A REXX FUNCTION THAT WILL FIND A * * MODULE IN THE SYSTEM LPALIST OR LINKLIST * * * * THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE: * * MEMBER = WHICH WILL CONTAIN THE MEMBER NAME TO FIND * * * * THE VARIABLE VALUE THAT WILL BE RETURNED IS: * * DSNAME_AREA = WHERE THIS PROGRAM WILL STORE THE DATASET * * NAME OR THE KEYWORD NOT_FOUND, AND WHETHER * * IT WAS IN LPALIST OR LINKLIST * * * * REGISTERS: * * R1 - FIVE WORD PARAMETER LIST OF REXX VARIABLES * * WORD1 - RESERVED * * WORD2 - RESERVED * * WORD3 - RESERVED * * WORD4 - ADDRESS OF ARGUMENTS PASSED BY REXX * * WORD5 - ADDRESS OF THE EVALUATION BLOCK WHERE WE * * WILL RETURN THE REPLY * * * * I AM ONLY INTERESTED IN R1 BECAUSE IT WILL PASS THE ADDRESS * * PARAMETER LIST OF VARIABLES. EVERYTHING IS STANDARD * * USAGE AND NOTHING TO WRITE HOME ABOUT. * **************************************************************** ALXRFNDS CSECT ALXRFNDS AMODE 31 ALXRFNDS RMODE 24 PRINT ON,NOGEN,NODATA 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 NO_STORAGE EQU 20 FOUND_DDN EQU 1 FOUND_DSNAME EQU 2 CDE_MODULE EQU 8 LPA_LISTED EQU 4 STM R14,R12,12(R13) LR R7,R1 SAVE THE PARAMETER ADDRESS LR R12,R15 SET UP BASE REGISTER ADDRESS. USING ALXRFNDS,R12 GETMAIN RC,LV=STORAGE_SIZE LTR R15,R15 BZ GOOD_STORAGE LA R15,NO_STORAGE B RETURN2 GOOD_STORAGE EQU * ST R1,8(R13) ST R13,4(R1) LR R13,R1 USING STORAGE,R13 ****************************************************************** L R11,16(R7) LET'S GET OUR ARGUMENT CLC 0(8,R11),FFFLAG IS THERE ANY ARGUMENT BE BAD_FIND NO, THEN DO DEFAULT ICM R3,15,4(R11) GET THE LENGTH OF ARGUMENT BZ BAD_FIND IF NULL/ZERO THEN DO DEFAULT CH R3,HW8 VERIFY IT'S NOT TOO LONG BH BAD_FIND NO, THEN CONTINUE MVC MEMBER(8),BLANKS BLANK OUT THE MEMBER NAME BCTR R3,0 DECREMENT FOR EXECUTE MOVE L R10,0(R11) AND ADDRESS THE ARGUMENT EX R3,MOVEMMBR MVC MEMBER(0),0(R10) **************************************************************** * WE WILL SEARCH THROUGH THE CONTENTS DIRECTORY ENTRIES (CDE) * * TO SEE IF IT WAS AN MLPA OR FIX LIST ENTRY * **************************************************************** LOADCVT L R3,16 CVT POINTER L R3,188(R3) CDE POINTER LOOPCDE CLC MEMBER(8),8(R3) COMPARE FOR THE A CDE MODULE BE GOTCDE YES, THEN MARK IT ICM R3,15,0(R3) CHAIN TO THE NEXT BNZ LOOPCDE B DONECDE IF FALL THRU THEN CONTINUE GOTCDE OI FLAG,CDE_MODULE FLAG IT AS CDE **************************************************************** * HERE IS WHERE WE WILL USE SVC99 TO READ ALL OF THE DDNAMES * * AND THEIR CORRESPONDING DATASET NAMES. * **************************************************************** DONECDE LA R3,DSNAME_TABLE L R11,16 GET THE ADDRESS OF THE CVT TM FLAG,LPA_LISTED IS THIS THE FIRST OR SECOND TIME BO LOADLINK YES, THEN LOAD THE LINK LIST L R11,1336(R11) GET THE POINTER FOR LPA FIRST B LOOPLIST LOADLINK L R11,1244(R11) LINKLIST POINTER LOOPLIST L R10,4(R11) GET THE COUNT IN REG 10 LR R9,R10 TEMP SAVE HERE FOR LOOP LA R8,8(R11) INCREMENT TO DSNAMES LOOPNAME MVC 0(44,R3),1(R8) MOVE IN THE NAME LA R3,44(R3) INCREMENT THE TABLE LA R8,45(R8) AND HERE AS WELL BCT R9,LOOPNAME LOAD UP THE NAMES **************************************************************** * HERE IS WHERE WE WILL USE SVC99 TO READ ALL OF THE DDNAMES * * AND THEIR CORRESPONDING DATASET NAMES. * **************************************************************** ALLOC_LOADLIB EQU * LA R3,DSNAME_TABLE POINT TO TABLE LA R5,S99AREA ADDRESS SVC99 PARAMETER FIELDS USING S99RB,R5 LR R9,R10 GET THE COUNT IN R9 FOR LOOP LOOP_SVC99 EQU * MVC ALDSN(44),0(R3) MOVE IN THE DSNAME MVI S99VERB,S99VRBAL INDICATE ALLOCATE VERB * LOADR1PT LA R1,ALTUPTR ADDR OF ALLOCATION TEXT UNIT PTRS ST R1,S99TXTPP STORE IN SVC 99 REQUEST BLOCK LA R1,S99PARM LOAD ADDRESS OF SVC 99 PARM AREA SPACE 1 DYNALLOC PERFORM DYNAMIC ALLOCATION LTR R15,R15 VERIFY RETURN CODE * BNZ DYNALL_ERROR ISSUE ERROR MESSAGE ****+++*** BNZ INCR_DSNAME NOT ZERO THEN DO THE NEXT ONE * BZ GOOD_ALLOC NOT ZERO THEN DO THE NEXT ONE GOOD_ALLOC EQU * CLI CONDDN1,C' ' IS THIS THE FIRST TIME THROUGH BNE CONCAT_FILE NO, THEN CONCATENATE IT MVC CONDDN1(8),ALDDN MOVE IN THE DDNAME FOR CONCAT MVC UALDDNAM(8),ALDDN MOVE IN THE DDNAME FOR FREE MVC SYSLOADS+40(8),ALDDN USE THIS DDNAME FOR OPEN B INCR_DSNAME CONCAT_FILE EQU * LA R1,CONPTR ADDR OF ALLOCATION TEXT UNIT PTRS MVC CONDDN2(8),ALDDN MOVE IN THE RETURNED DDNAME MVC ALDDN(8),BLANKS AND BLANK IT OUT FOR NEXT TIME MVI S99VERB,S99VRBCC MOVE IN CONCATENATION VERB ST R1,S99TXTPP STORE IN SVC 99 REQUEST BLOCK LA R1,S99PARM LOAD ADDRESS OF SVC 99 PARM AREA SPACE 1 DYNALLOC PERFORM DYNAMIC ALLOCATION LTR R15,R15 VERIFY RETURN CODE BNZ DYNALL_ERROR ISSUE ERROR MESSAGE ****+++*** INCR_DSNAME EQU * LA R3,44(R3) BCT R9,LOOP_SVC99 LOOP THROUGH AND ALLOCATE SPACE 2 ********************************************************************* * THIS SECTION WILL OPEN THE FILE AND DO A BLDL SEARCH ON THE * * LOAD MODULE * ********************************************************************* OPENLIB LA R14,OPENBSM ICM R14,8,=X'00' BSM R0,R14 OPENBSM EQU * OPEN SYSLOADS TM SYSLOADS+48,X'10' BZ BAD_FIND2 LA R2,MEMBER_BLDL BLDL SYSLOADS,(2) * DC H'00' ***+++*** LTR R15,R15 BNZ CLOSEUP GOT_DSNAME EQU * LH R3,DSNAME_COUNT SLR R14,R14 IC R14,MEMBER+11 GET THE CONCATENATION VALUE MH R14,HW44 LA R15,DSNAME_TABLE LA R15,0(R14,R15) INCREMENT TO THE DSNAME ENTRY MVC DSNAME_AREA(44),0(R15) OI FLAG,FOUND_DSNAME FLAG AS FOUND TM FLAG,CDE_MODULE WAS THIS A FIX/MLPA MODULE BZ CHECK_LPA MVC DSNAME_LOCATION(9),FIXMLPA B FLAG_END CHECK_LPA EQU * TM FLAG,LPA_LISTED IS THIS THE FIRST OR SECOND TIME BO SET_LINKLIST MVC DSNAME_LOCATION(9),LPALIST B FLAG_END SET_LINKLIST EQU * MVC DSNAME_LOCATION(9),LINKLIST FLAG_END OI FLAG,LPA_LISTED FLAG THIS SO IT EXITS CLOSEUP EQU * CLOSE SYSLOADS LA R14,FREEIT ICM R14,8,=X'80' BSM R0,R14 **************************************************************** * I COULD NOT GET FREE=CLOSE TO WORK IN THIS PROGRAM, AND SO * * JUST CODED THE UNALLOCATE FUNCTION. SUE ME. * **************************************************************** FREEIT MVI S99VERB,S99VRBUN INDICATE UNALLOCATION TO BE DONE LA R1,UALTUPTR ADDR OF UNALLOCATION TEXT UNIT PTRS ST R1,S99TXTPP STORE IN SVC 99 REQUEST BLOCK LA R1,S99PARM LOAD ADDRESS OF SVC 99 PARM AREA UNALLOC EQU * DYNALLOC PERFORM DYNAMIC UNALLOCATION **************************************************************** * WE WILL CHECK THE FLAG TO SEE IF THIS IS THE FIRST OR SECOND * * TIME THROUGH THE LOOP. IF SECOND, THEN QUIT; IF FIRST THEN * * GET ADDRESS OF LINKLIST AND LOOP BACK THROUGH * **************************************************************** CHCKLOOP TM FLAG,LPA_LISTED IS THIS THE FIRST OR SECOND TIME BO CHECK_FOUND YES, THEN VERIFY SOMETHING FOUND OI FLAG,LPA_LISTED SET THE FLAG MVC CONDDN1(8),BLANKS RESET TO BLANKS B DONECDE AND LOOP BACK THROUGH CHECK_FOUND EQU * LA R8,53 TM FLAG,FOUND_DSNAME DID WE FIND IT BO SETRPLY MVC DSNAME_AREA(44),NOT_FOUND_DSN LA R8,44 **************************************** SETRPLY L R10,20(R7) L R10,0(R10) USING EVALBLOCK,R10 ST R8,EVALBLOCK_EVLEN LA R14,16(R8) SRDL R14,32 LA R3,8 DIVISOR BY DOUBLE WORDS DR R14,R3 DIVIDE IT LTR R14,R14 BZ NO_INCREMENT LA R15,1(R15) NO_INCREMENT EQU * ST R15,EVALBLOCK_EVSIZE MVC EVALBLOCK_EVDATA(53),DSNAME_AREA FREESTOR EQU * LR R1,R13 L R13,4(R13) SO WE CAN GET OUT OF HERE FREEMAIN RC,A=(1),LV=STORAGE_SIZE RETURN1 SLR R15,R15 RETURN2 L R14,12(R13) LM R0,R12,20(R13) BR R14 BAD_FIND EQU * MVC DSNAME_AREA(33),ERROR_FUNCTION LA R8,33 B SETRPLY BAD_FIND2 EQU * MVC DSNAME_AREA(33),OPEN_ERROR LA R8,33 LA R14,SETRPLY ICM R14,8,=X'80' BSM R0,R14 DYNALL_ERROR EQU * * DC H'00' MVC DSNAME_AREA(33),ERROR_DYNALLOC LA R8,33 B SETRPLY EJECT SYSLOADS DCB DDNAME=SYSLOADS,DSORG=PO,MACRF=R,EODAD=CLOSEUP MOVEMMBR MVC MEMBER(0),0(R10) MOVEDDN MVC DDNAME(0),0(R10) MOVERPLY MVC EVALBLOCK_EVDATA(0),DSNAME_AREA HW4 DC H'4' HW8 DC H'8' HW10 DC H'10' HW12 DC H'12' HW44 DC H'44' HW80 DC H'80' HW119 DC H'119' HW122 DC H'122' RETURN_DDNAME DC X'0055' USE_DDNAME DC X'0001' FFFLAG DC 8X'FF' ****** MEMBER_BLDL DC H'1',H'12' MEMBER DC CL8' ',4X'00' ****** BLANKS DC CL8' ' FIXMLPA DC CL9' FIX/MLPA' LPALIST DC CL9' LPALIST' LINKLIST DC CL9' LINKLIST' NOT_FOUND_DSN DC CL44'NOT_FOUND ' ERROR_FUNCTION DC CL33'ERROR IN SPECIFYING FIND FUNCTION' OPEN_ERROR DC CL33'ERROR OPENING FILE TO FIND MODULE' ERROR_DYNALLOC DC CL33'ERROR IN DYNAMIC ALLOCATIONN ' * HERE ARE THE SVC 99 PARAMETER VALUES DS 0F S99PARM DC X'80',AL3(S99AREA) ADDRESS OF SVC 99 REQUEST BLOCK S99AREA DC AL1(S99RBEND-S99RB) LENGTH OF REQUEST BLOCK VERBCDE DC X'00' VERB CODE DC XL6'00' POINTER DC A(ALTUPTR) POINTER TO LIST OF TEXT UNIT PTRS DC XL8'00' SPACE 1 ALTUPTR DC A(ALDSTU) ADDR OF DSNAME TEXT UNIT DC A(ALDDTU) ADDR OF DDNAME TEXT UNIT DC A(ALFCTU) ADDR OF FREE = CLOSE TEXT UNIT DC X'80',AL3(ALDDSP) ADDR OF DISP TEXT UNIT SPACE 1 ALDSTU DC X'0002' ALLOCATION BY DSNAME DC X'0001' ONE PARAMETER ALDSNLNG DC X'002C' LENGTH OF PARAMETER ALDSN DC CL44' ' DS 0H ALDDTU DC X'0055' DDNAME DC X'0001' ONE PARAMETER DC X'0008' LENGTH OF PARAMETER ALDDN DC CL8' ' AREA FOR DDNAME DS 0H ALDDSP DC X'0004' OVERRIDE DISPOSITION DC X'0001' ONE PARAMETER DC X'0001' LENGTH OF PARAMETER DC X'08' DISPOSITION OF SHR DS 0H ALFCTU DC X'001C' FREE=CLOSE DC X'0000' 0 PARAMETER DS 0H *********** CONPTR DC A(CONCATD) DC X'80',AL3(CONCATP) CONCATD DC X'0001' CONCATENATION UNIT DC X'0002' CONDDL1 DC X'0008' CONDDN1 DC CL8' ' CONDDL2 DC X'0008' CONDDN2 DC CL8' ' CONCATP DC X'0004' PERMANENTLY CONCATENATED UNIT DC X'0000' *********** UALTUPTR DC A(UALDDTU) ADDR OF UNALLOC DDNAME TEXT UNIT DC A(UALUNTU) ADDR OF UNALLOC PERM TEXT UNIT DC X'80',AL3(UALDPTU) ADDR OF UNALLOC DISP TEXT UNIT SPACE 1 UALDDTU DC X'0001' UNALLOCATION BY DDNAME DC X'0001' ONE PARAMETER DC X'0008' LENGTH OF PARAMETER UALDDNAM DC CL8' ' DDNAME TO BE UNALLOCATED DS 0H UALUNTU DC X'0007' RESET EVEN IF PERMANENT ALLOC DC X'0000' ZERO PARM UALDPTU DC X'0005' OVERRIDE DISPOSITION DC X'0001' ONE PARAMETER DC X'0001' LENGTH OF PARAMETER UDISP DC X'08' DISPOSITION OF KEEP ****************************************************************** LTORG STORAGE DSECT SAVEAREA DS 18F DDNAME DS CL8 LIBRARY_LOCATION DS CL8 DSNAME_AREA DS CL44 DSNAME_LOCATION DS CL9 FLAG DS X DSNAME_COUNT DS H DSNAME_TABLE DS 11220X ** STORAGE_SIZE EQU *-SAVEAREA IRXEVALB IEFZB4D0 IEFZB4D2 ** ** ** (C) COPYRIGHT 1998, SSC, INC. ** ** SSC, INC. ** 13530 WILT STORE RD. ** LEESBURG, VA 20176 ** (703) 777-2771 FAX (703) 777-6839 ** END