PRINT GEN TITLE 'ALC$DALO - PERFORM DYNAMIC ALLOCATION FUNCTIONS' *---------------------------------------------------------------------* * REMARKS: THIS PROGRAM WILL INQUIRY, ALLOCATE, DE-ALLOCATE DATASETS * VIA DYNAMIC ALLOCATION (SVC99) *---------------------------------------------------------------------* * REGISTER USAGE * R10 = ADDRESSIBILITY TO PARMS PASSED * R11 = BASE REGISTER * R12 = BASE REGISTER 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 R00 EQU 0 R01 EQU 1 R02 EQU 2 R03 EQU 3 R04 EQU 4 R05 EQU 5 R06 EQU 6 R07 EQU 7 R08 EQU 8 R09 EQU 9 EJECT ALC$DALO CSECT AMODE 31 RMODE ANY USING *,R11,R12 R11,R12=BASE REGISTERS STM R14,R12,12(R13) SAVE REGISTERS LR R11,R15 ADDRESSIBILITY LA R12,2048(0,R11) LA R12,2048(0,R12) LR R1,R13 SAVE SAVE AREA POINTER LA R13,SAVEAREA POINT TO MY SAVEAREA ST R13,8(0,R1) SET FORW CHAIN IN CALLERS SAREA ST R1,4(0,R13) SET BACK CHAIN IN MY SAVEAREA L R1,24(0,R1) REACQUIRE R1 AS IT CAME HERE L R10,0(R1) R10=ADDRESS OF PARMS USING DA$PRM,R10 B SVC99BEG DS 0F DC C'*' PGMID DC CL8'ALC$DALO' DC C'*' COMPDATE DC CL8'&SYSDATE' COMPTIME DC CL8'&SYSTIME' SAVEAREA DC 18F'0' SVC99END EQU * L R13,4(0,R13) POINT BACK TO CALLERS SAVEAREA LM R14,R12,12(R13) RESTORE REGISTERS XR R15,R15 CLEAR RETURN CODE BR R14 GOBACK TO MOMMA EJECT SVC99BEG EQU * XC DA$RET,DA$RET CLEAR SVC99 ERROR REASON CODE XC DA$INF,DA$INF CLEAR SVC99 INFO REASON CODE XC DA$R15,DA$R15 CLEAR SVC99 R15 VALUE CLI DA$FCN,C'I' INQUIRY FUNCTION? BE $INQUIRY YES, THEN DO IT CLI DA$FCN,C'A' ALLOCATE (DISP=SHR) FUNCTION? BE $ALLOC YES, THEN DO IT CLI DA$FCN,C'M' ALLOCATE (DISP=SHR) FUNCTION? BE $ALLOC YES, THEN DO IT CLI DA$FCN,C'D' DE-ALLOCATE FUNCTION? BE $DEALLOC YES, THEN DO IT CLI DA$FCN,C'C' CONCATENATE FUNCTION? BE $CONCAT YES, THEN DO IT MVC DA$RET,=H'-1' UNKNOWN FUNCTION B SVC99END EJECT *--------------------------------------------------------------------* * $INQUIRY = CHECK FOR THE EXISTANCE OF A PARTICULAR DDNAME * *--------------------------------------------------------------------* $INQUIRY EQU * MVC TUDDL,=X'0008' INITIALIZE LENGTH MVC TUDSNL,=X'002C' " " MVC TUDSOL,=X'0002' " " MVC TUDDNAME,DA$DD GET THE DDNAME TO LOOK AT MVC TUDSNAME(1),=C' ' CLEAR THE DATASET NAME MVC TUDSNAME+1(43),TUDSNAME CLEAR THE DATASET NAME LA R2,RBADDR POINT TO BEG OF REQ BLOCK PNTR USING S99RBP,R2 LA R3,RBWORK POINT TO REQ BLOCK WORK AREA USING S99RB,R3 ST R3,S99RBPTR SAVE ADDR OF REQ BLOCK OI S99RBPTR,S99RBPND INDICATE LAST POINTER XC S99RB(RBLEN),S99RB CLEAR REQ BLOCK WORK AREA MVI S99RBLN,RBLEN SET LENGTH OF REQ BLOCK MVI S99VERB,S99VRBIN SET VERB FOR INFO ONLY LA R4,TUPTRS POINT TO TEXT UNIT POINTER AREA USING S99TUPL,R4 ST R4,S99TXTPP SAVE ADDR OF TEXT UNIT POINTER LA R5,TUDD POINT TO 1ST TEXT UNIT ST R5,S99TUPTR SAVE THIS ADDR LA R4,S99TUPL+4 POINT TO NEXT TEXT UNIT POINTER LA R5,TUDSN POINT TO 2ND TEXT UNIT ST R5,S99TUPTR SAVE THIS ADDR LA R4,S99TUPL+4 POINT TO NEXT TEXT UNIT POINTER LA R5,TUDSO POINT TO 3RD TEXT UNIT ST R5,S99TUPTR SAVE THIS ADDR OI S99TUPTR,S99TUPLN INDICATE LAST TEXT POINTER LR R1,R2 POINT R1 TO REQUEST BLOCK DYNALLOC STH R15,DA$R15 SAVE R15 VALUE MVC DA$RET,S99ERROR GET ERROR REASON CODE MVC DA$INF,S99INFO GET INFORMATION REASON CODE DROP R2,R3,R4 MVC DA$DSNF,TUDSNAME MOVE IN DATASET NAME FOUND MVC DA$DSNFL,TUDSNL MOVE IN LENGTH B SVC99END EJECT *--------------------------------------------------------------------* * $ALLOC = ALLOCATE A DATASET AND DDNAME WITH A DISP OF * * (SHR,KEEP,KEEP) AND OPTIONALLY A MEMBER NAME IF REQUESTED * *--------------------------------------------------------------------* $ALLOC EQU * MVC ALDDX,DA$DD GET THE DDNAME TO ALLOCATE MVC ALDDLEN,DA$DDL GET THE LENGTH OF THE DDNAME MVC ALDSNX,DA$DSN GET THE DSN TO ALLOCATE MVC ALDSNLEN,DA$DSNL GET THE LENGTH OF THE DSN * LA R2,RBADDR POINT TO BEG OF REQ BLOCK PNTR USING S99RBP,R2 LA R3,RBWORK POINT TO REQ BLOCK WORK AREA USING S99RB,R3 ST R3,S99RBPTR SAVE ADDR OF REQ BLOCK OI S99RBPTR,S99RBPND INDICATE LAST POINTER XC S99RB(RBLEN),S99RB CLEAR REQ BLOCK WORK AREA MVI S99RBLN,RBLEN SET LENGTH OF REQ BLOCK MVI S99VERB,S99VRBAL SET VERB FOR ALLOCATION LA R4,TUPTRS POINT TO TEXT UNIT POINTER LIST USING S99TUPL,R4 ST R4,S99TXTPP SAVE ADDR TO TEXT UNIT PNTR LIST * POINT TO TEXT UNIT FOR DDNAME LA R5,ALDD GET DDNAME AREA ST R5,S99TUPTR SAVE THIS ADDR * POINT TO TEXT UNIT FOR DSNAME LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALDSN GET DSNAME AREA ST R5,S99TUPTR SAVE THIS ADDR CLI DA$BUFNO,X'00' DO WE ALLOCATION DCB=BUFNO=XX BNE $ALLOC08 NO--> CONTINUE MVC ALBUFNOL,DA$BUFNO GET NUMBER OF BUFFERS LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALBUFNO GET BUFNO NAME AREA ST R5,S99TUPTR SAVE THIS ADDR $ALLOC08 EQU * * POINT TO TEXT UNIT FOR MEMBER (IF NEEDED) CLI DA$FCN,C'M' ALLOCATE WITH MEMBER NAME? BNE $ALLOC09 NO--> CONTINUE MVC ALMEMX,DA$MEM GET THE MEMBER NAME TO ALLOCATE MVC ALMEMLEN,DA$MEML GET THE LENGTH OF THE MEMBER LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALMEM GET MEMBER NAME AREA ST R5,S99TUPTR SAVE THIS ADDR $ALLOC09 EQU * * POINT TO TEXT UNIT FOR DATASET STATUS MVC ALSTAX,DA$ALLOC GET ALLOCATION TYPE LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALSTA GET DATASET DISP FIELD ST R5,S99TUPTR SAVE THIS ADDR * POINT TO TEXT UNIT FOR DATASET NORMAL COMPLETION STATUS MVC ALNSTX,DA$NDISP GET GOOD COMP TYPE LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALNST GET NORM COMP STATUS FIELD ST R5,S99TUPTR SAVE THIS ADDR * POINT TO TEXT UNIT FOR DATASET CONDITIONAL COMPLETION STATUS MVC ALCSTX,DA$CDISP GET BAD COMP TYPE LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALCST GET COND COMP STATUS FIELD ST R5,S99TUPTR SAVE THIS ADDR * SEE IF WE ARE ALLOCATING THIS AS DISP=NEW CLI DA$ALLOC,X'04' DISP=NEW BNE $ALLOC89 NO----> CONTINUE * ALLOC IN CYLINDERS LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALCYL GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS * GET PRIMARY CYLINDER ALLOCATION MVC ALPRIMEX+1(2),DA$PCYL GET PRIMARY CYL ALLOCATION LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALPRIME GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS * GET SECONDARY CYLINDER ALLOCATION MVC ALSECNDX+1(2),DA$SCYL GET SECONDARY CYL ALLOCATION LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALSECND GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS * SET ,RLSE LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALRLSE GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS * GET UNIT= PARAMETER MVC ALUNITX,DA$UNIT GET UNIT MVC ALUNITL,DA$UNITL GET UNIT LENGTH LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALUNIT GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS * GET DCB=DSNAME TO CLONE DCB PARAMETERS MVC ALDCBDSX,DA$DCBDS GET DATASET NAME MVC ALDCBDSL,DA$DCBDL GET DATASET LENGTH LA R4,4(R4) GET NEXT SLOT FOR POINTER LA R5,ALDCBDS GET TEXT UNIT ST R5,S99TUPTR SAVE ADDRESS $ALLOC89 EQU * * INDICATE LAST POINTER HAS BEEN ENTERED OI S99TUPTR,S99TUPLN INDICATE LAST TEXT POINTER LR R1,R2 POINT R1 TO REQUEST BLOCK DYNALLOC * SET RETURN CODE FIELDS STH R15,DA$R15 SAVE R15 VALUE MVC DA$RET,S99ERROR GET ERROR REASON CODE MVC DA$INF,S99INFO GET INFORMATION REASON CODE DROP R2,R3,R4 B SVC99END EJECT *--------------------------------------------------------------------* * $DEALLOC = DEALLOCATE A DATASET * *--------------------------------------------------------------------* $DEALLOC EQU * B SVC99END *--------------------------------------------------------------------* * $CONCAT = CONCATENATE DATASETS TOGETHER * *--------------------------------------------------------------------* $CONCAT EQU * LA R2,RBADDR POINT TO BEG OF REQ BLOCK PNTR USING S99RBP,R2 LA R3,RBWORK POINT TO REQ BLOCK WORK AREA USING S99RB,R3 ST R3,S99RBPTR SAVE ADDR OF REQ BLOCK OI S99RBPTR,S99RBPND INDICATE LAST POINTER XC S99RB(RBLEN),S99RB CLEAR REQ BLOCK WORK AREA MVI S99RBLN,RBLEN SET LENGTH OF REQ BLOCK MVI S99VERB,S99VRBCC SET VERB FOR CONCATENATION LA R4,TUPTRS POINT TO TEXT UNIT POINTER LIST USING S99TUPL,R4 ST R4,S99TXTPP SAVE ADDR TO TEXT UNIT PNTR LIST * LA R5,DA$CC GET CONCAT AREA MVC DA$CC(2),CCCONCAT ST R5,S99TUPTR SAVE THIS ADDR OI S99TUPTR,S99TUPLN INDICATE LAST TEXT POINTER * LR R1,R2 POINT R1 TO REQUEST BLOCK DYNALLOC STH R15,DA$R15 SAVE R15 VALUE MVC DA$RET,S99ERROR GET ERROR REASON CODE MVC DA$INF,S99INFO GET INFORMATION REASON CODE DROP R2,R3,R4 MVC DA$DSNF,TUDSNAME MOVE IN DATASET NAME FOUND MVC DA$DSNFL,TUDSNL MOVE IN LENGTH B SVC99END LTORG EJECT DS 0F * WORK AREA FOR DYNAMIC ALLOCATION FACILITIES RBLEN EQU (S99RBEND-S99RB) LEN OF REQUEST BLOCK RBADDR DS F ADDR OF REQUEST BLOCK RBWORK DS XL20 REQ BLOCK WORK AREA TUPTRS DS 20F TEXT UNIT POINTERS *---------------------------------------------------------------------- * INFO USED TO REQUEST INFORMATION ABOUNT A PARTICULAR DATASET * DA$FCN = 'I ' *---------------------------------------------------------------------- TUDD EQU * DDNAME WORK AREA DC AL2(DINDDNAM) DDNAME INFO REQ INDICATOR DC XL2'0001' NUM OF ENTRIES TUDDL DC XL2'0008' LENGTH OF WORK AREA TUDDNAME DC CL8'????????' DDNAME * TUDSN EQU * DSNAME WORK AREA DC AL2(DINRTDSN) DSNAME INFO REQ INDICATOR DC XL2'0001' NUM OF ENTRIES TUDSNL DC XL2'002C' LENGTH OF WORK AREA TUDSNAME DC CL44' ' DATASET NAME * TUDSO EQU * DSORG WORK AREA DC AL2(DINRTORG) DSORG INFO REQ INDICATOR DC XL2'0001' NUM OF ENTRIES TUDSOL DC XL2'0002' LENGTH OF ENTRY WORK AREA TUDSORG DC CL2' ' DATASET ORGINAZATION *---------------------------------------------------------------------- * INFO USED TO REQUEST ALLOCATION OF A PARTICULAR DATASET * DA$FCN = 'A ' DISP=(SHR,KEEP,KEEP) *---------------------------------------------------------------------- ALDD EQU * DDNAME WORK AREA DC AL2(DALDDNAM) ALLOCATE DD INDICATOR DC XL2'0001' NUMBER OF ENTRIES ALDDLEN DC XL2'0008' LENGTH OF WORK AREA (INITIAL) ALDDX DC CL8' ' DDNAME TO ALLOCATE * ALDSN EQU * DSNAME WORK AREA DC AL2(DALDSNAM) ALLOCATE DSN INDICATOR DC XL2'0001' NUMBER OF ENTRIES ALDSNLEN DC XL2'002C' LENGTH OF WORK AREA (INITIAL) ALDSNX DC CL44' ' DATASET NAME TO ALLOCATE * ALMEM EQU * MEMBER NAME TO ALLOCATE DC AL2(DALMEMBR) ALLOCATE MEMBER INDICATOR DC XL2'0001' NUMBER OF ENTRIES ALMEMLEN DC XL2'0008' LENGTH OF WORK AREA (INITIAL) ALMEMX DC CL8' ' MEMBER NAME TO ALLOCATE * ALSTA EQU * DATASET STATUS DC AL2(DALSTATS) ALLOCATE DATASET STATUS DC XL2'0001' NUMBER OF ENTRIES ALSTALEN DC XL2'0001' LENGTH OF WORK AREA (INITIAL) ALSTAX DC XL1'08' DISP=(SHR,,) * X'01'=OLD * X'02'=MOD * X'04'=NEW * X'08'=SHR * ALNST EQU * DATASET NORMAL COMPLETION STATUS DC AL2(DALNDISP) ALLOCATE NORMAL COMP STATUS DC XL2'0001' NUMBER OF ENTRIES ALNSTLEN DC XL2'0001' LENGTH OF WORK AREA (INITIAL) ALNSTX DC XL1'08' DISP=(SHR,KEEP,) * X'01'=UNCATLG * X'02'=CATLG * X'04'=DELETE * X'08'=KEEP * EJECT * ALCST EQU * DATASET CONDITIONAL COMPLETION STATUS DC AL2(DALCDISP) ALLOCATE CONDITIONAL COMP STATUS DC XL2'0001' NUMBER OF ENTRIES ALCSTLEN DC XL2'0001' LENGTH OF WORK AREA (INITIAL) ALCSTX DC XL1'08' DISP=(SHR,KEEP,KEEP) * X'01'=UNCATLG * X'02'=CATLG * X'04'=DELETE * X'08'=KEEP ALCYL EQU * ALLOCATE IN CYLINDERS DC AL2(DALCYL) ALLOCATE CYLINDERS DC XL2'0000' NUMBER OF ENTRIES * ALPRIME EQU * PRIMARY ALLOC IN CYLINDERS DC AL2(DALPRIME) PRIMARY CYLINDER ALLOCATION DC XL2'0001' NUMBER OF ENTRIES ALPRIMEL DC XL2'0003' LENGTH OF WORK AREA (INITIAL) ALPRIMEX DC XL3'000001' ALLOCATE 1 CYLINDER * ALSECND EQU * SECONDARY ALLOC IN CYLINDERS DC AL2(DALSECND) SECONDARY CYLINDER ALLOCATION DC XL2'0001' NUMBER OF ENTRIES ALSECNDL DC XL2'0003' LENGTH OF WORK AREA (INITIAL) ALSECNDX DC XL3'000001' ALLOCATE 1 CYLINDER * ALRLSE EQU * RELEASE UNUSED DC AL2(DALRLSE) RELEASE UNUSED DC XL2'0000' NUMBER OF ENTRIES * ALUNIT EQU * UNIT= PARMAETER DC AL2(DALUNIT) UNIT= PARAMETER DC XL2'0001' NUMBER OF ENTRIES ALUNITL DC XL2'0005' LENGTH OF WORK AREA (INITIAL) ALUNITX DC CL8'SYSDA ' UNIT=SYSDA * ALDCBDS EQU * GET DCB INFO FROM CATALOGED DATASET DC AL2(DALDCBDS) GET DCB INFO DC XL2'0001' NUMBER OF ENTRIES ALDCBDSL DC XL2'0001' LENGTH OF WORK AREA (INITIAL) ALDCBDSX DC CL44' ' DATASETNAME * ALBUFNO EQU * ALLOCATE DCB=BUFNO=XX DC AL2(DALBUFNO) DC XL2'0001' DC XL2'0001' ALBUFNOL DC XL1'20' DCB=BUFNO=32 EJECT DS 0F CCCONCAT EQU * DC AL2(DCCDDNAM) RETCODE DS F EJECT DA$PRM DSECT DA$FCN DS C FUNCTION * 'I' = INQUIRY * 'A' = ALLOCATE * 'C' = CONCATENATE * 'M' = ALLOCATE (DISP=SHR ONLY) WITH * MEMBER NAME * 'D' = DEALLOCATE DA$DD DS CL8 DD NAME DA$DSN DS CL44 DATASET NAME DA$DSNF DS CL44 DATASET NAME FOUND ON INQUIRES DA$MEM DS CL8 MEMBER NAME DA$UNIT DS CL8 UNIT= FOR ALLOCATE FUNCTION DA$DCBDS DS CL44 DCB=DSNAME FOR ALLOCATE FUNCTION DA$ALLOC DS XL1 DISP=(XXX,,,) * X'01'=OLD * X'02'=MOD * X'04'=NEW * X'08'=SHR DA$NDISP DS XL1 DISP=(,XXX,) (GOOD COMPLETION) * X'01'=UNCATLG * X'02'=CATLG * X'04'=DELETE * X'08'=KEEP DA$CDISP DS XL1 DISP=(,,XXX) (BAD COMPLETION) * X'01'=UNCATLG * X'02'=CATLG * X'04'=DELETE * X'08'=KEEP DA$DDL DS XL2 LENGTH OF DD NAME DA$DSNL DS XL2 LENGTH OF INPUT DATASET NAME DA$MEML DS XL2 LENGTH OF MEMBER NAME TO ALLOC DA$DSNFL DS XL2 LENGTH OF FOUND DATASET NAME DA$PCYL DS XL2 ALLOC CYL PRIMARY QUANTITY DA$SCYL DS XL2 ALLOC CYL SECONDARY QUANTITY DA$UNITL DS XL2 LENGTH OF UNIT= DA$DCBDL DS XL2 LENGTH OF DCB=DSNAME LENGTH DA$R15 DS XL2 R15 RETURN FROM SVC 99 DA$RET DS XL2 ERROR REASON CODE FROM SVC 99 * 0 = GOOD DA$INF DS XL2 INFORMATION REASON CODE FROM SVC 99 DA$BUFNO DS XL1 DCB=BUFNO=XX FOR UNIT=BUFNO DS XL1 DA$CC DS CL256 DA$$L EQU *-DA$PRM EJECT * DYNAMIC ALLOCATION PARM LIST IEFZB4D0 EJECT * DYNAMIC ALLOCATION KEY TABLE IEFZB4D2 END