V1L0 TITLE ' Sample TSO Command for ? TSO Journal' SPACE 10 *********************************************************************** * * * Title - DYNALLOC * * * * Function / Operation - DYNALLOC is a sample TSO command written * * to illustrate an article for TSO Journal * * * * Command Syntax - * * DYNALLOC data-set-name * * * * Status / Change Level - * * V1L0 - October 2003 * * * * Attributes - DYNALLOC is not reentrant, not refreshable and not * * reusable. It operates in problem key and problem state in TCB * * mode as a TSO command processor. * * * * Character Set - EBCDIC * * * *********************************************************************** EJECT IKJCPPL , SPACE 5 IKJPPL MYPPLSZ EQU *-PPL SPACE 5 IKJIOPL MYIOPLSZ EQU *-IOPL PUSH PRINT PRINT NOGEN CVT DSECT=YES IEFZB4D0 , IEFZB4D2 , POP PRINT EJECT * INITIAL ENTRY - PREPARE THE PPL AND IOPL TSO CONTROL BLOCK SPACE 1 DYNALLOC CSECT DEFINE PROGRAM CSECT SPACE 1 USING CPPL,R1 DEFINE CPPL ADDRESSABILITY USING *,R12 DEFINE PROGRAM ADDRESSABILITY USING IOPL,MYIOPL DEFINE IOPL ADDRESSABILITY USING PPL,MYPPL DEFINE PPL ADDRESSABILITY USING PDL,R10 DEFINE PDL ADDRESSABILITY SPACE 1 SAVE (14,12),,* SAVE CALLER'S REGISTERS LR R12,R15 COPY ENTRY POINT ADDRESS TO REG 12 LA R15,S LOAD ADDRESS OF A NEW SAVE AREA ST R15,8(,R13) ADD NEW SAVE AREA TO THE ST R13,4(,R15) SAVE AREA CHAIN LR R13,R15 ESTABLISH NEW SAVE AREA POINTER SPACE 1 L R0,CPPLCBUF LOAD ADDR OF THE COMMAND BUFFER ST R0,PPLCBUF SAVE IT SPACE 1 L R0,CPPLECT LOAD ADDR OF THE TSO ECT ST R0,PPLECT SAVE IT FOR PARSE ST R0,IOPLECT AND THE IOPL SPACE 1 L R0,CPPLUPT LOAD ADDR OF THE TSO UPT ST R0,PPLUPT SAVE IT FOR PARSE ST R0,IOPLUPT AND THE IOPL SPACE 1 LA R0,ECB LOAD ADDR OF AN ECB ST R0,PPLECB SAVE IT FOR PARSE ST R0,IOPLECB AND IOPL SPACE 1 L R0,=A(PCL) LOAD ADDR OF THE PCL ST R0,PPLPCL SAVE IT FOR PARSE SPACE 1 LA R0,ANSPTR LOAD ADDR OF THE PARSE ANSWER ADDR ST R0,PPLANS SAVE IT FOR PARSE SPACE 1 ST R1,DFCPPLP SAVE CPPL ADDRESS FOR "DAIRFAIL" SPACE 1 CALLTSSR EP=IKJPARS, CALL IKJPARS -> MF=(E,MYPPL) SPACE 1 * THIS IS THE "DO YOUR OWN THING" PART OF THE COMMAND. * USE DYNALLOC TO ALLOCATE A DATA SET, THEN RECALL IT TO UNALLOCATE * THE DATA SET. CALL AN ERROR MESSAGE GENERATOR IF EITHER ALLOCATION * FAILS. L R10,ANSPTR LOAD ADDR OF THE PDL LH R9,PDLDSN+4 LOAD LENGTH L R8,PDLDSN LOAD ADDRESS LA R14,ADSN LOAD ADDR OF ADSN LR R15,R9 COPY LENGTH TO REG 15 STCM R9,B'0011',ADSN-2 STORE LENGTH IN THE DSN TEXT UNIT MVCL R14,R8 COPY DSN TO TEXT UNIT SPACE LA R1,ARBPTR LOAD ADDR OF THE RB POINTER BAL R14,DODYN CALL DODYN ROUTINE LTR R15,R15 TEST RC FROM DYNALLOC BNZ EXIT EXIT IF ERROR SPACE 1 MVC UNDDN,ALDDN COPY ALLOCATED DDNAME TO UNDDN LA R0,URBPTR LOAD ADDR OF THE RB POINTER BAL R14,DODYN CALL DODYN ROUTINE LTR R15,R15 TEST RC FROM DYNALLOC BNZ EXIT BR IF ERROR SPACE 1 LA R1,TEXT LOAD START OF OUTPUT LINE MVC MSG(L'ALDDN),ALDDN COPY ALLOCATED DDNAME TO MESSAGE LA R14,MSG+L'ALDDN SET R14 = END OF DDN SR R14,R1 COMPUTE LENGTH OF THE OUTPUT LINE STH R14,0(,R1) STORE LENGTH IN THE RDW OF THE -> OUTPUT LINE SPACE 1 PUTLINE MF=(E,MYIOPL), WRITE THE GENERATED OUTPUT LINE -> PARM=PUTLPB SPACE 1 EXIT L R13,4(,R13) LOAD ADDR OF THE CALLER'S SAVE AREA RETURN (14,12),T,RC=0 RESTORE REGS & RETURN TO CALLER SPACE 1 CNOP 0,8 DODYN SAVE (14,12) SAVE REGS LA R14,DOSAVE LOAD ADDR OF THE NEW SAVE AREA ST R14,8(,R13) ADD NEW SAVE AREA TO THE ST R13,4(,R14) SAVE AREA CHAIN LR R13,R14 ESTABLISH NEW SAVE AREA POINTER LR R2,R1 SAVE ADDRESS DYNALLOC , DO THE ALLOCATION LTR R15,R15 TEST RC BZ DODOEXIT BR IF OK ST R15,DYNRC SAVE DYNALLOC RC L R0,0(,R2) LOAD ADDR OF THE FAILING RB N R0,=A(X'7FFFFFFF') REMOVE THE HIGH ORDER BIT ST R0,DFS99RBP SAVE ERROR RB FOR 'DAIRFAIL' LINK SF=(E,CALLDF), CALL 'DAIRFAIL' -> MF=(E,DFPARMS) L R15,DYNRC RESTORE DAIR RETURN CODE DODOEXIT L R13,4(,R13) LOAD ADDR OF THE CALLER'S SAVE AREA RETURN (14,12),T,RC=(15) RESTORE REGS & RETURN TO CALLER EJECT S DC 9D'0' SAVE AREA DOSAVE DC 9D'0' SAVE AREA SPACE 1 * THE PPL IS DOUBLE WORD ALIGNED BECAUSE THE SAVE AREA IS DOUBLE * WORD ALIGNED. THE 0D'0' AT THE END OF THE DC FORCES THE NEXT * DATA AREA TO BE DOUBLE WORD ALIGNED. SPACE 1 MYPPL DC XL(MYPPLSZ)'0',0D'0' PPL SPACE 1 MYIOPL DC XL(MYIOPLSZ)'0',0D'0' IOPL SPACE 1 CALLDF LINK EP=IKJEFF18,SF=L SPACE 1 PUTLPB PUTLINE OUTPUT=(TEXT,TERM,SINGLE,DATA), PUTLINE PARAMETER -> MF=L BLOCK SPACE 1 * "DAIRFAIL" PARAMETER LIST. IF YOU ARE USING "DAIRFAIL" IN A * NON-TSO APPLICATION, CODE DFDSEC2=NO AND EXTRACT THE TWO POSSIBLE * MESSAGES FROM THE MESSAGE BUFFERS SPACE 1 IKJEFFDF DFDSECT=NO,DFDSEC2=YES * RETURN TO THE CSECT BECAUSE THE DFDSEC2 PARAMETER CAUSES THE * IKJEFFDF MACRO TO TERMINATE AFTER CREATING A DSECT DYNALLOC CSECT * OVERLAY DATA AREAS IN THE IKJEFFDF EXPANSION WITH APPROPROPRIATE * ADDRESS CONSTANTS ORG DFRCP DC A(DYNRC) ORG DFJEFF02 DC A(ZEROS) ORG DFIDP DC A(IDCODE) ORG , SPACE 1 ECB DC F'0' AN ECB ANSPTR DC A(*-*) ADDRESS OF PPL ZEROS DC A(*-*) ADDRESS OF IKJEFF02 OR BINARY 0S DYNRC DC A(*-*) DYNALLOC MACRO RETURN CODE TEXT DC 2AL2(0) OUTPUT LINE RDW MSG DC CL256' ' MESSAGE FILL AREA DC 0D'0' FORCE BOUNDARY ALIGNMENT LTORG , DEFINE THE LITERAL POOL SPACE 1 * THE IKJEFFDF MACRO IS VERY UNCLEAR HOW THE BITS ARE DISTRIBUTED * WITHIN THE TWO BYTES IN IDCODE. THE TSO/E PROGRAMMING SERVICES * MANUAL IS VERY GOOD. THERE IS A CLEAR PATTERN YOU CAN GET FROM * THE TSO/E PROGRAMMING SERVICES MANUAL. IF YOU CAN REMEMBER THE * PATTERN YOU WILL NOT HAVE ANY TROUBLE. SPACE 1 * IF YOU ARE CALLING "DAIRFAIL" FROM A NON-TSO FUNCTION, YOU * NORMALLY SPECIFY DFDSEC2=NO IN THE IKJEFFDF MACRO, SET DFBUFP * TO POINT TO DFBUFS, SET DFBUFSW IN THE FIRST BYTE OF IDCODE, * AND EXTRACT THE MESSAGES FROM DFBUFS SPACE 1 IDCODE DC 0AL2(0),AL1(0,DFSVC99) SPACE 1 * DYNAMIC ALLOCATION PARAMETER LIST. IF CONSISTS OF 4 PARTS - * - THE REQUEST BLOCK POINTER * - THE REQUEST BLOCK * - THE TEXT UNIT POINTER LIST * - THE TEXT UNITS THAT TELL DYNAMIC ALLOCATION WHAT TO DO SPACE 1 * THE REQUEST BLOCK POINTER SPACE 1 ARBPTR DC A(X'80000000'+ARB) SPACE 1 * THE REQUEST BLOCK SPACE 1 ARB DC 0A(0),AL1(S99RBEND-S99RB,S99VRBAL,0,0) DC 2AL2(0) DC A(ATXTPP) DC 2A(0) SPACE 1 * THE TEXT UNIT POINTER LIST SPACE 1 ATXTPP DC A(ATXT01,ATXT02,ATXT03,X'80000000'+ATXT04) SPACE 1 * THE TEXT UNITS SPACE 1 ATXT01 DC AL2(DALDSNAM,1,L'ADSN) SPECIFY THE DATA SET NAME ADSN DC CL44'ZYS1.MACLIB' ATXT02 DC AL2(DALRTDDN,1,L'ALDDN) REQUEST DYNAMIC ALLOCATION TO ALDDN DC CL8' ' RETURN THE DDNAME IT ALLOCATED ATXT03 DC AL2(DALRTORG,1,2),AL2(0) REQUEST DYNAMIC ALLOCATION -> RETURN THE DSORG OF THE -> ALLOCATED DATA SET. THIS -> IS A GOOD WAY TO TELL -> ALLOCATION TO VERIFY THE -> SET EXISTS ON THE VOLUME ATXT04 DC AL2(DALSTATS,1,1),AL1(X'08') DISP=SHR SPACE 1 URBPTR DC A(X'80000000'+URB) SPACE 1 URB DC 0A(0),AL1(S99RBEND-S99RB,S99VRBUN,0,0) DC 2AL2(0) DC A(UTXTPP) DC 2A(0) SPACE 1 UTXTPP DC A(X'80000000'+UTXT01) SPACE 1 UTXT01 DC AL2(DUNDDNAM,1,L'UNDDN) UNDDN DC CL8' ' PCL IKJPARM DSECT=PDL PDLDSN IKJPOSIT DSNAME,PROMPT='DATA SET NAME' IKJENDP , SPACE 1 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 SPACE 1 END DYNALLOC