**** START OF SPECIFICATIONS ***************************************** 00010000 * * 00020000 *01* MODULE NAME = APSUX07 * 00030000 * $MOD (APSUX07 ) COMP(APS) PROD(PSF) : VERSION 3.3.0 * 00040000 * * 00050000 *01* DESCRIPTIVE NAME = RESOURCE EXIT - SAMPLE 7 * 00060000 * * 00070000 *01* STATUS = VERSION 3, RELEASE 3, LEVEL 0 * 00080000 * * 00090000 *01* FUNCTION = * 00100000 * * 00110000 * This exit performs two functions: * 00120000 * * 00130000 * 1. Force load of all FORMDEFs and PAGEDEFs from DASD. The * 00140000 * PSF in-storage copy will never be used. * 00150000 * * 00160000 * 2. For all accessed PAGEDEFs, FORMDEFs, OVERLAYs, and PAGE * 00170000 * SEGMENTs, the object name is altered if the dataset being * 00180000 * processed is a "production" dataset. Production datasets * 00190000 * are flagged by having PRMODE=UPROD in their JCL. * 00200000 * * 00210000 * The alteration made to the resource name is to place a $ in * 00220000 * the second character position. For instance, PAGEDEF * 00230000 * P1ABCD would have its name changed to P$ABCD. Since the * 00240000 * PAGEDEF that is named P$ABCD cannot be accessed directly * 00250000 * through JCL (i.e. coding PAGEDEF=ABCD results in a reference * 00260000 * to the P1ABCD object), this exit ensures that objects * 00270000 * with the $ in their second character are only accessible to * 00280000 * production jobs. * 00290000 * * 00300000 * This means that a development copy of PAGEDEF ABCD can * 00310000 * coexist with the production copy and they can be used * 00320000 * concurrently. Test jobs will access P1ABCD and production * 00330000 * will access P$ABCD. FORMDEFs, OVERLAYs, and PAGE SEGMENTs * 00340000 * are treated the same way. * 00350000 * * 00360000 * * 00370000 * NOTE: Implicit in this approach is the fact that ALL * 00380000 * production resource objects must have the production * 00390000 * prefix. This has two ramifications: standard PSF * 00400000 * objects (e.g. F1010110), if used by a production job * 00410000 * must have a copy bearing the production prefix; and * 00420000 * test jobs using a mix of production and test objects * 00430000 * must have an available test copy of all production * 00440000 * objects. * 00450000 * * 00460000 * * 00470000 * This exit is first entered on PSF initialization. On this entry * 00480000 * the exit sets flags in the XTP7NACC field to indicate that it * 00490000 * wants control whenever a PAGEDEF, FORMDEF, OVERLAY, or PAGE * 00500000 * SEGMENT is accessed. On subsequent entries the logic discussed * 00510000 * above is executed. * 00520000 * * 00530000 * * 00540000 * The basic logic and environment for PSF exits is described in * 00550000 * the PSF System Programmers Guide. * 00560000 * * 00570000 * * 00580000 * * 00590000 * * 00600000 *01* NOTES = SEE BELOW: * 00610000 * DEPENDENCIES = NONE * 00620000 * RESTRICTIONS = NONE * 00630000 * * 00640000 *01* MODULE TYPE = PROCEDURE * 00650000 * PROCESSOR = ASSEMBLER * 00660000 * ATTRIBUTES = REENTRANT, SUPERVISOR STATE, CALLER'S KEY, * 00670000 * PAGEABLE * 00680000 * * 00690000 *01* ENTRY POINT = APSUX07 * 00700000 * * 00710000 *01* REGISTER ON ENTRY : * 00720000 * R1 = ADDRESS OF A 4 BYTE FIELD WHICH CONTAINS THE * 00730000 * ADDRESS OF APSGEXTP * 00740000 * R13 = SAVE AREA ADDRESS * 00750000 * R14 = RETURN ADDRESS * 00760000 * R15 = ENTRY POINT ADDRESS * 00770000 * * 00780000 * * 00790000 *01* INPUT = PARAMETER AREA (APSGEXTP) * 00800000 * * 00810000 *01* OUTPUT = N/A * 00820000 * EXIT-NORMAL = RETURN TO CALLER * 00830000 * EXIT-ERROR = NONE * 00840000 * * 00850000 *01* EXTERNAL REFERENCES = SEE BELOW: * 00860000 * ROUTINES = * 00870000 * DATA AREAS = NONE * 00880000 * CONTROL BLOCKS = (SEE MACROS LISTED BELOW) * 00890000 * * 00900000 *01* TABLES = NONE * 00910000 * * 00920000 *01* MACROS = MACROS USED FROM MACRO LIBRARY: * 00930000 * APSGEXTP - PSF INSTALLATION EXIT PARAMETER AREA * 00940000 * APSUECA - PSF EXIT COMMUNICATIONS AREA * 00950000 * APSURLST - PSF EXIT RESOURCE LIST AREA * 00960000 * * 00970000 *01* CHANGE ACTIVITY = * 00980000 * $L1=LAPS0004, HAF1228, 880601, B53KEMC: RELEASE 3.0 * 00990000 * $01=OY31363, HAF1228, 900406, B53KEMC: Use correct save area @01A* 01000000 * $H5=LAPS0005, HPRF102, 033189, B53KEMC: REL 2.1.0 NEW FUNCT @H5A* 01010000 * $02=OW18773, HPRF220, 960410, BDKURLD: Delete MDFLT @02A* 01020000 * $DU=LAPS0007,HPRF310,980604,BDKURLB: Version 3.1.0 @DUA* 01030000 * $DX=LAPS0008,HPRF320,991117,BUQ4RLB: Version 3.2.0 @DXA* 01040000 * $EV=LAPS0009,HPRF330,010530,BUQ4RLB: Version 3.3.0 @EVA* 01050000 * * 01060000 **** END OF SPECIFICATIONS ******************************************* 01070000 APSUX07 START 0 01080000 TITLE 'DSECT - GEXTP' 01090000 APSGEXTP LIST=YES 01100000 TITLE 'DSECT - UECA' 01110000 APSUECA LIST=YES 01120000 TITLE 'DSECT - RLST' 01130000 APSURLST LIST=YES 01140000 TITLE 'APSUX07 - INSTALLATION EXIT 7 - RESOURCE EXIT' 01150000 APSUX07 CSECT 01160000 APSUX07 AMODE 31 @H5A 01170000 APSUX07 RMODE ANY @H5A 01180000 USING *,R15 01190000 B START 01200000 DC AL1(16) LENGTH OF FOLLOWING FIELDS 01210000 DC CL8'APSUX07 ' NAME OF THIS ROUTINE 01220000 DC CL8'&SYSDATE' DATE OF THIS ASSEMBLY 01230000 DROP R15 01240000 START DS 0H 01250000 STM R14,R12,R12(R13) SAVE CALLERS REGISTERS 01260000 USING APSUX07,BASEREG NEW ADDRESSABILITY 01270000 LR BASEREG,R15 SWITCH BASE REGISTER 01280000 ********************************************************************** 01290000 * GET BASING FOR CONTROL BLOCKS * 01300000 ********************************************************************** 01310000 USING APSGEXTP,GEXTPTR SET ADDRESSABILITY TO GEXTP 01320000 USING XTP7,XTP7PTR SET ADDRESSABILITY TO XTP7 01330000 USING APSUECA,ECAPTR SET ADDRESSABILITY TO APSUECA 01340000 USING APSUECE,ECEPTR SET ADDRESSABILITY TO APSUECE 01350000 USING APSURLST,RLSTPTR SET ADDRESSABILITY TO APSURLST 01360000 L GEXTPTR,0(,R1) LOAD ADDRESS OF GEXTP 01370000 L ECAPTR,XTPECAP LOAD ADDRESS OF APSUECA 01380000 LR R2,R13 LOAD ADDRESS OF CALLERS SAVE 01390000 LA R13,ECARSCSV ADDR OF APSUX07 SAVE AREA @01C 01400000 ST R2,4(,R13) SAVE CALLERS SAVE AREA ADDRESS 01410000 ST R13,8(,R2) SAVE APSUX07 SAVE AREA ADDR @01C 01420000 L ECEPTR,ECAECEP LOAD ADDRESS OF ECA EXTENSION 01430000 L XTP7PTR,XTPRECP LOAD ADDRESS OF XTP7 01440000 L RLSTPTR,XTP7LSTP LOAD ADDRESS OF APSURLST 01450000 ********************************************************************** 01460000 * DETERMINE WHAT TYPE OF CALL IS BEING MADE TO THE EXIT * 01470000 ********************************************************************** 01480000 CALLTYPE EQU * 01490000 TM XTP7ETYP,INITCALL INITIALIZATION CALL? 01500000 BO INITRTN YES, GOTO INIT ROUTINE 01510000 TM XTP7ETYP,ACCCALL RESOURCE ACCESS TIME CALL? 01520000 BO ACCRTN YES, GOTO ACCESS ROUTINE 01530000 B GETOUT THIS SHOULD NEVER HAPPEN 01540000 ********************************************************************** 01550000 * INITIALIZATION ROUTINE: * 01560000 * (ENTERED ONLY DURING PSF INITIALIZATION) * 01570000 * FUNCTION: * 01580000 * - REQUEST CONTROL AT ACCESS TIME FOR FORMDEFS ALL RESOURCES * 01590000 * EXCEPT FONTS. * 01600000 ********************************************************************** 01610000 INITRTN EQU * 01620000 MVI XTP7NACC,XTP7AFD+XTP7APD+XTP7APS+XTP7AMO 01630000 * REQUEST CONTROL AT ACCESS 01640000 * TIME FOR FDEFS, PDEFS, 01650000 * PSEGS AND OVERLAYS 01660000 B GETOUT EXIT APSUX07 01670000 * 01680000 ********************************************************************** 01690000 * ACCESS ROUTINE: * 01700000 * FUNCTION: * 01710000 * - CHECK DATASET TYPE AND DON'T PROCESS HEADERS, TRAILERS, MSGDS* 01720000 * - SET RLSTLOAD FLAG TO FORCE PAGEDEF OR FORMDEF LOAD FROM DASD * 01730000 * - IF JOB'S PRMODE=UPROD, THEN SET PRODUCTION FLAG IN RESOURCE * 01740000 * NAME, OTHERWISE EXIT LEAVING NAME UNTOUCHED. THIS MEANS * 01750000 * PRODUCTION JOBS USE RESOURCES WITH NAMES THAT CANNOT BE * 01760000 * CODED IN JCL OR OVERLAYS. THIS ENSURES THAT TEST AND * 01770000 * DEVELOPMENT OBJECTS DO NOT HAVE NAMES THAT CONFLICT WITH * 01780000 * PRODUCTION OBJECT NAMES. * 01790000 ********************************************************************** 01800000 * 01810000 ACCRTN EQU * 01820000 TM XTP7DSAT,XTP7PDFT+XTP7PJHD+XTP7PJTR+XTP7PDSH+XTP7PMDS 01830000 * TEST FLAGS FOR NON-USER DATASET 01840000 BNZ GETOUT EXIT IF NON-USER 01850000 TM XTP7RTYP,PDEF+FDEF IS THIS RESOURCE A PDEF OR FDEF? 01860000 BZ NORELOAD IF NOT, DON'T FORCE RELOAD 01870000 OI RLSTAFLG,RLSTLOAD REQUEST PD OR FD LOAD FROM DASD 01880000 NORELOAD EQU * 01890000 CLC ECEPRMD,=CL8'UPROD' CHECK JOB'S PRMODE TO SEE IF 01900000 * THIS IS A PRODUCTION JOB 01910000 BNE GETOUT IF NOT, EXIT 01920000 LH R2,XTP7LSTC GET # RLST ENTRIES IN CHAIN 01930000 *--------------------------------------------------------------------* 01940000 * CHANGE SECOND CHAR OF RESOURCE NAME TO $ TO ENSURE RESOURCE IS * 01950000 * ACCESSED FROM PRODUCTION LIBRARY. PAGEDEFS AND FORMDEFS ONLY * 01960000 * HAVE ONE RLST ENTRY, BUT THERE MAY BE MULTIPLE OVERLAYS OR PSEGS * 01970000 * SO WE HAVE TO WORK DOWN THE RLST CHAIN TO GET ALL OBJECTS. * 01980000 *--------------------------------------------------------------------* 01990000 CHNGLOOP EQU * 02000000 MVI RLSTNAME+1,C'$' ALTER RESOURCE NAME 02010000 OI RLSTAFLG,X'40' PROVIDE SUBSTITUTION MESSAGE 02020000 L RLSTPTR,RLSTNEXT POINT TO NEXT RLST ENTRY 02030000 BCT R2,CHNGLOOP ITERATE LOOP IF MORE ENTRIES 02040000 B GETOUT EXIT, WE'RE DONE 02050000 * 02060000 ********************************************************************** 02070000 * EXIT LINKAGE * 02080000 ********************************************************************** 02090000 GETOUT EQU * 02100000 SLR R15,R15 PSF EXPECTS ZERO RETURN CODE 02110000 L R13,4(,R13) RESTORE CALLERS SAVE AREA ADDR. 02120000 L R14,12(,R13) RESTORE CALLERS RETURN ADDRESS 02130000 LM R0,R12,20(R13) RESTORE CALLERS REGISTERS 02140000 BR R14 RETURN TO CALLER 02150000 * 02160000 ********************************************************************** 02170000 * EQUATES TO VERIFY TYPE OF EXIT CALL, COMPARE WITH XTP7ETYP * 02180000 ********************************************************************** 02190000 INITCALL EQU B'10000000' RESOURCE MANAGER INITIAL CALL 02200000 BDSCALL EQU B'01000000' BEGINNING OF DATA SET CALL 02210000 ACCCALL EQU B'00100000' RESOURCE ACCESS 02220000 LDBCALL EQU B'00010000' RESOURCE LOAD BEGIN 02230000 LDECALL EQU B'00001000' RESOURCE LOAD END 02240000 DSECALL EQU B'00000100' RESOURCE DELETE AT DATA SET END 02250000 TRMCALL EQU B'00000010' TERMINATION OF FSA 02260000 ********************************************************************** 02270000 * EQUATES TO VERIFY TYPE OF RESOURCE CALL, COMPARE WITH XTP7RTYP * 02280000 ********************************************************************** 02290000 PDEF EQU B'10000000' PAGEDEF 02300000 FDEF EQU B'01000000' FORMDEF 02310000 FONT EQU B'00100000' CODED FONT 02320000 OVLY EQU B'00010000' MEDIUM OVERLAY 02330000 PSEG EQU B'00001000' PAGE SEGMENT 02340000 ********************************************************************** 02350000 * EQUATES FOR RLSTATTR FLAG FIELD * 02360000 ********************************************************************** 02370000 DFLT EQU B'10000000' DEFAULT FD/PD RESOURCE 02380000 * deleted 1 line (MDFLT) @02D 02390000 INLINE EQU B'00100000' INLINE FD/PD RESOURCE 02400000 SOFTPS EQU B'00010000' SOFT PAGE SEGMENT 02410000 MEFONT EQU B'00001000' MULTIPLE ENTRY FONT 02420000 ********************************************************************** 02430000 * REGISTER EQUATES * 02440000 ********************************************************************** 02450000 R0 EQU 0 02460000 R1 EQU 1 02470000 R2 EQU 2 02480000 R3 EQU 3 02490000 R4 EQU 4 02500000 R5 EQU 5 02510000 R6 EQU 6 02520000 R7 EQU 7 02530000 R8 EQU 8 02540000 R9 EQU 9 02550000 R10 EQU 10 02560000 R11 EQU 11 02570000 R12 EQU 12 02580000 R13 EQU 13 02590000 R14 EQU 14 02600000 R15 EQU 15 02610000 GEXTPTR EQU R5 02620000 XTP7PTR EQU R6 02630000 ECAPTR EQU R7 02640000 RLSTPTR EQU R8 02650000 ECEPTR EQU R9 02660000 BASEREG EQU R12 02670000 * * 02680000 END 02690000