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                                

