*--------------------------------------------------------------------* 00010001 * * 00020001 * THIS PROGRAM WILL ADD A DATASET TO THE APF LIST * 00030001 * THAT IS POINTED TO BY THE APFLIB DDNAME * 00040001 * * 00050001 *--------------------------------------------------------------------* 00060001 * ADDED DYNAMIC APF SUPPORT * 00061001 * * 00061101 *--------------------------------------------------------------------* 00061201 KMBAPFLB AMODE 31 00061301 KMBAPFLB RMODE 24 00061401 KMBAPFLB CSECT 00061501 USING KMBAPFLB,R12 00061601 SAVE (14,12),T,KMBAPFLB_&SYSDATC._&SYSTIME 00061701 LR R12,R15 00061801 L R2,=A(SAVEAREA) 00061901 ST R13,4(R2) 00062001 ST R2,8(R13) 00063001 LR R13,R2 00064001 USING DATAAREA,R10 00065001 L R10,=A(DATAAREA) 00066001 * get yourself AUTHORIZED or be in APF library 00067001 ***************************************************** 00068001 L R15,=A(OPEN) OPEN APFLIB 00069001 BALR R14,R15 00070001 LTR R15,R15 OK 00080001 BNZ ERROPEN NO, EXIT 00090001 SPACE 2 00100001 L R15,=A(GETAPFAD) 00110001 BALR R14,R15 STD LINKAGE 00120001 LTR R15,R15 00130001 BNZ BADTABLE 00140001 TM WFLAG,$DYN 00150001 BO DYNAMIC 00160001 SPACE 2 00170001 APFOK L R15,=A(SEARCH) IS IT ALREADY THERE 00180001 BALR R14,R15 00190001 CH R15,H4 ALREADY THERE 00200001 BE DSNNOK 00210001 CH R15,H8 APF TABLE FULL 00220001 BE APFFULL 00230001 BH BADTABLE BAD TABLE 00240001 SPACE 2 00250001 L R15,=A(GETMAIN) GET NEW STORAGE 00260001 BALR R14,R15 00270001 LTR R15,R15 00280001 BNZ GETMFAIL 00290001 SPACE 2 00300001 L R15,=A(ASKIFOK) ASK IT ITS OK TO ADD 00310001 BALR R14,R15 00320001 LTR R15,R15 OK TO ADD 00330001 BNZ DENIED NO, EXIT 00340001 SPACE 2 00350001 L R15,=A(BUILDNEW) 00360001 BALR R14,R15 STD LINKAGE 00370001 SPACE 2 00380001 L R15,=A(STIMER) STIMER 00390001 BALR R14,R15 00400001 SPACE 2 00410001 L R15,=A(FREEMAIN) FREEMAIN OLD ENTRY 00420001 BALR R14,R15 00430001 LTR R15,R15 00440001 BNZ MAINRCXX 00450001 SPACE 2 00460001 APFADDED DS 0H 00470001 MVC APFL001D,APFDSN 00480001 XR R0,R0 THIS MUST BE HERE 00490001 WTO ('APFL001 THE FOLLOW IN DATASET SUCCESSFULLY ADDED',D), X00500001 ('APFL001 TO SYSTEM APFTABLE',D), X00510001 ('APFL001 DSN: X00520001 ',DE), X00530001 ROUTCDE=(11) 00540001 APFL001D EQU *-2-44,44 00550001 XR R15,R15 00560001 B MAINRCXX 00570001 EJECT , 00580001 *--------------------------------------------------------------------* 00590001 * APFLIB OPEN FAILED * 00600001 *--------------------------------------------------------------------* 00610001 ERROPEN DS 0H 00620001 XR R0,R0 THIS MUST BE HERE 00630001 WTO ('APFL230 APFLIB DD MISSING OR INCORRECT, CORRECT ',D), X00640001 ('APFL230 AND RESUBMIT JOB',DE), X00650001 ROUTCDE=(11) 00660001 LA R15,16 00670001 B MAINRCXX 00680001 SPACE 2 00690001 *--------------------------------------------------------------------* 00700001 * MESSED UP APFTABLE * 00710001 *--------------------------------------------------------------------* 00720001 BADTABLE DS 0H 00730001 MVC APFL240D,APFDSN 00740001 XR R0,R0 THIS MUST BE HERE 00750001 WTO ('APFL240 THE FOLLOWING DATA SET NOT ADDED TO',D), X00760001 ('APFL240 APFTABLE DUE TO UNKNOWN TABLE FORMAT',D), X00770001 ('APFL240 DSN: X00780001 ',DE), X00790001 ROUTCDE=(11) 00800001 APFL240D EQU *-2-44,44 00810001 LA R15,20 00820001 B MAINRCXX 00830001 SPACE 2 00840001 *--------------------------------------------------------------------* 00850001 * DSN ALREADY IN APFTABLE * 00860001 *--------------------------------------------------------------------* 00870001 DSNNOK DS 0H 00880001 MVC APFL250D,APFDSN 00890001 XR R0,R0 THIS MUST BE HERE 00900001 WTO ('APFL250 THE FOLLOW IN DATASET IS ALREADY',D), X00910001 ('APFL250 IN APFTABLE. REQUEST REJECTED',D), X00920001 ('APFL250 DSN: X00930001 ',DE), X00940001 ROUTCDE=(11) 00950001 APFL250D EQU *-2-44,44 00960001 LA R15,24 00970001 B MAINRCXX 00980001 *--------------------------------------------------------------------* 00990001 * GETMAIN FAILURE * 01000001 *--------------------------------------------------------------------* 01010001 GETMFAIL MVC APFL260D,APFDSN 01020001 XR R0,R0 THIS MUST BE HERE 01030001 WTO ('APFL260 THE FOLLOWING DATASET NOT ADDED TO ',D), X01040001 ('APFL260 APFTABLE DUE TO INSUFFICENT SPACE',D), X01050001 ('APFL260 DSN: X01060001 ',DE), X01070001 ROUTCDE=(11) 01080001 APFL260D EQU *-2-44,44 01090001 LA R15,12 01100001 B MAINRCXX 01110001 SPACE 2 01120001 *--------------------------------------------------------------------* 01130001 * APFTABLE IS FULL * 01140001 *--------------------------------------------------------------------* 01150001 APFFULL DS 0H 01160001 MVC APFL270D,APFDSN 01170001 XR R0,R0 THIS MUST BE HERE 01180001 WTO ('APFL270 THE FOLLOW IN DATASET NOT ADDED TO ',D), X01190001 ('APFL270 APFTABLE DUE TO APF TABLE ALREADY FULL',D), X01200001 ('APFL270 DSN: X01210001 ',DE), X01220001 ROUTCDE=(11) 01230001 APFL270D EQU *-2-44,44 01240001 LA R15,24 01250001 B MAINRCXX 01260001 SPACE 2 01270001 *--------------------------------------------------------------------* 01280001 * OPERATOR DENIED REQUEST * 01290001 *--------------------------------------------------------------------* 01300001 DENIED MVC APFL280D,APFDSN 01310001 XR R0,R0 THIS MUST BE HERE 01320001 WTO ('APFL280 THE FOLLOWING DATASET NOT ADDED TO ',D), X01330001 ('APFL280 APFTABLE DUE TO OPERATOR DENIAL',D), X01340001 ('APFL280 DSN: X01350001 ',DE), X01360001 ROUTCDE=(11) 01370001 APFL280D EQU *-2-44,44 01380001 LA R15,8 01390001 B MAINRCXX 01400001 *--------------------------------------------------------------------* 01410001 * MAIN RETURN EXIT * 01420001 *--------------------------------------------------------------------* 01430001 MAINRCXX DS 0H 01440001 LR R2,R15 SAVE RC 01450001 * get yourself UNAUTHORIZED or if in APF library, do nothing * 01460001 ********************************************************************* 01470001 * 01480001 TM WFLAG,$ENQ ENQ BEING HELD 01490001 BZ MAINRCX1 01500001 DEQ (ENQMAJ,ENQMIN,7,SYSTEM) 01510001 NI WFLAG,255-$ENQ TURN OFF ENQ 01520001 MAINRCX1 DS 0H 01530001 * 01540001 LR R15,R2 RESTORE RC 01550001 L R13,4(R13) 01560001 L R14,12(R13) 01570001 LM R0,R12,20(R13) RESTORE REGS 01580001 BR R14 EXIT 01590001 SPACE 3 01600001 *--------------------------------------------------------------------* 01610001 * * 01620001 * DYNAMIC PROCESSING * 01630001 * * 01640001 *--------------------------------------------------------------------* 01650001 DYNAMIC DS 0H 01660001 CSVAPF REQUEST=QUERY,DSNAME=APFDSN, X01670001 VOLTYPE=ANY,VOLUME=APFVOL, X01680001 MF=(E,WCSVAPF) 01690001 C R15,=A(4) 01700001 BL DSNNOK DSN ALREADY THERE 01710001 BE DYNADD 01720001 B DYNERR 01730001 DYNADD DS 0H 01740001 CSVAPF REQUEST=ADD,DSNAME=APFDSN, X01750001 VOLTYPE=ANY,VOLUME=APFVOL, X01760001 MF=(E,WCSVAPF) 01770001 C R15,=A(4) 01780001 BE DSNNOK DSN ALREADY THERE 01790001 BL APFADDED 01800001 DYNERR DS 0H 01810001 MVC APFL310D,APFDSN 01820001 XR R0,R0 THIS MUST BE HERE 01830001 WTO ('APFL310 THE FOLLOW IN DATASET NOT ADDED TO ',D), X01840001 ('APFL310 APFTABLE DUE TO APF PARAM ERROR',D), X01850001 ('APFL310 DSN: X01860001 ',DE), X01870001 ROUTCDE=(11) 01880001 APFL310D EQU *-2-44,44 01890001 LA R15,24 01900001 B MAINRCXX 01910001 LTORG , 01920001 DROP R12 01930001 *--------------------------------------------------------------------* 01940001 * * 01950001 * OPEN APFLIB AND GET DSNAME AND LENGTH * 01960001 * * 01970001 *--------------------------------------------------------------------* 01980001 USING *,R12 01990001 OPEN DS 0H 02000001 STM R14,R12,12(R13) SAVE REGS 02010001 LR R12,R15 02020001 LA R2,72(R13) 02030001 ST R13,4(R2) 02040001 ST R2,8(R13) 02050001 LR R13,R2 02060001 SPACE 2 02070001 LA R9,APFJFCB 02080001 OPEN (APFLIB,(INPUT)) 02090001 SPACE 2 02100001 RDJFCB (APFLIB) 02110001 LTR R15,R15 02120001 BNZ OPENRC04 02130001 SPACE 2 02140001 MVC APFDSN,0(R9) MOVE IN DSN 02150001 MVC APFVOL,118(R9) MOVE IN VOLSER 02160001 CLOSE (APFLIB) CLOSE 02170001 SPACE 2 02180001 TRT APFDSN,TRTTBL FIND 1ST BLANK 02190001 BZ OPEN0300 02200001 S R1,=A(APFDSN) MINUS @ OF APFDSN 02210001 STC R1,APFDSNL SAVE LENGTH 02220001 B OPENRCXX 02230001 OPEN0300 MVI APFDSNL,X'2C' SET DSN LEN = 44 02240001 B OPENRCXX 02250001 OPENRC04 CLOSE (APFLIB) PARM SET BRCH 02260001 LA R15,4 02270001 OPENRCXX L R13,4(R13) 02280001 L R14,12(R13) 02290001 LM R0,R12,20(R13) RESTORE REGS 02300001 BR R14 EXIT 02310001 TRTTBL DC 256X'0' 02320001 ORG TRTTBL+C' ' 02330001 DC X'04' 02340001 ORG TRTTBL+256 02350001 DROP R12 02360001 SPACE 3 02370001 *--------------------------------------------------------------------* 02380001 * * 02390001 * GET OLD APFTABLE ADDRESS * 02400001 * * 02410001 *--------------------------------------------------------------------* 02420001 USING *,R12 02430001 GETAPFAD DS 0H 02440001 STM R14,R12,12(R13) SAVE REGS 02450001 LR R12,R15 02460001 LA R2,72(R13) 02470001 ST R13,4(R2) 02480001 ST R2,8(R13) 02490001 LR R13,R2 02500001 ENQ (ENQMAJ,ENQMIN,E,7,SYSTEM) 02510001 OI WFLAG,$ENQ 02520001 L R11,X'10' CVT ADDRESS 02530001 MVC APFOTBL@(4),CVTAUTHL-CVT(R11) 02540001 CLC APFOTBL@,=X'7FFFF001' DYNAMIC IN EFFECT 02550001 BE GAPFDYN YES 02560001 CLI APFOTBL@,X'00' 02570001 BE GAPFRC00 02580001 LA R15,4 02590001 B GAPFRCXX 02600001 GAPFRC00 DS 0H 02610001 LA R15,0 02620001 GAPFRCXX DS 0H 02630001 L R13,4(R13) 02640001 L R14,12(R13) 02650001 LM R0,R12,20(R13) RESTORE REGS 02660001 BR R14 EXIT 02670001 GAPFDYN DS 0H 02680001 OI WFLAG,$DYN 02690001 B GAPFRC00 02700001 DROP R12 02710001 SPACE 3 02720001 *--------------------------------------------------------------------* 02730001 * * 02740001 * SCAN APFTABLE TO SEE IF DSN ALREADY THERE * 02750001 * * 02760001 *--------------------------------------------------------------------* 02770001 SEARCH DS 0H 02780001 USING *,R12 02790001 STM R14,R12,12(R13) SAVE REGS 02800001 LR R12,R15 02810001 LA R2,72(R13) 02820001 ST R13,4(R2) 02830001 ST R2,8(R13) 02840001 LR R13,R2 02850001 XR R15,R15 02860001 SPACE 3 02870001 L R9,APFOTBL@ 02880001 LA R8,2(,R9) POINT TO 1ST ENTRY 02890001 XR R6,R6 02900001 * IC R6,1(,R9) 02910001 LH R6,0(,R9) *KMB* 02920001 CH R6,H255 MAX ENTRIES 02930001 B SRCH0200 *KMB* 02940001 B SRCHRC08 02950001 SPACE 2 02960001 *--------------------------------------------------------------------* 02970001 * SCAN THRU APF TABLE * 02980001 *--------------------------------------------------------------------* 02990001 SRCH0200 XR R7,R7 03000001 IC R7,0(,R8) ENTRY LENGTH 03010001 CH R7,=H'50' IS IT VALID LENGTH 03020001 BH SRCHRC12 NO, ERROR 03030001 SH R7,H7 -L'DSNL-L'VOLSER 03040001 MVC SAVEDSN(44),BLANKS 03050001 EX R7,MVCDSN1 03060001 MVC SAVEVOL,1(R8) MOVE IN VOLSER 03070001 CLC SAVEVOL(50),APFVOL IS IT THE SAME 03080001 BE SRCHRC04 YES, 03090001 LA R8,8(R7,R8) NO, NEXT ENTRY 03100001 BCT R6,SRCH0200 LOOP 03110001 ST R8,APFOTBLE SAVE CURRENT END OF APFTBLE 03120001 XR R15,R15 03130001 B SRCHEXIT 03140001 SPACE 2 03150001 SRCHRC12 DS 0H 03160001 LA R15,12 BAD ENTRIES 03170001 B SRCHEXIT 03180001 SRCHRC08 DS 0H 03190001 LA R15,8 MAX ENTRIES 03200001 B SRCHEXIT 03210001 SRCHRC04 LA R15,4 DATASET ALREADY THERE 03220001 SRCHEXIT L R13,4(R13) 03230001 L R14,12(R13) 03240001 LM R0,R12,20(R13) RESTORE REGS 03250001 BR R14 EXIT 03260001 MVCDSN1 MVC SAVEDSN(*-*),7(R8) 03270001 DROP R12 03280001 *--------------------------------------------------------------------* 03290001 * * 03300001 * GETMAIN NEW APFTABLE * 03310001 * * 03320001 *--------------------------------------------------------------------* 03330001 USING *,R12 03340001 GETMAIN DS 0H 03350001 STM R14,R12,12(R13) SAVE REGS 03360001 LR R12,R15 03370001 LA R2,72(R13) 03380001 ST R13,4(R2) 03390001 ST R2,8(R13) 03400001 LR R13,R2 03410001 L R15,=A(ADDLEN) 03420001 BALR R14,R15 STD LINKAGE 03430001 L R2,NEWAPFLN 03440001 MODESET KEY=ZERO,MODE=SUP 03450001 GETMAIN RC,LV=(2),SP=245 03460001 ST R1,NEWAPF@ 03470001 STH R15,GETMRETC 03480001 MODESET KEY=NZERO,MODE=PROB 03490001 XR R15,R15 03500001 CLC GETMRETC(2),ZERO 03510001 BNH GETMRCXX 03520001 LA R15,4 03530001 GETMRCXX L R13,4(R13) 03540001 L R14,12(R13) 03550001 LM R0,R12,20(R13) RESTORE REGS 03560001 BR R14 EXIT 03570001 DROP R12 03580001 *--------------------------------------------------------------------* 03590001 * * 03600001 * ADD NEW DSN ENTRY LENTH TO CURRENT TABLE LENGTH * 03610001 * * 03620001 *--------------------------------------------------------------------* 03630001 USING *,R12 03640001 ADDLEN DS 0H 03650001 STM R14,R12,12(R13) SAVE REGS 03660001 LR R12,R15 03670001 LA R2,72(R13) 03680001 ST R13,4(R2) 03690001 ST R2,8(R13) 03700001 LR R13,R2 03710001 SPACE 2 03720001 L R2,APFOTBLE GET END OF TABLE 03730001 S R2,APFOTBL@ MINUS BEGINNING 03740001 XR R3,R3 03750001 IC R3,APFDSNL GET DSN LENGTH 03760001 LA R2,7(R2,R3) ADD LENGTH+VOLSER TO DSNLEN 03770001 ST R2,NEWAPFLN NEW ENTRY LENGTH 03780001 SPACE 1 03790001 XR R15,R15 03800001 L R13,4(R13) 03810001 L R14,12(R13) 03820001 LM R0,R12,20(R13) RESTORE REGS 03830001 BR R14 EXIT 03840001 DROP R12 03850001 SPACE 3 03860001 *--------------------------------------------------------------------* 03870001 * * 03880001 * ASK IF OK TO ADD DSNAME TO APFTABLE * 03890001 * * 03900001 *--------------------------------------------------------------------* 03910001 USING *,R12 03920001 ASKIFOK EQU * 03930001 STM R14,R12,12(R13) SAVE REGS 03940001 LR R12,R15 03950001 LA R2,72(R13) 03960001 ST R13,4(R2) 03970001 ST R2,8(R13) 03980001 LR R13,R2 03990001 * 04000001 * PUT WTOR HERE TO ASK IF OK 04010001 * 04020001 XR R0,R0 04030001 ASKRC00 XR R15,R15 04040001 ASKRCXX L R13,4(R13) 04050001 L R14,12(R13) 04060001 LM R0,R12,20(R13) RESTORE REGS 04070001 BR R14 EXIT 04080001 DROP R12 04090001 *--------------------------------------------------------------------* 04100001 * * 04110001 * BUILD NEW APFTABLE * 04120001 * * 04130001 *--------------------------------------------------------------------* 04140001 USING *,R12 04150001 BUILDNEW DS 0H 04160001 STM R14,R12,12(R13) SAVE REGS 04170001 LR R12,R15 04180001 LA R2,72(R13) 04190001 ST R13,4(R2) 04200001 ST R2,8(R13) 04210001 LR R13,R2 04220001 L R15,=A(MOVEAPF) 04230001 BALR R14,R15 STD LINKAGE 04240001 L R15,=A(ADDDSN) 04250001 BALR R14,R15 STD LINKAGE 04260001 L R15,=A(UPDCVT) 04270001 BALR R14,R15 STD LINKAGE 04280001 L R13,4(R13) 04290001 L R14,12(R13) 04300001 LM R0,R12,20(R13) RESTORE REGS 04310001 BR R14 EXIT 04320001 DROP R12 04330001 SPACE 3 04340001 *--------------------------------------------------------------------* 04350001 * * 04360001 * MOVE CURRENT APFTABLE TO NEW TABLE * 04370001 * * 04380001 *--------------------------------------------------------------------* 04390001 USING *,R12 04400001 MOVEAPF DS 0H 04410001 STM R14,R12,12(R13) SAVE REGS 04420001 LR R12,R15 04430001 LA R2,72(R13) 04440001 ST R13,4(R2) 04450001 ST R2,8(R13) 04460001 LR R13,R2 04470001 SPACE 2 04480001 L R9,APFOTBL@ OLD TABLE ADDRESS 04490001 L R2,NEWAPF@ NEW TABLE ADDRESS 04500001 L R3,NEWAPFLN NEW TABLE LENGTH 04510001 LR R4,R9 04520001 * XR R6,R6 THIS SEEMS 04530001 * IC R6,0(,R9) TO DO 04540001 * SLL R6,3 NOTHING 04550001 L R5,APFOTBLE OLD TABLE END 04560001 SR R5,R9 MINUS BEGINNING 04570001 MODESET KEY=ZERO,MODE=SUP 04580001 SPACE 1 04590001 MVCL R2,R4 MOVE CURRENT APF TO NEW 04600001 SPACE 1 04610001 MODESET KEY=NZERO,MODE=PROB 04620001 SPACE 2 04630001 XR R15,R15 04640001 L R13,4(R13) 04650001 L R14,12(R13) 04660001 LM R0,R12,20(R13) RESTORE REGS 04670001 BR R14 EXIT 04680001 DROP R12 04690001 *--------------------------------------------------------------------* 04700001 * * 04710001 * ADD NEW ENTRY TO NEW TABLE * 04720001 * * 04730001 *--------------------------------------------------------------------* 04740001 USING *,R12 04750001 ADDDSN DS 0H 04760001 STM R14,R12,12(R13) SAVE REGS 04770001 LR R12,R15 04780001 LA R2,72(R13) 04790001 ST R13,4(R2) 04800001 ST R2,8(R13) 04810001 LR R13,R2 04820001 SPACE 2 04830001 XR R15,R15 04840001 L R9,NEWAPF@ 04850001 L R8,APFOTBLE OLD TABLE END 04860001 S R8,APFOTBL@ MINUS BEGINNING = OLD LENGTH 04870001 AR R8,R9 POINT AT END OF NEW 04880001 IC R6,APFDSNL ADD IN 04890001 LA R6,6(,R6) NEW 04900001 STC R6,APFDSNL DSN ENTRY 04910001 MODESET KEY=ZERO,MODE=SUP 04920001 EX R6,ADDMVC1 MOVE IN NEW DSN TO END OF TBL 04930001 L R2,NEWAPFLN 04940001 LH R2,0(,R9) *KMB* 04950001 LA R2,1(,R2) 04960001 STH R2,0(,R9) *KMB* 04970001 MODESET KEY=NZERO,MODE=PROB 04980001 SPACE 2 04990001 XR R15,R15 05000001 L R13,4(R13) 05010001 L R14,12(R13) 05020001 LM R0,R12,20(R13) RESTORE REGS 05030001 BR R14 EXIT 05040001 ADDMVC1 MVC 0(0,R8),APFDSNL 05050001 DROP R12 05060001 SPACE 3 05070001 *--------------------------------------------------------------------* 05080001 * * 05090001 * INSERT NEW APFTABLE IN CVT * 05100001 * * 05110001 *--------------------------------------------------------------------* 05120001 USING *,R12 05130001 UPDCVT DS 0H 05140001 STM R14,R12,12(R13) SAVE REGS 05150001 LR R12,R15 05160001 LA R2,72(R13) 05170001 ST R13,4(R2) 05180001 ST R2,8(R13) 05190001 LR R13,R2 05200001 SPACE 2 05210001 MODESET KEY=ZERO,MODE=SUP 05220001 SPACE 2 USE COMPARE AND SWAP 05230001 L R11,X'10' CVT ADDRESS 05240001 L R1,CVTAUTHL-CVT(,R11) 05250001 L R2,NEWAPF@ 05260001 UPDC0120 CS R1,R2,CVTAUTHL-CVT(R11) 05270001 BC 4,UPDC0120 ITS CHANGED 05280001 SPACE 2 05290001 MODESET KEY=NZERO,MODE=PROB 05300001 SPACE 2 05310001 TM WFLAG,$ENQ ENQ BEING HELD 05320001 BZ UPDC0140 05330001 DEQ (ENQMAJ,ENQMIN,7,SYSTEM) 05340001 NI WFLAG,255-$ENQ TURN OFF ENQ 05350001 UPDC0140 DS 0H 05360001 SPACE 2 05370001 XR R15,R15 05380001 L R13,4(R13) 05390001 L R14,12(R13) 05400001 LM R0,R12,20(R13) RESTORE REGS 05410001 BR R14 EXIT 05420001 DROP R12 05430001 *--------------------------------------------------------------------* 05440001 * * 05450001 * STIMER * 05460001 * * 05470001 *--------------------------------------------------------------------* 05480001 USING *,R12 05490001 STIMER DS 0H 05500001 STM R14,R12,12(R13) SAVE REGS 05510001 LR R12,R15 05520001 LA R2,72(R13) 05530001 ST R13,4(R2) 05540001 ST R2,8(R13) 05550001 LR R13,R2 05560001 STIMER REAL,DINTVL=INTVL 05570001 XR R15,R15 05580001 L R13,4(R13) 05590001 L R14,12(R13) 05600001 LM R0,R12,20(R13) RESTORE REGS 05610001 BR R14 EXIT 05620001 DROP R12 05630001 SPACE 3 05640001 *--------------------------------------------------------------------* 05650001 * * 05660001 * FREEMAIN OLD APFTABLE * 05670001 * * 05680001 *--------------------------------------------------------------------* 05690001 USING *,R12 05700001 FREEMAIN DS 0H 05710001 STM R14,R12,12(R13) SAVE REGS 05720001 LR R12,R15 05730001 LA R2,72(R13) 05740001 ST R13,4(R2) 05750001 ST R2,8(R13) 05760001 LR R13,R2 05770001 XR R15,R15 05780001 L R2,APFOTBL@ 05790001 L R3,APFOTBLE 05800001 SR R3,R2 05810001 MODESET KEY=ZERO,MODE=SUP 05820001 FREEMAIN RC,LV=(3),A=(2),SP=245 05830001 STH R15,GETMRETC 05840001 MODESET KEY=NZERO,MODE=PROB 05850001 XR R15,R15 05860001 CLC GETMRETC(2),ZERO 05870001 BNH FREERCXX 05880001 LA R15,4 05890001 FREERCXX L R13,4(R13) 05900001 L R14,12(R13) 05910001 LM R0,R12,20(R13) RESTORE REGS 05920001 BR R14 EXIT 05930001 DC F'0' 05940001 DROP R12 05950001 DATAAREA EQU * 05960001 INTVL DC C'00000500' 05970001 ENQMAJ DC CL8'KMBAPFQ' 05980001 ENQMIN DC CL7'APFLIST' 05990001 APFOTBL@ DC F'0' 06000001 APFOTBLE DC F'0' 06010001 NEWAPF@ DC F'0' 06020001 NEWAPFLN DC F'0' 06030001 GETMRETC DC H'0' 06040001 BLANKS DC CL44' ' 06050001 WFLAG DC AL1(0) 06060001 $ENQ EQU X'80' ENQ IS BEING HELD 06070001 $DYN EQU X'40' DYNAMIC IN USE 06080001 SAVETBL DC 0XL50'00' --+ 06090001 SAVEVOL DC XL6'0' | 06100001 SAVEDSN DC XL44'00' <-+ 06110001 APFDSNL DC X'00' ---+ KEEP 06120001 APFVOL DC CL6' ' | THESE 06130001 APFDSN DC CL44' ' <--+ TOGETHER 06140001 APFEXLST DC 0F'0',X'87',AL3(APFJFCB) 06150001 APFJFCB DC XL176'00' 06160001 APFLIB DCB DDNAME=APFLIB,DSORG=PO,EXLST=APFEXLST,MACRF=(R) 06170001 LTORG , 06180001 H4 DC H'0004' 06190001 H8 DC H'0008' 06200001 H7 DC H'0007' 06210001 H255 DC H'0255' 06220001 ZERO DC F'0' 06230001 SAVEAREA DS (5*9)D'0' 06240001 WCSVAPFX CSVAPF MF=(L,WCSVAPF) 06250001 DROP R10 06260001 REGS 06270001 *--------------------------------------------------------------------* 06280001 * DSECT * 06290001 *--------------------------------------------------------------------* 06300001 CVT DSECT=YES,LIST=NO 06310001 END 06320001