**************************************************************** * 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 TAKE A DDNAME * * AND A LIST OF DATASETS, DYNAMICALLY ALLOCATE AND CONCATENATE * * THEM. * * * * THE VARIABLES THAT WILL BE PASSED THROUGH REGISTER 1 ARE: * * DDNAME = WHICH WILL CONTAIN THE DDNAME TO USE * * DSNAME = DSNAME TO CONCATENATE; WILL OCCUR AS MANY * * TIMES AS REQUIRED. * * * * THE VARIABLE VALUE THAT WILL BE RETURNED IS: * * STATUS_AREA = STORE THE STATUS OF THE ALLOCATION * * * * 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. * **************************************************************** ALXRCONC CSECT ALXRCONC AMODE 31 ALXRCONC 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 STM R14,R12,12(R13) LR R7,R1 SAVE THE PARAMETER ADDRESS LR R12,R15 SET UP BASE REGISTER ADDRESS. USING ALXRCONC,R12 L R3,16(R7) ADDR ARGUMENTS PASSED SLR R5,R5 CLEAR TO MAINTAIN COUNT OF DSNS LOOP_COUNT EQU * CLC 0(8,R3),FFFLAG ARE WE AT THE END ? BE DONE_COUNT YES, THEN STOP COUNTING ICM R15,15,4(R3) GET THE LENGTH OF ARG TO VER NOT 0 BZ NOINCR_COUNT 0 ? THEN GO TO NEXT ARG LA R5,1(R5) INCR COUNT NOINCR_COUNT EQU * LA R3,8(R3) ADDR NEXT ARGUMENT B LOOP_COUNT AND KEEP LOOPING ALONG DONE_COUNT EQU * BCTR R5,0 DECREMENT 1 FOR DDNAME VALUE LR R4,R5 SAVE TO MULTIPLY MH R4,HW44 MULTIPLY BY DSNAME LENGTH LA R3,STORAGE_SIZE GET THE LENGTH OF STORAGE AR R3,R4 ADD THE TWO GETMAIN RC,LV=(3) LTR R15,R15 VERIFY OKAY BZ GOOD_STORAGE YES, THEN GO AROUND LA R15,NO_STORAGE LOAD RETURN CODE B RETURN2 AND EXIT WITHOUT CEREMONY GOOD_STORAGE EQU * ST R1,8(R13) SAVE STORAGE LOC IN SAVEREA ST R13,4(R1) AND THEIR SAVEAREA IN OURS LR R13,R1 RE-ADDRESS SAVE AREA USING STORAGE,R13 XC SAVEAREA+8(CLEARSTOR),SAVEAREA+8 CLEAR STORAGE ST R3,GETMAIN_LENGTH SAVE THE STORAGE LENGTH *************************************************************** * NEXT SECTION INITIALIZE THE DYNAMIC ALLOCATION STORAGE * *************************************************************** LA R14,S99PARM LOAD UP STORAGE LOCATION LA R15,LENGTH_DYNAMIC GET THE LENGTH SET FOR MVCL LR R9,R15 AND HIS PARTNER LA R8,DYNAMIC_ALLOCATION POINT TO VARIABLE SETS MVCL R14,R8 MOVE THEM IN * CHANGED MVC TO PRIOR MVCL BECAUSE MOVE EXCEEDED 256 BYTES * MVC S99PARM(LENGTH_DYNAMIC),DYNAMIC_ALLOCATION * * NEXT SECTION INITIALIZES THE VARIOUS TEXT UNIT ADDR POINTERS * THAT WERE GETMAINED AND DID NOT CONTAIN THE VALID ADDRESSES YET LA R15,S99AREA ADDR SVC99 PARAMETER AREAS STCM R15,7,S99PARM+1 SAVE IT IN THE GETMAINED REQ BLK LA R15,ALTUPTR1 LOAD ADDR ALLOC UNIT POINTERS ST R15,POINTER STORE IT TO INITIALIZE LA R15,ALDSTU GET ADDR OF DSNAME ALLOC UNIT ST R15,ALTUPTR1 SET IT IN THE POINTERS ST R15,ALTUPTRC AND IN THE ALLOC CONCAT POINTER LA R15,ALDDTU GET THE DDNAME ALLOC UNIT ADDR ST R15,ALTUPTR1+4 AND INIT THE POINTER ADDR. LA R15,ALDRTU GET DDNAME RETURNED ADDR ST R15,ALTUPTRC+4 AND INIT THE ALLOC CONCAT POINTER LA R15,ALDDSP GET DISP ADDR STCM R15,7,ALTUPTR1+9 SAVE IT THE ALLOC POINTER STCM R15,7,ALTUPTRC+9 AND IN THE ALLOC CONCAT POINTER LA R15,CONCATD ADDR THE CONCAT TEXT UNITS ST R15,CONPTR INIT FIRST POINTER LA R15,CONCATP GET SECOND CONCAT TEXT UNIT STCM R15,7,CONPTR+5 AND INIT THE SECOND POINTER LA R15,INRRTU ADDR THE REL REC INFO TEXT UNIT ST R15,INTUPTR SAVE IT LA R15,RTDSTU ADDR THE DNAME INFO TEXT UNIT ST R15,INTUPTR+4 AND INIT 2ND POINTER LA R15,RTDDTU ADDR DDNAME INFO TEXT UNIT ST R15,INTUPTR+8 INIT 3RD POINTER LA R15,RTRRTU ADDR STATUS INFO TEXT UNIT STCM R15,7,INTUPTR+13 SAVE IT LA R15,UALDDTU ADDR UNALLOC DD TEXT UNIT ST R15,UALTUPTR INIT ADDR POINTER LA R15,UALUNTU RESET UNALLOC TEXT UNIT ST R15,UALTUPTR+4 YOU SHOULD KNOW BY NOW LA R15,UALDPTU LAST, THE DISP UNALLOC UNIT STCM R15,7,UALTUPTR+9 SAVED ****************************************************************** STH R5,DSNAME_COUNT AND SAVE THE COUNT MVI FLAG,X'00' MAKE SURE IT IS ZERO ****************************************************************** * WITH ALL THE STORAGE ACQUIRED AND PROPERLY INITIALIZED WE CAN * * GO BACK AND PROCESS THE DDNAME AND DSNAMES PASSED AS ARGUMENTS * ****************************************************************** L R11,16(R7) LET'S GET OUR ARGUMENT CLC 0(8,R11),FFFLAG IS THERE ANY ARGUMENT BE BAD_FUNCTION NO, THEN DO DEFAULT ICM R3,15,4(R11) GET THE LENGTH OF ARGUMENT BZ BAD_FUNCTION IF NULL/ZERO THEN DO DEFAULT CH R3,HW8 VERIFY IT'S NOT TOO LONG BH BAD_FUNCTION NO, THEN CONTINUE MVC DDNAME(8),BLANKS BLANK OUT THE MEMBER NAME BCTR R3,0 DECREMENT FOR EXECUTE MOVE L R10,0(R11) AND ADDRESS THE ARGUMENT EX R3,MOVEDDN MVC DDNAME(0),0(R10) MVC CONDDN1(8),DDNAME MOVE IN THE DDNAME FOR CONCAT **************************************************************** * HERE IS WHERE WE WILL MOVE THE DSNAMES FROM THE ARGUMENT * * LIST INTO STORAGE. * **************************************************************** LA R3,DSNAME_TABLE BEGINNING OF TABLE LR R14,R3 SET FOR BLANKING THE BLOCK LR R15,R4 GET THE LENGTH IN R15 SLR R9,R9 CLEAR REG 9 FOR INSERT ICM R9,8,BLANKS MOVE IN A BLANK MVCL R14,R8 BLANK OUT THE STORAGE LA R11,8(R11) INCREMENT PAST THE DDNAME LH R2,DSNAME_COUNT RELOAD THE COUNT LOOP_MOVE EQU * CLC 0(8,R11),FFFLAG ARE WE AT THE END BE DONE_MOVE YES, THEN GET OUT ICM R15,15,4(R11) LENGTH OF DSNAME IN R15 BZ NOMOVE_DSNAME ZERO, THEN NEXT ONE L R8,0(R11) GET THE ADDRESS IN R8 BCTR R15,0 DECREMENT FOR EX MOVE EX R15,TRTBLANK TRT 0(0,R8),BLANKTBL BNZ BAD_CONTINUATION IF BLANKS THEN ERROR EX R15,MOVE_DSNAME MVC 0(0,R3),0(R8) LA R3,44(R3) INCREMENT STORAGE NOMOVE_DSNAME EQU * LA R11,8(R11) BCT R2,LOOP_MOVE DONE_MOVE EQU * LH R14,HW44 LOAD BXLE INCREMENT LR R15,R3 LOAD LAST DSN ENTRY IN R15 LA R3,DSNAME_TABLE RELOAD TO BEGINNING LH R2,DSNAME_COUNT RELOAD THE COUNT CH R2,HW1 SEE IF JUST ONE ENTRY BE DDNAME_CHECK YES, THEN DO NOT COMPARE BCTR R2,0 DROP ONE FOR LOOPING **************************************************************** * THIS NEXT SECTION WILL LOOP THROUGH THE DSNAMES STORED AND * * MAKE SURE THAT THERE ARE NO DUPLICATES. IF DUPLICATE, THEN * * FLAG WITH A X'FF' IN COLUMN 1. * **************************************************************** OUTER_DSNLOOP EQU * LA R1,44(R3) INCREMENT TO NEXT INNER_DSNLOOP EQU * CLC 0(44,R1),0(R3) ARE THEY EQUAL BNE JUSTLOOP NO, THEN HIT THE LOOP MVI 0(R1),X'FF' JUST FLAG IT AS DUPLICATE JUSTLOOP BXLE R1,R14,INNER_DSNLOOP LA R3,44(R3) INCREMENT TO NEXT BCT R2,OUTER_DSNLOOP AND LOOP THROUGH **************************************************************** * CHECK TO SEE IF THE DDNAME IS ALREADY ALLOCATED. YES, THEN * * CONCATENATE EVERYONE. NO, THEN ALLOCATE FIRST AND CONCAT REST* **************************************************************** DDNAME_CHECK EQU * LA R3,DSNAME_TABLE REFERENCE THE BEGINNING LH R4,DSNAME_COUNT AND RELOAD THE COUNT L R8,16 ADDR. CVT L R8,0(R8) ADDR. TCB L R8,4(R8) ADDR. ACTIVE TCB L R8,12(R8) ADDR. TIOT LA R8,24(R8) ADDR. FIRST DDNAME SLR R9,R9 CLEAR R9 LOOPDDN CLC 4(8,R8),DDNAME IE THE DDNAME ALREADY ALLOCATED BNE INCRDDN YES, THEN DO CONCATENATION ST R8,TIOT_DDNAME SAVE THIS FOR COMPARING DSN * B DO_CONCATENATE YES, THEN DO CONCATENATION B DO_COMPARES AND COMPARE THE DSNAMES SET INCRDDN IC R9,0(R8) GET LENGTH INCREMENT LA R8,0(R9,R8) POINT R3 TO NEW DDNAME CLI 0(R8),X'00' IS IT A DDNAME FIELD BNE LOOPDDN YES, THEN PROCESS NEXT ONE B ALLOC_FIRST GO AND ALLOCATE THE FIRST ONE DO_COMPARES EQU * **************************************************************** * HERE IS WHERE WE WILL USE SVC99 TO READ ALL OF THE DDNAMES * * AND THEIR CORRESPONDING DATASET NAMES. * **************************************************************** LA R5,S99AREA ADDRESS SVC99 PARAMETER FIELDS USING S99RB,R5 MVI S99VERB,S99VRBIN INDICATE INFORMATION TO BE GOTTEN LA R9,1 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 DYNALL_ERROR NOT ZERO THEN ISSUE ERROR MSG LA R9,1(R9) INCR RELATIVE RECORD COUNT STH R9,INRRNUM SAVE FOR NEXT SVC99 INVOCATION TM FLAG,FOUND_DDN HAVE WE FOUND THE DDNAME YET BZ COMPARE_DDNAME YES, THEN COMPARE DDNAMES CLI RTDDN,C' ' ARE WE FINISHED, NOT CONCAT ? BNE RESET_CONCAT YES, THEN CONTINUE PROCESSING B CHECK_DSNAME NO, THEN COMPARE DSNAMES COMPARE_DDNAME EQU * CLC RTDDN(8),DDNAME SEE IF OUR DDNAME BE SET_FLAGDDN GET THE DDNAME RETURNED TM RTRRNUM,X'80' WAS THAT THE LAST ENTRY BZ LOOP_SVC99 NO, THEN CONITNUE READING LIST MVC STATUS_AREA(50),ERROR_DYNINFO LA R8,50 B SETRPLY SHOULD NEVER FALL THRU HERE SET_FLAGDDN EQU * OI FLAG,FOUND_DDN FLAG TO SAY WE FOUND IT CHECK_DSNAME EQU * LA R3,DSNAME_TABLE RELOAD TO BEGINNING LH R2,DSNAME_COUNT RELOAD THE COUNT LOOP_COMP_DSN EQU * CLC RTDSN(44),0(R3) COMPARE THE DSNAMES BE FLAG_DSNAME LA R3,44(R3) BCT R2,LOOP_COMP_DSN B CHECK_END FLAG_DSNAME EQU * MVI 0(R3),X'FF' FLAG AS IGNORE CHECK_END EQU * TM RTRRNUM,X'80' WAS THAT THE LAST BZ LOOP_SVC99 NO, THEN CONITNUE READING LIST RESET_CONCAT EQU * LA R3,DSNAME_TABLE RELOAD TO BEGINNING B DO_CONCATENATE YES, THEN CONTINUE PROCESSING * * **************************************************************** **************************************************************** **************************************************************** * IF THE LOGIC ABOVE FALLS THROUGH TO HERE, THEN ALLOCATE AS * * THE FIRST IN THE SERIES. * **************************************************************** ALLOC_FIRST EQU * LA R5,S99AREA ADDRESS SVC99 PARAMETER FIELDS USING S99RB,R5 MVC ALDSN(44),0(R3) MOVE IN THE DSNAME MVI 0(R3),X'FF' AND FLAG AS DONE LA R3,44(R3) INCREMENT BCTR R4,0 AND DECREMENT MVC ALDDN(8),DDNAME MOVE IN THE DDNAME MVI S99VERB,S99VRBAL INDICATE ALLOCATE VERB * LA R1,ALTUPTR1 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 ****+++*** **************************************************************** * ALLOCATE THE DATASET TO A TEMPORARY DDNAME AND THEN * * CONCATENATE IT. * **************************************************************** DO_CONCATENATE EQU * LTR R4,R4 ANY REMAINING TO DO ? BZ SETRPLY_LENGTH LA R5,S99AREA ADDRESS SVC99 PARAMETER FIELDS USING S99RB,R5 ************************************ * CHECK FOR DSN PRESENT * ************************************ COMPARE_DSNAME EQU * CLI 0(R3),X'FF' WAS THIS FLAGGED AS DUPLICATE BE INCR_DSNAME YES, THEN GO TO NEXT * MVC ALDSN(44),0(R3) MOVE IN THE DSNAME MVI S99VERB,S99VRBAL INDICATE ALLOCATE VERB * LA R1,ALTUPTRC 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 ****+++*** **************************************************************** * CHECK TO SEE IF THE DDNAME IS ALREADY ALLOCATED. YES, THEN * * CONCATENATE EVERYONE. NO, THEN ALLOCATE FIRST AND CONCAT REST* **************************************************************** GOOD_ALLOC EQU * CONCAT_FILE EQU * LA R1,CONPTR ADDR OF ALLOCATION TEXT UNIT PTRS MVC CONDDN2(8),ALDDNR MOVE IN THE RETURNED DDNAME 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 BZ INCR_DSNAME GOOD, THEN CONTINUE MVC STATUS_AREA(41),ERROR_DYNCONC B DYNALL_ERROR2 ISSUE ERROR MESSAGE ****+++*** INCR_DSNAME EQU * LA R3,44(R3) BCT R4,COMPARE_DSNAME LOOP THROUGH AND ALLOCATE SPACE 2 SETRPLY_LENGTH EQU * LA R8,2 MVC STATUS_AREA(2),OKAY MOVE IN OKAY **************************************** 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),STATUS_AREA FREESTOR EQU * LR R1,R13 L R0,GETMAIN_LENGTH L R13,4(R13) SO WE CAN GET OUT OF HERE FREEMAIN RC,A=(1),LV=(0) RETURN1 SLR R15,R15 RETURN2 L R14,12(R13) LM R0,R12,20(R13) BR R14 BAD_FUNCTION EQU * MVC STATUS_AREA(29),ERROR_FUNCTION LA R8,29 B SETRPLY BAD_CONTINUATION EQU * MVC STATUS_AREA(47),ERROR_CONTINUATION LA R8,47 B SETRPLY DYNALL_ERROR EQU * * DC H'00' * RESET LENGTH FROM 55 TO 41 BECAUSE INFO CODE LOOKED WEIRD MVC STATUS_AREA(41),ERROR_DYNALLOC DYNALL_ERROR2 EQU * LA R8,41 CVD R15,DOUBLE_WORD LETS MAKE IT PRINTABLE UNPK STATUS_AREA+22(3),DOUBLE_WORD+6(2) OI STATUS_AREA+24,X'F0' AND ONE MORE LA UNPK STATUS_AREA+36(5),S99ERROR(3) 1 MORE THAN FIELD SIZE MVI STATUS_AREA+40,X'40' BLANK OUT GARBAGE TR STATUS_AREA+36(4),TRTBL-240 MAKE HEX PRINTABLE TOO * UNPK STATUS_AREA+50(5),S99INFO(3) SAME WITH INFO * MVI STATUS_AREA+54,X'40' GET A BLANK IN THERE * TR STATUS_AREA+50(4),TRTBL-240 MAKE HEX PRINTABLE TOO CLC STATUS_AREA(6),ERROR_DYNCONC WAS THIS CONCAT BNE SETRPLY NO, THEN JUST GET OUT FREEIT MVC UALDDNAM(8),CONDDN2 MOVE IN THE TEMP THAT FAILED 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 B SETRPLY EJECT MOVEDDN MVC DDNAME(0),0(R10) MOVE_DSNAME MVC 0(0,R3),0(R8) MOVERPLY MVC EVALBLOCK_EVDATA(0),STATUS_AREA TRTBLANK TRT 0(0,R8),BLANKTBL HW1 DC H'1' 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' ****** BLANKS DC CL8' ' OKAY DC CL2'OK' ERROR_FUNCTION DC CL29'ERROR IN SPECIFYING FUNCTION ' ERROR_CONTINUATION DC CL47'FUNCTION ERROR; FOR CONTINUATION USE TWO X COMMAS' ERROR_DYNALLOC DC CL55'ALLOCATE FAILED; RC - XXX, REASON - XXXXX, IX NFO - XXXXX' ERROR_DYNCONC DC CL55'CONCATENATE ERR; RC - XXX, REASON - XXXXX, IX NFO - XXXXX' ERROR_DYNINFO DC CL50'DYNAMIC ALLOCATION INFORMATION PROBLEM WITH X DDNAME' * HERE ARE THE SVC 99 PARAMETER VALUES DS 0F ******************************************************************** * DO NOT INSERT ANYTHING IN THIS STORAGE, BECAUSE IT WILL BE MOVED * * TO RESOLVE REENTRANCY. * ******************************************************************** DYNAMIC_ALLOCATION EQU * NR_S99PARM DC X'80',AL3(0) ADDRESS OF SVC 99 REQUEST BLOCK NR_S99AREA DC AL1(S99RBEND-S99RB) LENGTH OF REQUEST BLOCK NR_VERBCDE DC X'00' VERB CODE DC XL6'00' NR_POINTER DC A(0) POINTER TO LIST OF TEXT UNIT PTRS DC XL8'00' SPACE 1 NR_ALTUPTR1 DC A(0) ADDR OF DSNAME TEXT UNIT DC A(0) ADDR OF DDNAME TEXT UNIT DC X'80',AL3(0) ADDR OF DISP TEXT UNIT NR_ALTUPTRC DC A(0) ADDR OF DSNAME TEXT UNIT DC A(0) ADDR OF DDNAME TEXT UNIT DC X'80',AL3(0) ADDR OF DISP TEXT UNIT SPACE 1 NR_ALDSTU DC X'0002' ALLOCATION BY DSNAME DC X'0001' ONE PARAMETER NR_ALDSNLNG DC X'002C' LENGTH OF PARAMETER NR_ALDSN DC CL44' ' DS 0H NR_ALDDTU DC X'0001' DDNAME DC X'0001' ONE PARAMETER DC X'0008' LENGTH OF PARAMETER NR_ALDDN DC CL8' ' AREA FOR DDNAME DS 0H NR_ALDRTU DC X'0055' DDNAME DC X'0001' ONE PARAMETER DC X'0008' LENGTH OF PARAMETER NR_ALDDNR DC CL8' ' AREA FOR DDNAME DS 0H NR_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 *********** NR_CONPTR DC A(0) DC X'80',AL3(0) NR_CONCATD DC X'0001' CONCATENATION UNIT DC X'0002' NR_CONDDL1 DC X'0008' NR_CONDDN1 DC CL8' ' NR_CONDDL2 DC X'0008' NR_CONDDN2 DC CL8' ' NR_CONCATP DC X'0004' PERMANENTLY CONCATENATED UNIT DC X'0000' *********** NR_INTUPTR DC A(0) ADDR OF RELATIVE RECORD REQUEST DC A(0) ADDR OF DSNAME RETURN DC A(0) ADDR OF DDNAME RETURN DC X'80',AL3(0) ADDR OF LAST RELATIVE RECD RETURN SPACE 1 NR_RTDSTU DC X'0005' ALLOCATION BY DSNAME DC X'0001' ONE PARAMETER NR_RTDSLNG DC X'002C' LENGTH OF PARAMETER NR_RTDSN DC CL44' ' DS 0H NR_RTDDTU DC X'0004' DDNAME DC X'0001' ONE PARAMETER NR_RTDDLNG DC X'0008' LENGTH OF PARAMETER NR_RTDDN DC CL8' ' AREA FOR DDNAME DS 0H NR_INRRTU DC X'000F' RELATIVE RECORD DC X'0001' ONE PARAMETER DC X'0002' LENGTH OF PARAMETER NR_INRRNUM DC X'0001' RELATIVE RECORD ONE DS 0H NR_RTRRTU DC X'000D' DC X'0001' DC X'0001' NR_RTRRNUM DC X'00' *********** NR_UALTUPTR DC A(0) ADDR OF UNALLOC DDNAME TEXT UNIT DC A(0) ADDR OF UNALLOC PERM TEXT UNIT DC X'80',AL3(0) ADDR OF UNALLOC DISP TEXT UNIT SPACE 1 NR_UALDDTU DC X'0001' UNALLOCATION BY DDNAME DC X'0001' ONE PARAMETER DC X'0008' LENGTH OF PARAMETER NR_UALDDNAM DC CL8' ' DDNAME TO BE UNALLOCATED DS 0H NR_UALUNTU DC X'0007' RESET EVEN IF PERMANENT ALLOC DC X'0000' ZERO PARM NR_UALDPTU DC X'0005' OVERRIDE DISPOSITION DC X'0001' ONE PARAMETER DC X'0001' LENGTH OF PARAMETER NR_UDISP DC X'08' DISPOSITION OF KEEP LENGTH_DYNAMIC EQU *-DYNAMIC_ALLOCATION ****************************************************************** LTORG DS 0F TRTBL DC C'0123456789ABCDEF' BLANKTBL DC 256X'00' ORG BLANKTBL+C' ' DC X'FF' ORG STORAGE DSECT SAVEAREA DS 18F DOUBLE_WORD DS D GETMAIN_LENGTH DS F TIOT_DDNAME DS F DDNAME DS CL8 STATUS_AREA DS CL55 FLAG DS X DSNAME_COUNT DS H CLEARSTOR EQU *-SAVEAREA-8 DS 0F S99PARM DS X'80',AL3(S99AREA) ADDRESS OF SVC 99 REQUEST BLOCK S99AREA DS AL1(S99RBEND-S99RB) LENGTH OF REQUEST BLOCK VERBCDE DS X'00' VERB CODE DS XL6'00' POINTER DS A(ALTUPTR1) POINTER TO LIST OF TEXT UNIT PTRS DS XL8'00' SPACE 1 ALTUPTR1 DS A(ALDSTU) ADDR OF DSNAME TEXT UNIT DS A(ALDDTU) ADDR OF DDNAME TEXT UNIT DS X'80',AL3(ALDDSP) ADDR OF DISP TEXT UNIT ALTUPTRC DS A(ALDSTU) ADDR OF DSNAME TEXT UNIT DS A(ALDRTU) ADDR OF DDNAME TEXT UNIT DS X'80',AL3(ALDDSP) ADDR OF DISP TEXT UNIT SPACE 1 ALDSTU DS X'0002' ALLOCATION BY DSNAME DS X'0001' ONE PARAMETER ALDSNLNG DS X'002C' LENGTH OF PARAMETER ALDSN DS CL44' ' DS 0H ALDDTU DS X'0001' DDNAME DS X'0001' ONE PARAMETER DS X'0008' LENGTH OF PARAMETER ALDDN DS CL8' ' AREA FOR DDNAME DS 0H ALDRTU DS X'0055' DDNAME DS X'0001' ONE PARAMETER DS X'0008' LENGTH OF PARAMETER ALDDNR DS CL8' ' AREA FOR DDNAME DS 0H ALDDSP DS X'0004' OVERRIDE DISPOSITION DS X'0001' ONE PARAMETER DS X'0001' LENGTH OF PARAMETER DS X'08' DISPOSITION OF SHR DS 0H *********** CONPTR DS A(CONCATD) DS X'80',AL3(CONCATP) CONCATD DS X'0001' CONCATENATION UNIT DS X'0002' CONDDL1 DS X'0008' CONDDN1 DS CL8' ' CONDDL2 DS X'0008' CONDDN2 DS CL8' ' CONCATP DS X'0004' PERMANENTLY CONCATENATED UNIT DS X'0000' *********** INTUPTR DS A(INRRTU) ADDR OF RELATIVE RECORD REQUEST DS A(RTDSTU) ADDR OF DSNAME RETURN DS A(RTDDTU) ADDR OF DDNAME RETURN DS X'80',AL3(RTRRTU) ADDR OF LAST RELATIVE RECD RETURN SPACE 1 RTDSTU DS X'0005' ALLOCATION BY DSNAME DS X'0001' ONE PARAMETER RTDSLNG DS X'002C' LENGTH OF PARAMETER RTDSN DS CL44' ' DS 0H RTDDTU DS X'0004' DDNAME DS X'0001' ONE PARAMETER RTDDLNG DS X'0008' LENGTH OF PARAMETER RTDDN DS CL8' ' AREA FOR DDNAME DS 0H INRRTU DS X'000F' RELATIVE RECORD DS X'0001' ONE PARAMETER DS X'0002' LENGTH OF PARAMETER INRRNUM DS X'0001' RELATIVE RECORD ONE DS 0H RTRRTU DS X'000D' DS X'0001' DS X'0001' RTRRNUM DS X'00' *********** UALTUPTR DS A(UALDDTU) ADDR OF UNALLOC DDNAME TEXT UNIT DS A(UALUNTU) ADDR OF UNALLOC PERM TEXT UNIT DS X'80',AL3(UALDPTU) ADDR OF UNALLOC DISP TEXT UNIT SPACE 1 UALDDTU DS X'0001' UNALLOCATION BY DDNAME DS X'0001' ONE PARAMETER DS X'0008' LENGTH OF PARAMETER UALDDNAM DS CL8' ' DDNAME TO BE UNALLOCATED DS 0H UALUNTU DS X'0007' RESET EVEN IF PERMANENT ALLOC DS X'0000' ZERO PARM UALDPTU DS X'0005' OVERRIDE DISPOSITION DS X'0001' ONE PARAMETER DS X'0001' LENGTH OF PARAMETER UDISP DS X'08' DISPOSITION OF KEEP ************** END OF DYNAMIC ALLOCATION STORAGE DSNAME_TABLE DS 0H ** STORAGE_SIZE EQU *-SAVEAREA IRXEVALB IEFZB4D0 IEFZB4D2 ** ** ** (C) COPYRIGHT 1999, SSC, INC. ** ** SSC, INC. ** 13530 WILT STORE RD. ** LEESBURG, VA 20176 ** (703) 777-2771 FAX (703) 777-6839 ** END