**************************************************************** * 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 * * MEMBER IN A CONCATENATED LIST * * * * THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE: * * MEMBER = WHICH WILL CONTAIN THE MEMBER NAME TO FIND * * SEARCH_DDNAME = THE DDNAME TO SEARCH * * * * THE VARIABLE VALUE THAT WILL BE RETURNED IS: * * DSNAME_AREA = WHERE THIS PROGRAM WILL STORE THE DATASET * * NAME OR THE KEYWORD NOT_FOUND * * * * 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. * **************************************************************** ALXRFNDM CSECT ALXRFNDM AMODE 31 ALXRFNDM RMODE 24 PRINT ON,GEN,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 STM R14,R12,12(R13) LR R7,R1 SAVE THE PARAMETER ADDRESS LR R12,R15 SET UP BASE REGISTER ADDRESS. USING ALXRFNDM,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) LA R4,DDNAME ADDRESS FOR TEXT OF MESSAGE ****************************************************************** CLC 8(8,R11),FFFLAG HAVE THEY SPECIFIED A DDNAME BE SET_DEFAULT NO, THEN JUST SET TO 80 BYTES ICM R9,15,12(R11) GET THE LENGTH OF REPLY_LENGTH VALUE BZ SET_DEFAULT JUST SET TO 80 BYTES MVC DDNAME(8),BLANKS BLANK OUT THE DDNAME L R10,8(R11) POINT TO THE ARGUMENT BCTR R9,0 DECREMENT IT BY ONE EX R9,MOVEDDN MVC DDNAME(0),0(R10) B SEARCH_LOADLIB SET_DEFAULT EQU * MVC DDNAME(8),=C'LOADLIBS' SET THE DEFAULT **************************************************************** * HERE IS WHERE WE WILL USE SVC99 TO READ ALL OF THE DDNAMES * * AND THEIR CORRESPONDING DATASET NAMES. * **************************************************************** SEARCH_LOADLIB EQU * LA R3,DSNAME_TABLE POINT TO TABLE LA R5,S99AREA ADDRESS SVC99 PARAMETER FIELDS USING S99RB,R5 MVI S99VERB,S99VRBIN INDICATE INFORMATION TO BE GOTTEN LA R4,1 SET FIRST RELATIVE RECD COUNTER SLR R2,R2 ZERO IT OUT FOR COUNT LOOP_SVC99 EQU * * LA R1,INTUPTR 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 MVC RTDDLNG(2),HW8 RESET DDNAME LENGTH MVC RTDSLNG(2),HW44 RESET DSNAME LENGTH MVI RTDSN,C' ' BLANK OUT DSNAME MVC RTDSN+1(43),RTDSN BLANK OUT DSNAME MVC RTDDN(8),RTDSN BLANK OUT DDNAME SPACE 1 DYNALLOC PERFORM DYNAMIC ALLOCATION LTR R15,R15 VERIFY RETURN CODE BNZ BAD_FIND NOT ZERO THEN ISSUE ERROR MSG TM FLAG,FOUND_DDN HAVE WE ALREADY FOUND OUR DDN ? BO CHECK_END YES, THEN CHECK FOR THE END CLC RTDDN(8),DDNAME COMPARE FOR OUR DDNAME BNE SETNEXT OI FLAG,FOUND_DDN B MOVEADSN CHECK_END EQU * CLC RTDDN(8),BLANKS SEE IF CONCATENATED BNE DONEALOC NO, THEN WE GOT OURS MOVEADSN MVC 0(44,R3),RTDSN AND ALSO THE DATASET NAME LA R2,1(R2) INCR THE COUNT LA R3,44(R3) INCREMENT FIELD IN STORAGE SETNEXT LA R4,1(R4) INCR RELATIVE RECORD COUNT STH R4,INRRNUM SAVE FOR NEXT SVC99 INVOCATION TM RTRRNUM,X'80' WAS THAT THE LAST BZ LOOP_SVC99 NO, THEN CONITNUE READING LIST DONEALOC LTR R2,R2 MAKE SURE THAT WE FOUND OUR FILE BZ BAD_FIND NO, THEN GET OUT STCM R2,3,DSNAME_COUNT SAVE THE COUNT SPACE 2 ********************************************************************* * THIS SECTION WILL OPEN THE FILE AND READ IN ALL THE PROGRAM * * ENTRIES TO THE TABLE. * ********************************************************************* OPENLIB MVC LOADLIBS+40(8),DDNAME LA R14,OPENBSM ICM R14,8,=X'00' BSM R0,R14 OPENBSM EQU * OPEN LOADLIBS TM LOADLIBS+48,X'10' BZ BAD_FIND2 LA R2,MEMBER_BLDL BLDL LOADLIBS,(2) LTR R15,R15 BZ GOTDSNAME MVC DSNAME_AREA(44),NOT_FOUND_DSN B CLOSEUP GOTDSNAME 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) CLOSEUP EQU * CLOSE LOADLIBS LA R14,SETRPLY ICM R14,8,=X'80' BSM R0,R14 **************************************** SETRPLY L R10,20(R7) L R10,0(R10) USING EVALBLOCK,R10 LH R8,HW44 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(44),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),ERROR_FUNCTION LA R8,33 LA R14,SETRPLY ICM R14,8,=X'80' BSM R0,R14 EJECT LOADLIBS DCB DDNAME=LOADLIBS,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' FFFLAG DC 8X'FF' ****** MEMBER_BLDL DC H'1',H'12' MEMBER DC CL8' ',4X'00' ****** BLANKS DC CL8' ' NOT_FOUND_DSN DC CL44'NOT_FOUND ' ERROR_FUNCTION DC CL33'ERROR IN SPECIFYING FIND FUNCTION' FLAG DC X'00' * 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(INTUPTR) POINTER TO LIST OF TEXT UNIT PTRS DC XL8'00' SPACE 1 INTUPTR DC A(INRRTU) ADDR OF RELATIVE RECORD REQUEST DC A(RTDSTU) ADDR OF DSNAME RETURN DC A(RTDDTU) ADDR OF DDNAME RETURN DC X'80',AL3(RTRRTU) ADDR OF LAST RELATIVE RECD RETURN SPACE 1 RTDSTU DC X'0005' ALLOCATION BY DSNAME DC X'0001' ONE PARAMETER RTDSLNG DC X'002C' LENGTH OF PARAMETER RTDSN DC CL44' ' DS 0H RTDDTU DC X'0004' DDNAME DC X'0001' ONE PARAMETER RTDDLNG DC X'0008' LENGTH OF PARAMETER RTDDN DC CL8' ' AREA FOR DDNAME DS 0H INRRTU DC X'000F' RELATIVE RECORD DC X'0001' ONE PARAMETER DC X'0002' LENGTH OF PARAMETER INRRNUM DC X'0001' RELATIVE RECORD ONE DS 0H RTRRTU DC X'000D' DC X'0001' DC X'0001' RTRRNUM DC X'00' *********** LTORG STORAGE DSECT SAVEAREA DS 18F DDNAME DS CL8 DSNAME_AREA DS CL44 DSNAME_COUNT DS H DSNAME_TABLE DS 44000X ** STORAGE_SIZE EQU *-SAVEAREA IRXEVALB IEFZB4D0 IEFZB4D2 ** ** ** (C) COPYRIGHT 1997, SSC, INC. ** ** SSC, INC. ** 13530 WILT STORE RD. ** LEESBURG, VA 20176 ** (703) 777-2771 FAX (703) 777-6839 ** END