BSLJX49B TITLE 'JES2 JOB Queue Work Selection Exit (EXIT # 49)' *********************************************************************** * HASP EXIT 49 * * * * Function: This exit either accepts or rejects JES2's choice for JQE * * selection. It is used to sequence jobs based on their * * /*AFTER, /*BEFORE, /*WITH /*WITHOUT, /*CNTL, /*NOAUTOTR, * * /*HOLDTIL, & /*HOLDFOR cards, and upon the class limits * * set by "SSMCLSSLM" initialization statements and possibly * * and possibly by jobnames mask set by SSMUIDMX. * * The exit is called after JES2 has selected a new job for * * execution and is given a final opportunity to accept or * * reject the job. This exit never selects a job, it can only* * reject possible choices made by JES2. * * Other exits input, validate, record or move the specified * * options, but this exit is where they are eventually used * * and cause some action to take place, or not take place! * * * * Entry Point - * * * * EXIT49C * * * * Attributes - * * * * AC=1 AMODE=31 RMODE=ANY * * * * Register Usage - * * * * REG On Entry Usage within the exit On Return * * --- ------------ ------------------------------------- ------------* * R0 n/a Work Restored * * R1 XPL Work Restored * * R2 n/a ADDR OF THIS JOB'S STQNAME. Restored * * R3 n/a WORK AREA FOR THIS EXIT TO USE. Restored * * R4 n/a XPL ¬ THEN LATER AS OFFSET TO BERT. Restored * * ADDR OF TEST JOB'S UBRDNAME (INNER). * R5 n/a ¬ JQE SELECTED BY JES2 TO EXEC NEXT. Restored * * COUNTER OF TEST JOB'S UBRDNAME (INNER) * * R6 n/a ¬STQNAME OF JOB SELECTED BY JES2. Restored * * R7 n/a ¬JQA OF JOB TO COMPARE (FROM SCAN). Restored * * R8 n/a ¬STQNAME OF JOB TO COMPARE. Restored * * R9 n/a ¬ $CAT / $qgt Restored * * R10 n/a ¬ SSM'S ECSA COMMON AREA. SSMTB. Restored * * R11 HCT HCT Restored * * R12 n/a Base register Restored * * R13 Save Area * * R14 RETURN ADDR LINKAGE AND WORK Restored * * R15 Entry addr Return address and work Return code * * * * * *********************************************************************** TITLE 'JES2 JOB Queue work selection exit' COPY $HASPGBL Include the JES2 Global values PRINT OFF BSLJX49B $MODULE TITLE='JES2 JOB QUEUE WORK SELECTION EXIT', * RMODE=ANY, * ENVIRON=JES2, * ASCB, * CVT, * NTASM, Name/Token constants * PSA, Program Save Area DSECT * $HASPEQU, HASP equates * RPL, * WPL, Needed for WTO * $BERT, ($DOGBERT) * $BERTTAB, ($DOGBERT) * $CADDR, Commom storage address table * $CAT, ($DOGCAT) * $CATBERT, ($DOGBERT) * $HCCT, Common storage communication table * $HCT, HASP control table * $JCT, ($USERCBS: STJCTX) * $JCTX, ($USERCBS: STJCTX) * $JQE, * $MIT, Module information table * $PIT, * $MITETBL, * $PADDR, * $PARMLST, * $PSV, Process save area DSECT * $QGET, * $QSE, * $TQE, * $TRE, * $XECB, * $USERCBS, User defined control blocks * $XPL USING HCT,R11 Establish addressability to the HCT EXIT49C $ENTRY BASE=(R12),CSECT=NO,ENTRY=YES,REGUSE=(R15) $SAVE , Save caller's registers LR R12,R15 Set up base register (R12) XR R3,R3 Clear work area pointer LR R4,R1 Save passed parms list ... USING XPL,R4 ... and establish addressability $GETWORK WORDS=WRKWORDS,USE=J049 LR R5,R1 Grab a work area ... USING WORKAREA,R5 ... and establish addressability LA R15,4 Set defualt return code to 4 CLI X049Ind,X049norm Is this a normal job? BNE XINITROT Yes - Just get out L R1,X049QGT Get address of QGET parm list USING QGT,R1 ... establish addressability to QGET TM QGTWSTP,$QGTINWS Is this for INWS Q? (JES2 managed) BZ XINITROT No - JES can handle it L R7,QGTCB Get the PIT ... USING PIT,R7 ... and address it DROP R1 finsihed with QGET L R6,X049JQE Get the JQE address USING JQE,R6 ... and address the JQE *********************************************************************** * See if selected JQE should run after other job * *********************************************************************** $DOGBERT Action=GETOFFSET,CBType=JQE,Name=STQNAME, * ErRet=SkipJQA JNZ SkipJQA If offset is invalid - go to SkipJQA LA R3,0(R1,R6) Get address of our BERT ... USING STQNAME,R3 ...and establish addressabilty to it TM UBRMFLAG,UBRAFT was a /*AFTER specified ? BNZ SkipJQA Yes, skip this JQE *********************************************************************** * Check for BEFORE & CNTL Specifications * * * * We must compare all JQES in the execution class queue plus the STC,* * TSU, and conversion queues against the selected JQE for before * * specifications. If during the scan of the queue we find an active * * job we must additionally check for a conflict in the CNTL name * * * *********************************************************************** XR R2,R2 Start at first CAT QNXTQUE DS 0H $DOGCAT ACTION=(FETCHNEXT,READ),UPDATE=IGNORE,CAT=(R2), * ERRET=XINITROT LR R2,R1 Save returneded CAT Address USING CAT,R2 ... and address it $QJQE CAT=CAT,Reg=(R4),Special=NO,Loop=QNxtJQE, * NOMORE=QNXTQUE,INVQ=QNXTQUE DROP R2 Done with the CAT TM JQETYPE-JQE(R4),$XEQ Is it in the execution queue? BNO QNXTJQE No - then forget it * * R4 Points to a JQE in the execution queue at this point * CLR R6,R4 Is it our own JQE? BE QNXTJQE Yes - Then go get the next one $DOGBERT Action=GETOFFSET,CBType=JQE,Name=STQNAME, * ErRet=SkipJQA LA R8,0(R1,R4) Get address of our BERT $QBUSY JQE=(R8),ACTION=(TEST,ANY),NOTBUSY=QBEFORE * 00191000 * See if DOG JQE should run before our JQE 00192000 * 00193000 QBEFORE DS 0H 00194000 TM 70(R8),UBRBEF Did DOG use a /*BEFORE ? 00195000 BZ QNxtJQE No - continue search 00196000 IC R1,70(,R8) 00197000 N R1,=A(UBRAFT) 00198000 SLL R1,3 00199000 LA R1,0(R1,R8) ACCOUNT FOR /*AFTER 00200000 IC R0,70(,R8) 00201000 N R0,=A(UBRBEF) 00202000 QCHKBEF DS 0H 00203000 ST R0,SaveR0 Keep R0 safe as WTO could corrupt LR R9,R1 Save R1.... for the same reason! * MVC xUR_WTO(EJT_WTOL),EJT_WTO * MVC xUR_WTO+14(8),JQEJNAME * MVC xUR_WTO+22(6),=c'<=xx=>' * MVC xUR_WTO+28(6),24(R9) * BAS R6,Issue_WTO Issue diagnostic message LR R1,R9 Restore R1 CLC JQEJNAME,24(R1) Run before this one? 00204000 BE SkipJQA Yes - select another JQE 00205000 L R0,SaveR0 No - Restore R0 BCT R0,QNXTBEF ---+ Loop to next /*BEFORE 00206000 B QNxtJQE ¦ No - Go get next JQE 00207000 QNXTBEF DS 0H <------+ 00208000 LA R1,8(,R1) Up to the next one ... 00209000 B QCHKBEF ... then go and check it 00210000 DROP R3 00211000 XINITROT DS 0H SkipJQA DS 0H OI X049Resp,X049Skip Do not select this JQA $RETWORK (R5) LA R15,4 Set return code 4 J EXIT And go return STRC00 DS 0H $RETWORK (R5) XR R15,R15 Clear return code EXIT DS 0H $RETURN RC=(15) Return to caller Show_r3 Ds 0H ST R2,BSL_SAVER0 Save R2 as we destroy it here LA R0,8 Set loop counter 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 L R2,BSL_SAVER0 Restore R2 to former glory Issue_WTO DS 0H <== enter here to issue wto only $$WTO XUR_WTO Issue message BR R6 <===== Return to caller LTORG EJT_WTO WTO '$HASPX49B-E: ', C MF=L, C ROUTCDE=(2),DESC=(4) EJT_WTOL EQU *-EJT_WTO LENGTH OF HASP900 QCTLSNAM DC CL8' ' SELECTED JQE CNTL NAME WORKAREA 00336000 QCTLBNAM DC CL8' ' BUSY (ACTIVE) JQE CNTL NAME WORKAREA 00337000 QCTLSHR EQU B'10000000' SHARED 00338000 DROP , XX014 00339000 $MODEND , WORKAREA DSECT BSL_SAVER0 DS F Save area for register 0 BSL_SAVER1 DS F Save area for register 1 BSL_SAVERE DS F Save area for register 14 BSL_SAVERF DS F Save area for register 15 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 SaveR0 DS F WORKCTR1 DS H WORKCTR2 DS H SWITCH DS XL1 WORKNUM DS H NUMBER OF TABLE ENTRIES IN USE WORKJBNO DS 16F WORKEND DS 0F ALIGN ON FULLWORD BOUNDARY WRKWORDS EQU (WORKEND-WORKAREA)/4 NUMBER OR WORDS IN WORKAREA END BSLJX49B END OF MODULE