BSLJX07B TITLE 'JES2 Control block I/O Exit (EXIT # 7)' *********************************************************************** * HASP EXIT 7 * * * * This exit is used as a "Job termination" exit. All jobs processed * * by BSLJX28B (EXIT28) have a flag set (bit 1 of JCTUSER0+1). If * * the flag is on when this exit is entered, it is turned off and job * * termination processing is done. This routine also searches for any * * jobs with /*AFTER cards for the job that is terminating and turns * * off the after condition if the job eneded successfully. * * * * Register usage (ENTRY/EXIT) : * * * * REG Value on entry Value on exit * * R0 Parameter list * * R1 Control block address n/a * * R2-R10 n/a Unchanged * * R11 Address of HCT Unchanged * * R12 n/a Unchanged * * R13 Address of PCE Unchanged * * R14 Return address Unchanged * * R15 Entry address Return code (see below) * * * * Parameter list : * * * * Please refer to the $XPL documentation for this value * * * * Return codes (R15 on exit) * * 0 = Continue normal processing. Call any additional * * routines for exit 7. * * 4 = Continue normal processing. Do NOT call and additional * * routines for exit 7. * * * *********************************************************************** COPY $HASPGBL Include the JES2 Global values BSLJX07B $MODULE SYSP=(GEN,GEN,DATA,GEN,GEN), * TITLE='JES2 CONTROL BLOCK I/O EXIT (EXIT # 7)', * ENVIRON=JES2, * WPL, Required by WTO * $HASPEQU, USED BY PGM * $CAT, REQUIRED BY $QJQE * $CATBERT, REQUIRED BY $DOGBERT * $BERT, * $BERTTAB, * $TRE, HASP TRE DSECT * $PRE, HASP PRE DSECT * $ERA, HASP ERA DSECT * $HCCT, Common storage communication table * $HCT, HASP control table * $JCT, REQUIRED * $JQE, REQUIRED * $KIT, REQUIRED BY $CKPT * $MIT, Module information table * $USERCBS, User defined control blocks * $PCE, Processor control element DSECT * RMode=ANY, Load program above the line * $XPL, USED BY PGM * SSOB USED BY PGM TITLE 'JES2 CONTROL BLOCK I/O EXIT (EXIT # 7)' EXIT07C $ENTRY BASE=R12 $SAVE LR R12,R15 Establish base register as R12 LR R10,R1 Get JCT pointer LR R2,R0 Get XPL pointer $ESTAE RECADDR==A(X7RECOVR),RETRY=X07RETRY,BASE=(12) L R14,PCEPRE Get address of the PRE and ... USING PRE,R14 ...Address it MVC PRETRACK(L'X7MSG),X7MSG Move message to PRE ... MVI PRELOGLN,L'X7MSG ... and set the length of message DROP R14 Kill PRE addressability USING JCT,R10 Establish JCT addressability USING XPL,R2 Establish XPL addressability IF (CLC,X007CBID,=CL4'JCT',EQUAL),AND, If this is a JCT * (TM,JCTUSER0+1,BIT1,ON) and EXIT028 has processed it NI JCTUSER0+1,FF-BIT1 Set off so we don't process it again * If job didn't abend or fail in XEQ If (TM,JCTJTFlg,SSJTAbnd+SSJTJFal,ZERO),AND, * (CLC,JCTCnvRC,=A(JCTCOK),EQUAL),AND, and no JCL error * (TM,JCTUseID,Bit0,NO),AND, and ERROR program not invoked* (CLC,JCTXEQOn(8),$Zeros,NEQUAL),AND, and started XEQ * (CLC,JCTXEQOf(8),$Zeros,NEQUAL) and finished XEQ L R1,$JOBQPTR JCT pointer into R1 A R1,JCTJQE Add to get JQE ... USING JQE,R1 ... and establish addressability IF (TM,JQEFLAG1,JQE1OCAN,NO),DO,CKAFTRTN DROP R1 Kill JQE addressability ENDIF ENDIF $RETURN Return to caller * ------------------------------------------------------------------- * * - CKAFTRTN - * * - This routine searches for jobs with /*AFTER cards specifying - * * - this job and releases the AFTER condition. * * ------------------------------------------------------------------- * BGNSEG CKAFTRTN $GETWORK WORDS=WRKWORDS,USE=J007 Get some work storage LR R5,R1 ... and put address into R5 ... USING WORKAREA,R5 ... and address it a WORKAREA MVC CLASSENT,$BLANKS Initialise CLASSENT to blank $QSUSE , Get access to update JES checkpoint SRCHJQE DS 0H XC WORKNUM,WORKNUM Clear work area for job number NI SWITCH,FF-BIT0 Clear Switch LA R6,CLASSTBL Point to start of class table SRCHCLS DS 0H MVC CLASSENT(1),0(R6) Move in class to CLASSENT $QJQE TYPE=EXEC, * REG=(R4), Put returned JQE address in R4 * CLASS=CLASSENT, Read the JQE for this class * LOOP=NEXTJQE, * NOMORE=NEXTCLAS USING JQE,R4 Address the returned JQE * MVC xUR_WTO(EJT_WTOL),EJT_WTO * MVC xUR_WTO+14(4),=c'R4=>' * MVC xUR_WTO+18(8),JQEJNAME * $$WTO xUR_WTO Issue diagnostic message $DOGBERT ACTION=GETOFFSET, Get extension created in SSM mods * CBTYPE=JQE, * NAME=STQNAME, * ERRET=NEXTJQE LA R3,JQE(R1) Point to the STQNAME area USING STQNAME,R3 ... and address it * MVC xUR_WTO(EJT_WTOL),EJT_WTO * MVC xUR_WTO+14(4),=c'r3=>' * MVC xUR_WTO+18(24),0(R3) * $$WTO xUR_WTO Issue diagnostic message TM UBRMFLAG,UBRAFT Is the AFTER condition true? BZ NEXTJQE No - go get next JQE CLC JCTJNAME,UBRAFTR Does AFTER condition pertain to JOB BNE NEXTJQE No - go get next JQE SAVEJQE DS 0H LH R1,WORKNUM Get our work number CH R1,=Y(SAVENUM) Are we at the mximum allowed? BNL TBLOVFLW Yes - go deal with table overflow LA R1,1(,R1) Increment counter ... STH R1,WORKNUM ... and save it $JQEJNUM JQE=JQE,REG=R0 Go get JOB Number LH R1,WORKNUM Get our work number BCTR R1,0 Subtract one for zero based count SLL R1,2 Multiply by 8 ST R0,WORKJBNO(R1) and save returned Job # into table B NEXTJQE ... get the next one NEXTCLAS DS 0H LA R6,1(,R6) Up to next class C R6,=A(CLASSTBL+L'CLASSTBL) ..end of classes yet? BL SRCHCLS No - Go get JQE for this class CLC WORKNUM,=H'0' Did we find any? BE CKAFTXIT No - go drop out UPDTEJQE DS 0H XR R6,R6 Clear R6 as we are done with it GETJQE DS 0H LR R1,R6 SLL R1,2 L R1,WORKJBNO(R1) Load job number $QLOC (R1),NOTFOUND=NXTJOBNO $DOGJQE JQE=(R1),ACTION=(FETCH,UPDATE) LR R4,R0 R4 Points to JQE $DOGBERT ACTION=GETOFFSET, * CBTYPE=JQE, * NAME=STQNAME, * ERRET=RETJQE LA R3,JQE(R1) Point to the STQNAME area TM UBRMFLAG,UBRAFT Is the AFTER condition true? BZ RETJQE No - go and return the JQE XC WORKCTR2,WORKCTR2 Clear counter CLC JCTJNAME,UBRAFTR Does the after jobname match ours? BNE RETJQE No - go and return the JQE NEXTAFT3 DS 0H MVC UBRAFTR,=C' ' Clear the AFTER jobname XC UBRAFTR,UBRAFTR Clear the AFTER jobname NI UBRMFLAG,FF-UBRAFT Turn the AFTER flag off * NI JQEAFLG1,FF-UBRAFT RETJQE DS 0H $DOGJQE CBADDR=JQE,ACTION=RETURN Return the JQE NXTJOBNO DS 0H LA R6,1(,R6) Go get next job number to process CH R6,WORKNUM Are we done yet? BL GETJQE No - Go get the next one then TM SWITCH,BIT0 Table overflow? BO SRCHJQE Yes - continue JQE search B CKAFTXIT No - Go to return to caller TBLOVFLW DS 0H OI SWITCH,BIT0 Set tableover flow switch B UPDTEJQE ... and go deal with the table CKAFTXIT DS 0H $RETWORK (R5) Free up the work area ENDSEG X07RETRY LA R6,4 Set bad return code 4 RETURN DS 0H $ESTAE CANCEL Cancel ESTAE environment $RETURN (R6) Return to caller BADBERT DS 0H Error from DOGBERT come here $RETWORK (R5) LA R6,16(0,0) Set a bad return code - RC=16 B RETURN Go to return to caller * ------------------------------------------------------------------- * * - Show_R3 subroutine. - * * ------------------------------------------------------------------- * * - This subroutine is only used for diagnostics (if required) - * * - It will make the contents of R3 printable and then issue the- * * - $$WTO to display the message in xUR_WTO - * * - Exit is via R6 and R3 is destroyed by this routine. - * * ------------------------------------------------------------------- * Show_r3 DS 0H ST R2,BSL_SAVERE Save R2 for safe keeping LA R0,8 Set loop count LA R1,XUR_WTO+20 Point to target area LOOP_it LA R2,X'0F' Prime R2 with 0F SLDL R2,4 Shift first nibble from R3 CH R2,=X'00FA' Is it F0 to F9? BL SKIP ...No, skip subtract SH R2,=X'0039' Subtract 39 to get Hex letter SKIP STC R2,0(R1) Store character LA R1,1(R1) Increment R1 BCT R0,LOOP_it Loop until done $$WTO XUR_WTO Issue message L R2,BSL_SAVERE Restore R2 ... BR R6 ... and return to caller * ------------------------------------------------------------------- * X7MSG DC C'ESTAE SET UP FOR EXIT 7' EJT_WTO WTO '$HASPX07B-I: ', C MF=L, C ROUTCDE=(2),DESC=(4) EJT_WTOL EQU *-EJT_WTO Length of skeleton WTO * ------------------------------------------------------------------- * * Executed instructions * * ------------------------------------------------------------------- * ClearAFT MVC 0(0,R7),8(R7) SHFTDNAM MVC 0(0,R7),8(R7) * ------------------------------------------------------------------- * CLASSTBL DC C'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' SAVENUM EQU 256 USING X7RECOVR,R12 Set local addressability USING ERA,R5 Set ERA addressability X7RECOVR $SAVE Save callers registers LR R12,R15 Set local base register LR R5,R1 Set ERA address L R1,ERAPRE Get PRE address MVC ERAREG12,PREBASE-PRE(R1) Set resumes local base L R2,PRERESUM-PRE(,R1) Get resume address $SETRP RECOVER,RESUME=(R2) Set recovery address ************************************************************** * Return to caller * ************************************************************** $RETURN Return to caller DROP R5 Drop ERA addressability DROP R12 Drop rtn addressability IEZBITS EJECT LTORG EJECT $MODEND EJECT WORKAREA DSECT BSL_SAVER0 DS F BSL_SAVER1 DS F BSL_SAVER3 DS F BSL_SAVER6 DS F BSL_SAVERE DS F BSL_SAVERF DS F Xur_WTO WTO '*** EXPANSION OF THE OS/VS2 WRITE TO OPERATOR ***C *** (WTO) MACRO - EXPANDS TO LEAVE ROOM FOR 120 ***C *** CHARS', C ROUTCDE=(2),DESC=4,MF=L Xur_WTOL EQU *-Xur_WTO LENGTH OF HASP900 CLASSENT DS CL8 WORKCTR1 DS H WORKCTR2 DS H SWITCH DS XL1 WORKNUM DS H NUMBER OF TABLE ENTRIES IN USE WORKJBNO DS (SAVENUM)F WORKEND DS 0F ALIGN ON FULLWORD BOUNDARY WRKWORDS EQU (WORKEND-WORKAREA)/4 NUMBER OR WORDS IN WORKAREA END BSLJX07B