*TITLEUSDCC -- DYNAMIC CONCATENATION ROUTINE 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR RALPH MCMILLAN 00000200 *A DESIGNER RALPH MCMILLAN 00000300 *A LANGUAGE IBM ASSEMBLER 00000400 *A SYSTEM IBM 00000500 *A WRITTEN 4-29-87 00000600 * REVISED 08-09-90 ESN. INCREASE MAX NUMBER OF LIBS TO 25. 00000700 *A 00000800 *A 00000900 *A CALL USDCC (NUMDD, DDNMS, ERR, ERIN) 00001000 *A 00001100 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00001200 *A 00001300 *A IN NUMDD I4 NUMBER OF DDNAMES IN DDNMS ARRAY. 00001400 *A (NOT GREATER THAN 25). 00001500 *A 00001600 *A IN DDNMS C8 AN 8-BYTE CHARACTER ARRAY OF DDNAMES TO 00001700 *A CONCATENATED TOGETHER. 00001800 *A 00001900 *A OUT ERR I4 ERROR CODE. 00002000 *A 1 = OK. 00002100 *A 2 <---4 ) DYNAMIC CONCATENATION FAILED. 00002200 *A 3 <---8 ) RETURN CODE FROM SVC 99. 00002300 *A 4 <--12 ) SEE IBM MANUAL BELOW, P. 27. 00002400 *A 23 = NUMDD > 25. 00002500 *A 24 = A DDNAME IS BLANK. 00002600 *A 00002700 *A OUT ERIN I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). 00002800 *A BYTES 1 AND 2 = ERROR CODE, 00002900 *A BYTES 3 AND 4 = INFORMATION CODE. 00003000 *A IBM MANUAL GC28-0627-2, OS/VS2 MVS 00003100 *A SYSTEM PROGRAMMING LIBRARY: 00003200 *A JOB MANAGEMENT, PAGES 28 TO 31.0. 00003300 *A 00003400 *A 00003500 *A 00003600 *A THIS SUBROUTINE PERFORMS A DYNAMIC CONCATENATION ON THE DDNAMES 00003700 *A SPECIFIED IN THE ARRAY DDNMS. ALL DDNAMES MUST HAVE BEEN 00003800 *A PREVIOUSLY DYNAMICALLY ALLOCATED. THE CONCATENATED DDNAME WILL 00003900 *A BE THE FIRST ONE SUPPLIED IN DDNMS. 00004000 *A 00004100 *A THE MAXIMUM NUMBER OF DDNAMES ALLOWED IS 25. 00004200 SPACE 4 00004300 * REGISTER ASSIGNMENTS. 00004400 R0 EQU 0 00004500 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00004600 R2 EQU 2 00004700 R3 EQU 3 00004800 R4 EQU 4 00004900 R5 EQU 5 00005000 R6 EQU 6 00005100 R7 EQU 7 00005200 R8 EQU 8 00005300 R9 EQU 9 00005400 R10 EQU 10 00005500 R11 EQU 11 00005600 R12 EQU 12 BASE REGISTER. 00005700 R13 EQU 13 ADDRESS OF SAVE AREA. 00005800 R14 EQU 14 SUBROUTINE LINKAGE = RETURN ADDRESS. 00005900 R15 EQU 15 SUBROUTINE LINKAGE AND RETURN CODE. 00006000 * 00006100 EJECT 00006200 * PRELIMINARY SECTION. SAVE REGS., ESTABLISH BASE REGS. 00006300 USDCC CSECT 00006400 USING *,R15 00006500 B START 00006600 DC X'06',C'USDCC ' 00006700 START STM R14,R12,12(R13) 00006800 ST R13,SAVE+4 00006900 LA R12,SAVE 00007000 ST R12,8(,R13) 00007100 LR R13,R12 00007200 SPACE 00007300 LR R12,R15 BASE REGISTER FOR PROGRAM. 00007400 DROP R15 00007500 USING USDCC,R12 00007600 **************** ADDRESSING MODE SWITCH ****************** EXT 00007700 USDCC AMODE ANY EXT 00007800 USDCC RMODE 24 EXT 00007900 LA R4,UGNEXT EXT 00008000 LA R5,RETURNIT EXT 00008100 BSM R5,R4 EXT 00008200 RETADD DC F'0' EXT 00008300 UGNEXT DS 0H EXT 00008400 ST R5,RETADD EXT 00008500 SPACE 00008600 * 00008700 LM R2,R5,0(R1) LOAD PARAMETER ADDRESSES. 00008800 SPACE 00008900 * SET ERROR RETURNS TO OK. WILL BE CHANGED IF ERROR OCCURS. 00009000 LA R15,1 00009100 ST R15,0(,R4) ERIN MUST BE SET TO ZERO IF AN ERROR 00009200 SR R15,R15 OCCURS WHICH CAUSES EXIT FROM THE 00009300 ST R15,0(,R5) PROGRAM BEFORE SVC 99 IS ISSUED. 00009400 SPACE 00009500 L R2,0(R2) GET NUMBER OF DDNAMES 00009600 C R2,=F'25' 00009700 BNH A00 00009800 LA R15,23 NUMBER OF DDNAMES EXCEEDS ALLOWABLE. 00009900 B RETURN ERROR RETURN = 23. 00010000 SPACE 00010100 A00 STH R2,S99NUM01 STORE NUMBER OF DDNAMES FOR SVC99 00010200 SPACE 00010300 * 00010400 * NOW LOOP THROUGH INPUT DDNAMES AND MOVE TO SVC99 PARAMETER AREA 00010500 * 00010600 LA R6,S99LEN01 00010700 * 00010800 A01 MVC 2(8,R6),0(R3) 00010900 SPACE 00011000 * TO DETERMINE LENGTH, COUNT BACK FROM END OF DDNAME. 00011100 * LET D = ADDRESS OF DDNAME TO BE COUNTED, 00011200 * L = LENGTH OF DDNAME. 00011300 * 00011400 LA R10,9(,R6) R10 = D + 7 ---> END OF DDNAME. 00011500 L R14,FWM1 R14 = -1 00011600 LA R15,2(,R6) 00011700 BCTR R15,R0 R15 = D - 1 00011800 SPACE 00011900 A04 CLI 0(R10),C' ' 00012000 BNE A05 R10 = D + L - 1 00012100 BXH R10,R14,A04 R10 = R10 - 1. IF R10 > D - 1, REPEAT. 00012200 SPACE 00012300 LA R15,24 HERE R10 = D - 1, DDNAME IS ALL BLANKS. 00012400 B RETURN ERROR RETURN = 24. 00012500 SPACE 00012600 A05 SR R10,R15 R10 = D + L - 1 - (D - 1) = L 00012700 STH R10,0(,R6) PUT DDNAME LENGTH IN SVC 99 PARAMETERS. 00012800 LA R3,8(,R3) INCREMENT FOR NEXT INPUT DDNAME 00012900 LA R6,2(R10,R6) INCREMENT TO NEXT ADDRESS IN SVC99 PARMS. 00013000 BCT R2,A01 00013100 SPACE 3 00013200 * SECTION B. EXECUTE SVC 230 FOR ALLOCATION. 00013300 * RETURN ERROR AND INFORMATION CODES TO CALLER. 00013400 * 00013500 B00 EQU * 00013600 L R0,SVCROUT SVC 230 ROUTER CODE 00013700 LA R1,S99RBPTR R1 POINTS TO REQUEST BLOCK POINTER. 00013800 SVC 230 00013900 L R0,S99ERROR 00014000 ST R0,0(,R5) ERROR AND INFO. FROM SVC 99. 00014100 LTR R15,R15 00014200 BZ RETURN1 00014300 SRA R15,2 TRANSFORM CODES 4, 8, 12 00014400 LA R15,1(,R15) TO 2, 3, 4. 00014500 B RETURN 00014600 EJECT 00014700 SPACE 00014800 RETURN ST R15,0(,R4) RETURN ERROR CODE TO CALLER. 00014900 RETURN1 DS 0H 00015000 **************** ADDRESSING RETURN ****************** EXT 00015100 L R5,RETADD EXT 00015200 BSM 0,R5 EXT 00015300 RETURNIT DS 0H EXT 00015400 L R13,SAVE+4 00015500 LM R0,R12,20(R13) LEAVE RETURN CODE IN R15. 00015600 L R14,12(,R13) 00015700 MVI 12(R13),X'FF' 00015800 BR R14 00015900 EJECT 00016000 * REQUEST BLOCK AND PARAMETER TABLE FOR SVC 99. 00016100 * R1 POINTS TO S99RBPTR. 00016200 S99RBPTR DS 0F 00016300 DC X'80',AL3(S99RB) POINTER TO REQUEST BLOCK. 00016400 S99RB EQU * 00016500 S99RBLN DC X'14' 0 SVC 99 REQUEST BLOCK LENGTH = 20. 00016601 S99VERB DC X'03' 1 SVC 99 VERB, CONCATENATION. 00016700 S99FLAG1 DC X'0000' 2 SVC 99 FLAGS 1 (NONE NEEDED). 00016800 S99ERROR DC X'0000' 4 SVC 99 ERROR RETURN. 00016900 S99INFO DC X'0000' 6 SVC 99 INFORMATION RETURN. 00017000 S99TXTPP DC A(S99TUPL) 8 POINTS TO TEXT POINTERS. 00017100 S99RESV DC F'0' 12 RESERVED. 00017200 S99FLAG2 DC X'01000000' 16 SVC 99 FLAGS 2 (AUTHORIZED PROGRAMS). 00017300 S99TUPL EQU * 00017400 S99TUP01 DC X'80' END-OF-LIST MARKER. 00017500 DC AL3(S99TUN01) DDNAME 00017600 SPACE 00017700 S99TUN01 DS 0H 00017800 S99KEY01 DC X'0001' TEXT UNIT KEY FOR DDNAME. 00017900 S99NUM01 DC X'0001' NUMBER OF PARAMETERS = 1. 00018000 S99LEN01 DC X'0008' LENGTH OF PARAMETER = 1 TO 8. 00018100 S99PRM01 DC CL8' ' FIRST DDNAME. 00018200 DC 24CL10' ' SPACE FOR REMAINING 24 DDNAME PARAMETERS. 00018300 SPACE 00018400 FWM1 DC F'-1' 00018500 SAVE DC 18F'0' 00018600 DS 0F 00018700 SVCROUT DC H'0',C'01' 00018800 LTORG 00018900 END 00019000