//ISPEXI16 JOB (1),'ISPEXITS-#16',CLASS=A,COND=(0,LT),REGION=64M //* //ISPX16 EXEC ASMAC,PARM.C='TERM,RENT' //C.SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=SYS1.MODGEN //C.SYSTERM DD SYSOUT=* //C.SYSIN DD * * * ISPF exit 16 - log, list, trace, and temporary dataset * allocation exit * * Principles of operation * * The exit allocates work datasets if and when they are needed, so * you do not have to allocate potentially 32*12 temporary datasets * up front. * The exit is entered every time an ISPF log, list, trace, and * temporary data set is opened. Experimentation shows that it is * entered prior to checking if the DDname is present, hence it can * be used to allocate the dataset. This behaviour is not documented * so may change without notice. * * The ISPF configuration value ENABLE_ISPF_EXITS must be YES. * * The exit is fully reentrant, the dynamic work area is supplied * by ISPF. * * The exit will issue a number of WTOs, they can be dummied. * * * At entry * r1 -> +00 a -> a(user-exit-nr) * +04 a -> cl8'userid' * +08 a -> cl1'screenid' * +12 a -> cl32'zenvir' * +16 a -> a(l'exit-area) * +20 a -> exit-area * +24 a -> a(prefix-length) * +28 a -> cl26'prefix' * +32 a -> x'dataset type bits' * +36 a -> a(suffix-length) * +40 a -> cl18'suffix' * * Dataset type bits * bit 0 1 = List data set * bit 1 1 = Log data set * bit 2 1 = Temporary listing data set * bit 3 1 = Temporary control data set * bit 4 1 = Temporary work data set * bit 5 1 = ISPVCALL trace data set * bit 6 1 = ISPDPTRC trace data set * bit 7 1 = ISPFTTRC trace data set * Macro Clear &name mvi &name.,c' ' mvc &name.+1(l'&name.-1),&name. Mend * Macro &lbl C2XC &in=,&out=,&len=1 &lbl la r14,&in la r15,&out la r1,&len lclc &l &l setc 'c2x&sysndx' .* * upper nibble &l.un llc r0,0(r14) insert into workreg one byte srl r0,4 shift last four bit away ahi r0,240 cfi r0,x'fa' nibble gt 9? jl *+8 ahi r0,-57 then use C'A'-C'F' stc r0,7(r15) * lower nibble llc r0,0(r14) insert into workreg one byte sll r0,28 leave srl r0,28 lower nibble ahi r0,240 cfi r0,x'fa' nibble gt 9? jl *+8 ahi r0,-57 then use C'A'-C'F' stc r0,8(r15) ltr r1,r1 jz &l.x la r14,1(,r14) bump input la r15,2(,r15) bump output bct r1,&l.un &l.x ds 0h Mend * yregs iezbits IspX16p1 amode 31 IspX16p1 rmode any IspX16p1 csect bakr r14,0 lr r12,r15 using IspX16p1,r12 ereg 0,1 lr r9,r1 l r10,20(,r9) -> exit work area address l r10,0(,r10) -> exit work area using dwrk,r10 la r13,sa1 xc wtopfx(4),wtopfx clear wtodata mvc ddname,wtodata *- * log entry data *- mvc wtodata(3),=c'x16' la r4,wtodata+4 *userid mvc 0(4,r4),=c'user' l r2,4(,r9) -> userid mvc 5(8,r4),0(r2) la r4,14(,r4) *screen mvc 0(6,r4),=c'screen' l r2,8(,r9) -> screen mvc 7(1,r4),0(r2) la r4,9(,r4) *dataset bits mvc 0(6,r4),=c'dsbits' l r2,32(,r9) -> dsbits C2Xc in=0(,r2),out=0(,r4),len=1 la r4,10(,r4) *prefix mvc 0(6,r4),=c'prefix' l r2,28(,r9) -> prefix l r3,24(,r9) -> prefix length l r3,0(,r3) prefix length bctr r3,0 j *+10 mvc 7(*-*,r4),0(r2) ex r3,*-6 la r4,8(r3,r4) *do wto lr r15,r4 la r2,wtodata sr r15,r2 bal r14,xwto *- * allocate according to dataset type and screen *- l r2,32(,r9) -> dsbits tm 0(r2),bit0 jo listds tm 0(r2),bit1 jo logds tm 0(r2),bit2 jo tmplst tm 0(r2),bit3 jo tmpctl tm 0(r2),bit4 jo tmpwrk j back don't touch * lclc &unit &unit setc 'VIO' * Macro &lbl Makealc &name,&ddmod=Y,&ddlen=7 &lbl mvc alcdata(alc&name.l),alc&name. aif ('&ddmod' eq 'Y' or '&ddmod' eq 'y').ddmody aif ('&ddmod' eq 'N' or '&ddmod' eq 'n').ddmodn l r1,8(,r9) -> screen mvi alcdata+15,c'&ddmod' ago .ddmodn .ddmody l r1,8(,r9) -> screen mvc alcdata+15(1),0(r1) .ddmodn anop mvc ddname(&ddlen),alcdata+9 la r15,alc&name.l bal 14,xalloc Mend * *- list dataset, ispctl0, spftemp0 listds Makealc list,ddmod=n j back alclist dc c'alloc dd(isplist) new delete reuse ' dc c'lrecl(121) recfm(f,b,a) blksize(0) ' dc c'tracks space(5,5) unit(&unit) ' alclistl equ *-alclist * *- log dataset, ispctl0, spftemp0 logds ds 0h *ogds Makealc log,ddmod=n,ddlen=6 Makealc ctl,ddmod=0 j back alclog dc c'alloc dd(isplog) mod delete reuse ' dc c'lrecl(125) recfm(v,a) blksize(129) ' dc c'tracks space(5,5) unit(&unit) ' alclogl equ *-alclog * *- temp list ds tmplst makealc lst j back alclst dc c'alloc dd(isplst?) new delete reuse ' dc c'lrecl(121) recfm(f,b,a) blksize(0) ' dc c'tracks space(5,5) unit(&unit) ' alclstl equ *-alclst * *- temp cntl ds tmpctl makealc ctl j back alcctl dc c'alloc dd(ispctl?) new delete reuse ' dc c'lrecl(80) recfm(f,b) blksize(0) ' dc c'tracks space(5,5) unit(&unit) ' alcctll equ *-alcctl * *- temp work ds tmpwrk makealc wrk j back alcwrk dc c'alloc dd(ispwrk?) new delete reuse ' dc c'lrecl(256) recfm(f,b) blksize(0) ' dc c'tracks space(5,5) unit(&unit) ' alcwrkl equ *-alcwrk *- * back *- back ds 0h sr r15,r15 pr , *- * wto subroutine *- xwto ds 0h st r14,wtortn la r15,4(,r15) sth r15,wtopfx sr r0,r0 la r1,wtopfx svc 35 wto clear wtodata l r14,wtortn br r14 *- * dynalloc subroutine *- xalloc ds 0h st r14,allocrtn sth r15,alclen dynalloc string length oc ddname,=cl8' ' * mvc wtodata,alcdata * bal r14,xwto *- test if ddname is already there l r15,16 -> cvt l r15,0(,r15) -> tcbwords l r15,4(,r15) -> current tcb l r15,12(,r15) -> tiot la r15,24(,r15) jump to 1st dd entry slr r0,r0 locate dd entry in tiot xaltdd1 icm r0,b'0001',0(r15) get length of dd-entry jz xaltddn goodbye if last dd-entry clc 4(8,r15),ddname compare against target je xallocr success, get back ar r15,r0 -> next dd entry j xaltdd1 xaltddn ds 0h *- xc fw,fw sr r0,r0 la r14,alclen Link EP=BPXWDYN,param=((14)),VL=1,mf=(E,fw) st r15,fw mvc wtodata(5),=c'alloc' mvc wtodata+6(8),ddname ddname mvc wtodata+15(2),=c'rc' l r15,fw cvd r15,dw unpk wtodata+19(8),dw oi wtodata+26,x'f0' la r15,26 bal r14,xwto xallocr l r14,allocrtn br r14 *- * data etc *- ltorg drop r10,r12 *- * 1024 bytes allocated by the ISPMEPT and ISPMDAD statements in the * ISPXLST step later. dwrk dsect sa1 ds 18a wtortn ds a wtopfx ds a wtodata ds cl200 allocrtn ds a alclen ds h alcdata ds cl200 ddname ds cl8 fw ds f dw ds d ds 0d * End //C.SYSLIN DD DSN=&&OBJLIB(ISPX16P1),UNIT=VIO,SPACE=(TRK,(4,4,4)), // RECFM=FB,LRECL=80,BLKSIZE=4080,DISP=(,PASS) //* //ISPXLST EXEC ASMAC,PARM.C='TERM' //C.SYSLIB DD DISP=SHR,DSN=ISP.SISPMACS //C.SYSTERM DD SYSOUT=* //C.SYSIN DD * ISPMXED START ISPMXLST (16) * ISPMXDEF 16 ISPMEPT ISPX16P1,ISPXWA01 ISPMXEND * ISPMXED END * ISPMXDD START ISPMDAD ISPXWA01,1024 ISPMXDD END END //* //* All exit routines and ISPXDT CSECT must be in SYSLIB, //* but an INCLUDE SYSLIB statement is only required for //* ISPXDT and not for the exit routines. //LKED EXEC PGM=IEWL, // PARM='XREF,LET,LIST,RENT,SIZE=(512K,128K),AMODE=31,RMODE=ANY' //SYSPRINT DD SYSOUT=* //SYSUT1 DD UNIT=SYSDA,SPACE=(TRK,(10,5)) //SYSLMOD DD DISP=SHR,DSN=SYSX.TEST.LINKLIB //SYSLIB DD DSN=&&OBJLIB,DISP=SHR //SYSLIN DD DSN=&&OBJ,DISP=(OLD,DELETE) // DD * ORDER ISPXDT ENTRY ISPXDT NAME ISPEXITS(R) //*