DBEX TITLE 'IEFDB401 - EXIT TO DYNALLOC, SVC 99' PRINT OFF COPY $GUCGBL COPY $GUCSET PRINT &ON,&GEN,&DATA OSHEAD NAME=IEFDB401 SPACE 3 ****************************************************************** *. *. IEFDB401 83-02-17 *. LAST CHANGED: 84-10-30 *. *. USER-WRITTEN VALIDATION ROUTINE THAT CHECKS DSNAME IN *. A REQUEST TO SVC 99. IF DSNAME STARTS WITH ID (TSO- *. PREFIX), THE ID IS EXCHANGED FOR JCTINDEX, AS TO MAINTAIN *. GUC-STANDARD IN DSNAME. *. *. IEFDB401 RESIDES IN LOAD MODULE IEFW21SD. *. *. FOR REFERENCE, SEE: *. OS/VS2 MVS SYSTEM PROGRAMMING LIBRARY: JOB MANAGEMENT *. ****************************************************************** IEFDB401 CSECT , USING *,15 B *+14 BRANCH AROUND ID DC X'08',C'IEFDB401 ' STM R14,R12,12(R13) SAVE REGISTERS ** ** REGISTER DISPOSITION: ** ** R1 POINTER TO ADDRESS-LIST ** R2 POINTER TO TEXT UNIT POINTER LIST ** R3 POINTER TO JCT ** R4 POINTER TO JOBNAME ** R5 POINTER TO TEXT UNIT ** R6 WORK REGISTER ** R7 WORK REGISTER ** R8 POINTER TO WORK-AREA ** R9 WORK REGISTER ** R10 TEXT UNIT COUNTER ** R14 RETURN ADDRESS ** R15 BASE REGISTER AND RETURN CODE ** L R2,0(R1) GET REQUEST BLOCK POINTER L R8,4(R1) GET ADDRESS L R8,0(R8) TO WORK AREA ** ** WE ARE ONLY INTERESTED IN ALLOCATION, DEALLOCATION ** AND INFORMATION RETRIEVAL ** USING S99RB,R2 CLI S99VERB,S99VRBAL ALLOCATION? BE DB401TXU YES, VERB OK CLI S99VERB,S99VRBUN DEALLOCATION? BE DB401TXU YES, VERB OK CLI S99VERB,S99VRBIN INFORMATION? BNE DB401END NO, VERB NOT WANTED ** ** FIND JCT AND FIND JOBNAME FROM TIOT ** DB401TXU L R3,PSATOLD-PSA GET POINTER TO TCB USING TCBRBP,R3 L R4,TCBTIO GET POINTER TO TIOT USING TIOT,R4 EQTEST TIOT,TIOCNJOB POINT TO JOBNAME L R3,TCBJSCB GET JSCB POINTER DROP R3 ITL R3,JSCBSSIB-JSCB(R3) GET THE SSIB POINTER BZ DB401END NOTHING FOUND CLC =C'SSIB',SSIBID-SSIB(R3) VERIFY ID BNE DB401END NOT CORRECT ITL R3,SSIBSUSE-SSIB(R3) GET THE SJB POINTER BZ DB401END NOTHING FOUND CLC =C'SJB ',SJBID-SJB(R3) VERIFY ID BNE DB401END NOT CORRECT * CLC =C'JOB',SJBJOBID-SJB(R3) VERIFY JOB * BNE DB401END LEAVE TSU AND STC AS THEY ARE ITL R3,SJBJCT-SJB(R3) GET JCT POINTER BZ DB401END NOTHING FOUND CLC =C'JCT ',JCTID-JCTDSECT(R3) VERIFY ID BNE DB401END NOT CORRECT CLC =C'JOB',JCTJOBID-JCTDSECT(R3) VERIFY JOB BNE DB401END LEAVE TSU AND STC AS THEY ARE USING JCTDSECT,R3 ** ** FIND TEXT-UNITS THAT CONTAIN DSNAME ** L R2,S99TXTPP GET ADDRESS OF LIST OF TEXT UNIT POINTERS USING S99TUPL,R2 SR R10,R10 ZERO TEXT UNIT COUNTER DB401NTX ICM R5,15,S99TUPTR GET ADDRESS OF TEXT UNIT BZ DB401LA GO CHECK IF LAST UNIT USING S99TUNIT,R5 EQTEST DALDSNAM,DUNDSNAM MUST BE THE SAME EQTEST DALDSNAM,DINDSNAM MUST BE THE SAME CLC S99TUKEY,=AL2(DALDSNAM) COMPARE WITH KEY FOR DSNAME BE DB401FO WANTED KEY FOUND CLC S99TUKEY,=AL2(DALVLRDS) COMPARE WITH KEY FOR VOL.REF. BE DB401FO WANTED KEY FOUND CLC S99TUKEY,=AL2(DALDCBDS) COMPARE WITH DCB DSNAME REF. BNE DB401LA WANTED KEY NOT FOUND ** ** CHECK IF TSO PREFIXING ** DB401FO CLC TIOCNJOB(5),S99TUPAR PREFIXED WITH ID? BNE DB401LA NO, TEST NEXT TEXT-UNIT CLI S99TUPAR+5,C'.' BNE DB401LA NO, TEST NEXT TEXT-UNIT DROP R4 MVC 0(6,R8),S99TUPAR+7 ASSUME ACCOUNT-NUMBER OC 0(6,R8),DB4010F CHECK IF DIGITS CLC 0(6,R8),DB401FF BE DB401LA YES, CHECK NEXT TEXT-UNIT ** ** CONSTRUCT A NEW TEXT UNIT ** MVC 0(4,R8),S99TUKEY MOVE KEY AND NUMBER LA R6,JCTINDEX+L'JCTINDEX POINT AFTER JCTINDEX DB401LO1 BCTR R6,0 DECREASE POINTER CLI 0(R6),C' ' END OF INDEX FOUND? BE DB401LO1 NO LA R7,JCTINDEX COMPUTE LENGTH OF INDEX SR R6,R7 BNM DB401MO1 NO INDEX TO MOVE SR R6,R6 INDEX-LENGTH IS NULL B DB401LEN SPACE 3 DB401MO1 EX R6,DB401MV1 MOVE JCT INDEX LA R6,1(R6) COMPENSATE FOR REDUCED LENGTH DB401LEN LA R7,S99TUPAR GET POINTER TO PARAMETER AH R7,S99TULNG POINT AFTER DSNAME DB401LO2 BCTR R7,0 DECREASE POINTER CLI 0(R7),C' ' END OF DSNAME? BE DB401LO2 NO LA R9,S99TUPAR+5 COMPUTE LENGTH SR R7,R9 OF DSNAME BNP DB401ST NOTHING TO MOVE LR R9,R8 AR R9,R6 WHERE TO MOVE THE REST TO AR R6,R7 TOTAL LENGTH OF DSNAME CH R6,=H'44' MUST NOT BE GREATER THAN 44 BH DB401ERR BCTR R7,0 REDUCE LENGTH EX R7,DB401MV2 MOVE DSNAME DB401ST STCM R6,3,4(R8) STORE LENGTH STCM R8,7,S99TUPTR+1 SAVE ADDRESS TO NEW TEXT UNIT LA R8,S99TUPAR-S99TUNIT(R6,R8) POINT TO NEW FREE SPACE LA R10,1(R10) ONE TEXTUNIT ADDED CH R10,=H'3' HAVE WE ALREADY TREE EXTRA? BNL DB401END YES, THEN WE WON'T ADD MORE SO NOT * TO OVERFLOW THE WORK AREA. MORE THEN * TREE ADDED WILL GIVE DUPLICATES. DB401LA LTR R5,R5 LAST TEXT UNIT? BM DB401END YES LA R2,4(R2) POINT TO NEXT TEXT UNIT POINTER B DB401NTX SPACE 3 DB401ERR WTO MF=(E,DB401) REPORT ERROR LM R14,R12,12(R13) RELOAD REGISTERS LA R15,8 REQUEST IS NOT TO CONTINUE BR R14 RETURN SPACE 3 DB401END LM R14,R12,12(R13) RELOAD REGISTERS SR R15,R15 REQUEST IS TO CONTINUE BR R14 RETURN SPACE 3 DB401MV1 MVC 6(*-*,R8),JCTINDEX DB401MV2 MVC 6(*-*,R9),S99TUPAR+6 SPACE 3 DB4010F DC X'0F0F0F0F0F0F' DB401FF DC X'FFFFFFFFFFFF' DB401BL DC CL36' ' 36=L'JCTINDEX SPACE 3 DB401 WTO 'ACT0033I DSNAME EXCEEDS 44 CHARACTERS',MF=L, ROUTCDE=(2,11),DESC=6 PRINT © CVT,DYN,EQUATES,JCT,JSCB,PSA,SJB,SSIB,TCB,TIOT COPY EQUATES CVT CVT SYS=&SYS DYN DYN SYS=&SYS JCTDSECT JCT SYS=&SYS JSCB JSCB SYS=&SYS PSA PSA SYS=&SYS SSIB SSIB SYS=&SYS SJB SJB SYS=&SYS TCBDSECT TCB SYS=&SYS TIOT TIOT SYS=&SYS END