home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
guts
/
guts.exi
< prev
next >
Wrap
Text File
|
1988-08-15
|
8KB
|
190 lines
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