z/OS JES2 Installation Exits
Previous topic | Next topic | Contents | Contact z/OS | Library | PDF


Sample code for Exit 17 and Exit 18

z/OS JES2 Installation Exits
SA32-0995-00

The following is code that your installation can include in installation Exit 17 and Exit 18 to remove blanks from the remote workstation identifier on the RJE signon cards.

                                                                   Col 72
                                                                        |
                                                                        v


X1718   $MODULE ENVIRON=JES2,TITLE='JES2 EXIT 017 - $MODULE',           X
               $CADDR,             JES2 Common Address Table            X
               $HASPEQU,           JES2 Equates                         X
               $HCCT,              JES2 Common Communications Table     X
               $HCT,               JES2 Control Table                   X
               $HFAME,             JES2 File Allocation Map Entry       X
               $MIT,               JES2 Module Information Table        X
               $MITETBL,           JES2 MIT Entry Table                 X
               $PADDR,             JES2 Private Routine Address Table   X
               $PARMLST,           JES2 Parameter list                  X
               $PCE,               JES2 Processor Control Element       X
               $PSV,               JES2 Prefix Save Area                X
               $SCAT,              JES2 Sysout Class Attribute Table    X
               $USERCBS,           User Control Blocks                  X
               $XECB               JES2 Extended ECB
X17DBLNK $ENTRY CSECT=YES,BASE=R12  Establish entry point
         SPACE 1
        $SAVE                      Save caller's registers
         LR    R12,R15             Save base address
         SLR   R6,R6               Preset return code
         LTR   R0,R0               Is this the first call for signon?
         BNZ   X17RET               No, return now
         EJECT
**********************************************************************
*                                                                    *
*        The card image passed to this routine by JES2 will          *
*        always have a blank after the characters '/*SIGNON'.        *
*                                                                    *
**********************************************************************
         SPACE 1
         L     R2,12(,R1)          Point to the signon card
         LA    R2,15(,R2)          Point to remote number portion
         SPACE 1
**********************************************************************
*                                                                    *
*        Now get past the 'RMT ' or 'R '.                            *
*                                                                    *
**********************************************************************
         SPACE 1
         SLR   R7,R7               Zero number of blanks found
         LA    R5,L'X17FIELD       Get max length of remote field
         LA    R4,L'X17REMOT       Assume that it is 'REMOTE'
         CLC   X17REMOT,0(R2)      Does it start with 'REMOTE'?
         BE    X17FNUM              Yes, go process the number
         LA    R4,L'X17RMT         Assume that it is 'RMT'
         CLC   X17RMT,0(R2)        Does it start with 'RMT'?
         BE    X17FNUM              Yes, go process the number
         LA    R4,L'X17RM          Assume that it is 'RMT'
         CLC   X17RM,0(R2)         Does it start with 'RM'?
         BNE   X17RET               No, can't do anything with it
X17FNUM  LA    R2,0(R4,R2)         Point to character after remote
         SR    R5,R4               Get count of numbers in field
         LR    R4,R5               Save number of numbers
         LR    R3,R2               Save start of number portion
X17LOOP  CLI   0(R2),C' '          Is the next char a blank?
         BNE   X17SKWSH             No, all done
         LA    R7,1(,R7)           Increment number of blanks found
         LA    R2,1(,R2)           Point to next character
         BCT   R5,X17LOOP          And continue de-blanking
         B     X17RET              No numbers, all blanks
         EJECT
**********************************************************************
*                                                                    *
*        Move the characters over and then fill the rest of the      *
*        remote number portion of the field with blanks.             *
*                                                                    *
**********************************************************************
         SPACE 1
X17SKWSH LTR   R7,R7               Were any blanks found?
         BZ    X17RET               No, line is OK
         SR    R4,R7               Get number of numbers
         BCTR  R4,0                Less one for execute
         EX    R4,X17MOVE1         Move the characters over
         LA    R3,1(R4,R3)         Point past numbers
         BCTR  R7,0                Less one for execute
         EX    R7,X17MOVE2         Blank out remaining characters
         SPACE 1
X17RET  $RETURN RC=(R6)            Return to the caller
         EJECT
**********************************************************************
*                                                                    *
*        Executed statements and storage areas                       *
*                                                                    *
**********************************************************************
         SPACE 1
X17MOVE1 MVC   0(*-*,R3),0(R2)     Squish out those blanks
X17MOVE2 MVC   0(*-*,R3),X17BLANK  Squish out those blanks
         SPACE 1
X17BLANK DC    CL9' '
X17FIELD DC    C'REMOTE999'
X17REMOT DC    C'REMOTE'
X17RMT   DC    C'RMT'
X17RM    DC    C'RM'
***********************************************************************
*                                                                     *
*        LITERAL POOL                                                 *
*                                                                     *
***********************************************************************
         SPACE 1
         LTORG ,
         SPACE 1
        $MODEND ,
         END

Go to the previous page Go to the next page




Copyright IBM Corporation 1990, 2014