Macro
.*
.* Bump program use count (IHACDE CDUSE) to keep program in JPAQ.
.* This will improve performance of an often loaded program
.* significantly.
.* For reentrant and optionally serially reusable programs.
.*
.* Syntax
.*
.*  label  CDEUCTZ2 [BASE=reg][,SER=Y][,DSECT=N][,PRINT=OFF|NOGEN]
.*         reg       Basereg for main module. Default is determined
.*                   basereg when macro is expanded.
.*         SER=Y     Change uct for serially reusable module too.
.*         DESCT=N   Do not include DSESCTs in the macro expansion.
.*                   The DSECTs are
.*                      IKJTCB DSECT=YES
.*                      IHAPSA DSECT=YES
.*                      IHACDE
.*         PRINT=    Print option for DSECT expansions.
.*                   Default is NOGEN.
.*
.* Sample
.*
.*         YREGS
.*   A     Csect
.*         bakr  r14,r0
.*         lr    r9,r15
.*         Using A,r9
.*         CDEUCTZ2
.*
.* Performance
.*
.*  A small performance  test when CDEUCTZ2 is used in  a program run
.*  in  an REXX  exec  to scan  36  records 100  times  for a  match.
.*   The  program is  RXPATTRN  and  can be  found  at  the web  site
.*  mentioned below.
.*
.*                        EXCP   CONN    TCB
.*  CDEUCTZ2 disabled     7284      0   1.35
.*  CDEUCTZ2 enabled        90      0    .09
.*  Running from LPA        51      0    .14
.*
.* Author
.*     Willy Jensen
.*     mail: willy@harders-jensen.com
.*     web : http://harders-jensen.com/wjtech
.*-
&ml      CDEUCTZ2 &base=*,&wto=N,&ser=N,&dsect=Y,&print=NOGEN
         lclc  &l,&s,&br
&l       setc  'CT&sysndx'
         using tcb,r14
         using cdentry,r15
&ml      l     r14,psatold-psa(0,0)    -> my tcb
         l     r14,tcbjstcb            job-step tcb
         l     r15,tcbjpq              my cde
         drop  r14                     TCB
         cli   cduse+1,1               first time through?
         jne   &l.999                  no, jump
&s       setc  Upper('&ser')
         aif   ('&s '(1,1) ne 'Y').cdattrr
         tm    cdattr,cdren+cdser      reentrant or reuseable ??
         ago   .cdattrn
.cdattrr tm    cdattr,cdren            reentrant ??
.cdattrn anop
         jz    &l.999                  no, jump
.* do basereg test
         aif   ('&base' ne '*').base2  specific base (we hope)
         j     &l.e
&l.C     c     r0,cdentpt              executed, check cde
&l.D     dc    sl2(*)                  basereg + offsett
&l.E     sr    r1,r1
         ic    r1,&l.d                 load basereg+offsett
         srl   r1,4                    leave basereg
         sll   r1,4                    for execute
         ex    r1,&l.c                 check base against cdentpt
         ago   .base3
.base2   c     &base,cdentpt           my cde?
.base3   jne   &l.999                  no, jump
.* all seems ok, do load
         load  eploc=cdname            bump my own use count
         drop  r15                     CDE
&s       setc  Upper('&wto')
         aif   ('&s' ne 'Y').wton
         wto   'use count bumped'      for debugging
.wton    anop
&l.999   equ   *
.* dsects
&s       setc  Upper('&dsect')
         aif   ('&s' ne 'Y').dsectn
*dsects
&s       setc  '&sysect'
         Push  print
         Print &print
         gblb  &$DSCT_IKJTCB,&$DSCT_IHAPSA,&$DSCT_IHACDE
         aif   (&$DSCT_ikjtcb).dsect2
         IKJTCB DSECT=YES
&$DSCT_IKJTCB setb 1
.dsect2  aif   (&$DSCT_IHAPSA).dsect3
         IHAPSA DSECT=YES
&$DSCT_IHAPSA setb 1
.dsect3  aif   (&$DSCT_IHACDE).dsect4
         IHACDE
&$DSCT_IHACDE setb 1
.dsect4  Pop  print
*dsects end
&s       Csect
.dsectn  anop
.*-
.x       Mend