**************************************************************** * THIS PROGRAM IS A REXX FUNCTION THAT WILL READ THROUGH * * THE UCB ADDRESSES AND RETURN THEM IN REXX VARIABLES * * * * THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE: * * VARIABLE_NAME = NAME OF THE COMPOUND VARIABLE * * COUNT = MAXIMUM NUMBER OF MEMBERS TO LIST * * * * THE VARIABLE VALUE THAT WILL BE RETURNED IS: * * STATUS_AREA = WHERE THIS PROGRAM WILL RETURN THE STATUS * * * * 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. * **************************************************************** ALXRDASD CSECT ALXRDASD AMODE 31 ALXRDASD 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 YESDASD EQU 8 YESTAPE EQU 4 BYPVOL EQU 2 STM R14,R12,12(R13) LR R7,R1 SAVE THE PARAMETER ADDRESS LR R12,R15 SET UP BASE REGISTER ADDRESS. USING ALXRDASD,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 ST R7,EVALBLK_ADDRESS MVC EYECATCH(8),=C'EYECATCH' ************************************************************** * THE FIRST PARAMETER IS THE COMPOUND VARIABLE NAME * ************************************************************** PROCESS_VARNAME EQU * L R11,16(R7) LET'S GET OUR ARGUMENT CLC 0(8,R11),FFFLAG END OF PARM LIST BE USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES ICM R9,15,4(R11) GET THE LENGTH OF VAR NAME BZ PROCESS_COUNT IF 0 THEN USE DEFAULT AND GO TO NEXT CH R9,HW17 LENGTH 17 IS THE MAX BH BAD_PARM GT JUST GET OUT L R10,0(R11) POINT TO THE ARGUMENT STH R9,VARNAME_LENGTH SAVE THE LENGTH BCTR R9,0 DECREMENT IT BY ONE FOR MOVE EX R9,MOVEVARN MVC VARNAME(0),0(R10) ****************************************************************** * THE SECOND PARAMETER IS THE MAXIMUM NUMBER OF UCBS TO READ* ****************************************************************** PROCESS_COUNT EQU * CLC 8(8,R11),FFFLAG END OF PARM LIST BE USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES ICM R9,15,12(R11) GET THE LENGTH OF VAR NAME * BZ USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES BZ PROCESS_TYPE YES, THEN PROCESS THIRD PARM L R10,8(R11) POINT TO THE ARGUMENT BCTR R9,0 DECREMENT IT BY ONE LA R8,7 DOUBLE_WORD LENGTH - 1 FOR EX SLL R9,28 GET IT IN THE HI-ORDER BYTE SLDL R8,4 AND SHIFT IT TOGETHER W/ OTHER LENG EX R8,PACK_COUNT PACK DOUBLE_WORD(0),0(0,R10) CVB R8,DOUBLE_WORD GET THE LENGTH OF REPLY IN R8 CH R8,HW9999 CAN'T BE GT MAX BH BAD_PARM YES, THEN JUST QUIT STH R8,COUNT_VALUE SAVE THE COUNT FOR GETMAIN ****************************************************************** * THE THIRD PARAMETER IS THE UCB TYPE * ****************************************************************** PROCESS_TYPE EQU * CLC 16(8,R11),FFFLAG END OF PARM LIST BE USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES ICM R9,15,20(R11) GET THE LENGTH OF VAR NAME * BZ USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES BZ PROCESS_NOVOL YES, THEN PROCESS FOURTH PARM CH R9,HW4 SEE IF LENGTH OF YES * BNE USE_DEFAULTS NO, THEN DON'T CHECK FURTHER BNE PROCESS_NOVOL NO, THEN PROCESS FOURTH PARM L R10,16(R11) POINT TO THE ARGUMENT TRY_TAPE CLC 0(4,R10),TAPE IS IT A TAPE * BNE USE_DEFAULTS NO, THEN DON'T CHECK FURTHER BNE PROCESS_NOVOL NO, THEN PROCESS FOURTH PARM OI FLAG,YESTAPE SET THE FLAG ****************************************************************** * THE FOURTH PARAMETER IS FOR BYPASSING ACCESSING VOLUME INFO * ****************************************************************** PROCESS_NOVOL EQU * CLC 24(8,R11),FFFLAG END OF PARM LIST BE USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES ICM R9,15,28(R11) GET THE LENGTH OF VAR NAME BZ USE_DEFAULTS YES, USE REMAINING DEFAULT VALUES CH R9,HW5 SEE IF LENGTH OF NOVOL BNE USE_DEFAULTS NO, THEN DON'T CHECK FURTHER L R10,24(R11) POINT TO THE ARGUMENT CLC 0(5,R10),NOVOL DO WE BYPASS NOVOL BNE USE_DEFAULTS NO, THEN DON'T CHECK FURTHER OI FLAG,BYPVOL SET THE FLAG USE_DEFAULTS EQU * ********************************************************************* * * ********************************************************************* LH R3,COUNT_VALUE LH R5,VARNAME_LENGTH LA R5,17(R5) INCREMENT FOR SHV BLOCK INFO * VARNAME LGNTH+VARDATA LNGTH+VARDATA ADDR+ 5 (.9999) CH R3,HW1000 SEE IF LT 1000 BNL LEAVEIT BCTR R5,0 TAKE ONE AWAY FOR SMALLER GETMAIN LEAVEIT MH R5,COUNT_VALUE GET THE TOTAL GETMAIN LA R5,20(R5) INCR PASSED BEGINNING LA R3,1(R3) ADD ONE MORE FOR MEMBER.0 MULTIPLY_BY8 EQU * MH R3,HW25 MULTIPLY BY LENGTH OF UCBSTORE NOTBY8 AR R5,R3 TOTAL THE GETMAIN LR R0,R5 ST R0,GETMAIN_LENGTH SAVE THE LENGTH GETMAIN RC,LV=(0) LTR R15,R15 BNZ BAD_STORAGE ISSUE MESSAGE AND GET OUT ST R1,GETMAIN_ADDRESS LA R10,20(R1) SAVE FOR REXX SHV BLOCK DATA ************************************************************ LH R15,VARNAME_LENGTH BCTR R15,0 DECR FOR EXECUTE EX R15,INITVARN MVC 4(0,R10),VARNAME LA R14,5(R15,R10) POINT TO LOCATION PAST NAME MVC 0(2,R14),STEM0 MOVE IN PERIOD AND ZERO LA R15,3(R15) 1 FOR EX DECR, 1 FOR . , 1 FOR 0 STCM R15,15,0(R10) SAVE THE VARIABLE NAME LENGTH LA R10,2(R14) INCREMENT PAST STEM LH R15,HW4 LENGTH OF 4 FOR VAR DATA STCM R15,15,0(R10) SAVE THE LENGTH LA R10,4(R10) INCREMENT TO VAR DATA ST R10,STEM0_ADDRESS SAVE THIS LOCATION XC 0(4,R10),0(R10) AND ZERO THE VARDATA LA R10,4(R10) AND INCREMENT PAST IT LA R3,1 SET FOR MEMBER.0 VARIABLE ************************************************************* * READ THROUGH THE UCBS HERE *..................................................................... * * CLEAR THE UCBSCAN WORK AREA. * *..................................................................... * LA R0,SCANWORK SET STORAGE ADDRESS * LA R1,100 SET STORAGE LENGTH * SR R15,R15 CLEAR SECOND OPERAND * MVCL R0,R14 CLEAR THE STORAGE XC SCANWORK(100),SCANWORK CLEAR IT THIS WAY LA R7,UCBSTOR SETUP UP ADDRESSABILITY USING UCB,R7 *..................................................................... * * LOOP THROUGH ALL DASD UCBS * *..................................................................... SCANLOOP EQU * TM FLAG,YESTAPE BO SCANTAPE SCANDASD UCBSCAN COPY, X WORKAREA=SCANWORK, X UCBAREA=UCBSTOR, X DEVCLASS=DASD, X DYNAMIC=YES, X DEVNCHAR=DEVNCHAR, X RANGE=ALL, X MF=(E,SCANLIST) B CHECKRC SCANTAPE UCBSCAN COPY, X WORKAREA=SCANWORK, X UCBAREA=UCBSTOR, X DEVCLASS=TAPE, X RANGE=ALL, X DYNAMIC=YES, X DEVNCHAR=DEVNCHAR, X MF=(E,SCANLIST) * DC H'00' *..................................................................... * * IF UCBSCAN RETURNED A UCB, THEN STORE IT AND CONTINUE * *..................................................................... CHECKRC CH R15,HW4 TEST RETURN CODE BH RCGT4 IF GT 4 THEN EXIT WITH ERROR BE FINISHED RC 4 THEN COMPLETE AND STORE *..................................................................... ************************************************************* * * INITIALIZE THE SHV BLOCKS AND INCREMENT THE COMPOUND VARIABLE HERE * LH R15,VARNAME_LENGTH BCTR R15,0 DECR FOR EXECUTE EX R15,INITVARN MVC 4(0,R10),VARNAME LA R14,5(R15,R10) POINT TO LOCATION PAST NAME MVI 0(R14),C'.' MOVE IN PERIOD LA R14,1(R14) INCREMENT PAST AP COMPOUND_STEM(3),INCR_STEM(1) MVC STEM_VALUE(6),STEM_MASK SET THE MASK ED STEM_VALUE(6),COMPOUND_STEM TRT STEM_VALUE(6),NBLNKTBL LOOK FOR FIRST NON BLANK LA R2,STEM_VALUE+5 INCR FOR SUBTRACT SLR R2,R1 GET THE LENGTH EX R2,MOVE_STEM MVC 0(0,R14),0(R1) LA R15,3(R2,R15) 2 FOR EX DECR, AND 1 FOR PERIOD STCM R15,15,0(R10) SAVE THE VARIABLE NAME LENGTH LA R10,1(R2,R14) INCREMENT PAST STEM *********** MVI 4(R10),C' ' MOVE IN BLANK MVC 5(24,R10),4(R10) BLANK OUT THE WHOLE THING MVC 8(4,R10),DEVNCHAR MOVE IN 4 CHAR UCB TM UCBSTAT,UCBONLI SEE IF ONLINE BO ITS_ONLINE MVC 4(4,R10),=C'OFF ' B INCRUCBS ITS_ONLINE EQU * MVC 4(4,R10),=C'ON ' MVC 13(6,R10),UCBVOLI MOVE IN THE VOLSER MVC VOLSER(6),UCBVOLI * LA R4,VOLSER * LA R2,VTOCWORK TM FLAG,YESTAPE+BYPVOL IF IT'S TAPE OR NOVOL THEN DON'T BNZ INCRUCBS READ VTOC FOR SIZE * OBTAIN READVTOC SLR R14,R14 LA R15,VTOCWORK USING IECSDSL4,R15 * ICM R14,3,VTOCWORK+18 ICM R14,3,DS4DSCYL CVD R14,DOUBLE_WORD CONVERT IT MVC 20(5,R10),VOLSIZE_MASK MOVE IN THE MASK ED 19(6,R10),DOUBLE_WORD+5 MVC 26(3,R10),=C'ENA' TM DS4VTOCI,DS4DVTOC IS VTOC DISABLED? BZ INCRUCBS NO, THEN GO AROUND MVC 26(3,R10),=C'DIS' * DC H'00' INCRUCBS EQU * MVC 0(4,R10),FW25 MOVE IN LENGTH OF 25 FOR DASD INFO LA R10,29(R10) INCREMENT PAST THE MEMBER AND LNGTH LA R3,1(R3) INCR. COUNTER FOR MEMBERS CH R3,COUNT_VALUE CHECK TO SEE IF MAX HIT BL SCANLOOP NO, THEN LOOP THRU TO NEXT ONE **************************************** FINISHED EQU * CHECK_ERROR EQU * TM FLAG,X'01' DID AN ERROR OCCUR ?? BO SETRPLY **************************************** STOREIT L R14,GETMAIN_ADDRESS USING ALXPARM,R14 MVC ALXEXCOM_FUNCTION(8),=C'STORE ' ST R3,ALXEXCOM_VARCOUNT L R15,STEM0_ADDRESS BCTR R3,0 CVD R3,DOUBLE_WORD GET IT ED STEM_MASK(6),DOUBLE_WORD+5 MVC 0(4,R15),STEM_MASK+2 LA R1,ALXEXCOM_FUNCTION SET THE PARM FIELD UP LIKE ST R1,PARMLIST THIS SO THAT SUBROUTINE IS LA R1,PARMLIST ABLE TO HANDLE PARM LIKE COBOL DROP R14 L R15,ALXEXCOM BALR R14,R15 **** * LA R8,2 SET THE DEFAULT REPLY MESSAGE **************************************** SETRPLY L R7,EVALBLK_ADDRESS 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(33),STATUS_AREA FREESTOR EQU * ICM R1,15,GETMAIN_ADDRESS BZ NOT_GOTTEN L R0,GETMAIN_LENGTH FREEMAIN RC,A=(1),LV=(0) NOT_GOTTEN 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_PARM EQU * MVC STATUS_AREA(33),ERROR_FUNCTION LA R8,33 B SETRPLY ************************* BAD_STORAGE EQU * MVC STATUS_AREA(33),STORAGE_ERROR OI FLAG,X'01' SET FOR ERROR LA R8,22 B FINISHED ****************************************************** * THIS NEXT SECTION IS ENTERED IF THE RETURN CODE IS * * GT FOUR * ****************************************************** RCGT4 EQU * MVC STATUS_AREA(33),RCGT4_ERROR OI FLAG,X'01' SET FOR ERROR LA R8,25 B FINISHED READVTOC CAMLST SEARCH,VTOC,VOLSER,VTOCWORK *READVTOC CAMLST SEARCH,VTOC,(4),(2) ************************* EJECT ALXEXCOM DC V(ALXEXCOM) MOVEVARN MVC VARNAME(0),0(R10) MOVERPLY MVC EVALBLOCK_EVDATA(0),STATUS_AREA MOVE_STEM MVC 0(0,R14),0(R1) INITVARN MVC 4(0,R10),VARNAME MOVE_VARDATA MVC 4(0,R10),0(R5) PACK_COUNT PACK DOUBLE_WORD(0),0(0,R10) PACK_START EQU PACK_COUNT FW25 DC F'25' HW3 DC H'3' HW4 DC H'4' HW5 DC H'5' HW17 DC H'17' HW25 DC H'25' HW1000 DC H'1000' HW9999 DC H'9999' FFFLAG DC 8X'FF' COUNT_VALUE DC H'1000' START_VALUE DC H'1' VARNAME_LENGTH DC H'6' VARNAME DC CL22'RECORD ' STEM0 DC CL2'.0' STEM_VALUE DC CL6' ' STEM_MASK DC X'402020202120' UNITADDR_MASK DC X'21202020' DEVNCHAR DC CL4' ' VOLSIZE_MASK DC X'2021202020' COMPOUND_STEM DC PL3'0' INCR_STEM DC PL1'1' YES DC CL3'YES' DASD DC CL4'DASD' TAPE DC CL4'TAPE' BOTH DC CL4'BOTH' NOVOL DC CL5'NOVOL' VTOC DC 44X'04' VOLSER DC CL6' ' VTOCWORK DS CL140 ****** ****** BLANKS DC CL8' ' STATUS_AREA DC CL33'OK' ERROR_FUNCTION DC CL33'ERROR IN SPECIFYING READ FUNCTION' 33 OPEN_ERROR DC CL33'ERROR OPENING PDS DATASET ' 25 RCGT4_ERROR DC CL33'ERROR PERFORMING UCBSCAN ' 25 STORAGE_ERROR DC CL33'STORAGE REQUEST FAILED ' 22 *********** LTORG DS 0F NBLNKTBL DC 256X'FF' ORG NBLNKTBL+C' ' DC X'00' ORG STORAGE DSECT SAVEAREA DS 18F DOUBLE_WORD DS D EVALBLK_ADDRESS DS F GETMAIN_ADDRESS DS F GETMAIN_LENGTH DS F STEM0_ADDRESS DS F FLAG DS X EYECATCH DS CL8 *...................................................................... * . * LIST FORMS OF MACROS. THE LIST AND EXECUTE FORMS OF THESE MACROS . * ARE USED BECAUSE THIS MODULE IS REENTRANT. . * . *...................................................................... LIST_SCANSERV UCBSCAN MF=(L,SCANLIST) LIST FORM OF UCBSCAN SCANSERV_END DS 0D SCANWORK DS CL100 SCAN WORK AREA SCANWORK_END DS 0D UCBSTOR DS CL48 UCB COPY STORAGE UCBSTOR_END DS 0D *************************** *************************** STORAGE_SIZE EQU *-SAVEAREA ** ALXPARM DSECT PARMLIST DS F ALXEXCOM_FUNCTION DS CL8 ALXEXCOM_VARCOUNT DS F ALXEXCOM_RETCODE DS F ALXEXCOM_STORAGE EQU * IRXEVALB * CHANNEL PATH. ********************************** * UCB DSECT IEFUCBOB IECSDSL1 4 END