**** START OF SPECIFICATIONS ***************************************** 00010000 * * 00020000 *01* MODULE NAME = APSUX07 * 00030000 * $MOD (APSUX07 ) COMP(APS) PROD(PSF) : VERSION 3.2.0 * 00040000 * * 00050000 *01* DESCRIPTIVE NAME = RESOURCE EXIT - SAMPLE 7 * 00060000 * * 00070000 *01* STATUS = VERSION 3, RELEASE 2, 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 * * 01050000 **** END OF SPECIFICATIONS ******************************************* 01060000 APSUX07 START 0 01070000 TITLE 'DSECT - GEXTP' 01080000 APSGEXTP LIST=YES 01090000 TITLE 'DSECT - UECA' 01100000 APSUECA LIST=YES 01110000 TITLE 'DSECT - RLST' 01120000 APSURLST LIST=YES 01130000 TITLE 'APSUX07 - INSTALLATION EXIT 7 - RESOURCE EXIT' 01140000 APSUX07 CSECT 01150000 APSUX07 AMODE 31 @H5A 01160000 APSUX07 RMODE ANY @H5A 01170000 USING *,R15 01180000 B START 01190000 DC AL1(16) LENGTH OF FOLLOWING FIELDS 01200000 DC CL8'APSUX07 ' NAME OF THIS ROUTINE 01210000 DC CL8'&SYSDATE' DATE OF THIS ASSEMBLY 01220000 DROP R15 01230000 START DS 0H 01240000 STM R14,R12,R12(R13) SAVE CALLERS REGISTERS 01250000 USING APSUX07,BASEREG NEW ADDRESSABILITY 01260000 LR BASEREG,R15 SWITCH BASE REGISTER 01270000 ********************************************************************** 01280000 * GET BASING FOR CONTROL BLOCKS * 01290000 ********************************************************************** 01300000 USING APSGEXTP,GEXTPTR SET ADDRESSABILITY TO GEXTP 01310000 USING XTP7,XTP7PTR SET ADDRESSABILITY TO XTP7 01320000 USING APSUECA,ECAPTR SET ADDRESSABILITY TO APSUECA 01330000 USING APSUECE,ECEPTR SET ADDRESSABILITY TO APSUECE 01340000 USING APSURLST,RLSTPTR SET ADDRESSABILITY TO APSURLST 01350000 L GEXTPTR,0(,R1) LOAD ADDRESS OF GEXTP 01360000 L ECAPTR,XTPECAP LOAD ADDRESS OF APSUECA 01370000 LR R2,R13 LOAD ADDRESS OF CALLERS SAVE 01380000 LA R13,ECARSCSV ADDR OF APSUX07 SAVE AREA @01C 01390000 ST R2,4(,R13) SAVE CALLERS SAVE AREA ADDRESS 01400000 ST R13,8(,R2) SAVE APSUX07 SAVE AREA ADDR @01C 01410000 L ECEPTR,ECAECEP LOAD ADDRESS OF ECA EXTENSION 01420000 L XTP7PTR,XTPRECP LOAD ADDRESS OF XTP7 01430000 L RLSTPTR,XTP7LSTP LOAD ADDRESS OF APSURLST 01440000 ********************************************************************** 01450000 * DETERMINE WHAT TYPE OF CALL IS BEING MADE TO THE EXIT * 01460000 ********************************************************************** 01470000 CALLTYPE EQU * 01480000 TM XTP7ETYP,INITCALL INITIALIZATION CALL? 01490000 BO INITRTN YES, GOTO INIT ROUTINE 01500000 TM XTP7ETYP,ACCCALL RESOURCE ACCESS TIME CALL? 01510000 BO ACCRTN YES, GOTO ACCESS ROUTINE 01520000 B GETOUT THIS SHOULD NEVER HAPPEN 01530000 ********************************************************************** 01540000 * INITIALIZATION ROUTINE: * 01550000 * (ENTERED ONLY DURING PSF INITIALIZATION) * 01560000 * FUNCTION: * 01570000 * - REQUEST CONTROL AT ACCESS TIME FOR FORMDEFS ALL RESOURCES * 01580000 * EXCEPT FONTS. * 01590000 ********************************************************************** 01600000 INITRTN EQU * 01610000 MVI XTP7NACC,XTP7AFD+XTP7APD+XTP7APS+XTP7AMO 01620000 * REQUEST CONTROL AT ACCESS 01630000 * TIME FOR FDEFS, PDEFS, 01640000 * PSEGS AND OVERLAYS 01650000 B GETOUT EXIT APSUX07 01660000 * 01670000 ********************************************************************** 01680000 * ACCESS ROUTINE: * 01690000 * FUNCTION: * 01700000 * - CHECK DATASET TYPE AND DON'T PROCESS HEADERS, TRAILERS, MSGDS* 01710000 * - SET RLSTLOAD FLAG TO FORCE PAGEDEF OR FORMDEF LOAD FROM DASD * 01720000 * - IF JOB'S PRMODE=UPROD, THEN SET PRODUCTION FLAG IN RESOURCE * 01730000 * NAME, OTHERWISE EXIT LEAVING NAME UNTOUCHED. THIS MEANS * 01740000 * PRODUCTION JOBS USE RESOURCES WITH NAMES THAT CANNOT BE * 01750000 * CODED IN JCL OR OVERLAYS. THIS ENSURES THAT TEST AND * 01760000 * DEVELOPMENT OBJECTS DO NOT HAVE NAMES THAT CONFLICT WITH * 01770000 * PRODUCTION OBJECT NAMES. * 01780000 ********************************************************************** 01790000 * 01800000 ACCRTN EQU * 01810000 TM XTP7DSAT,XTP7PDFT+XTP7PJHD+XTP7PJTR+XTP7PDSH+XTP7PMDS 01820000 * TEST FLAGS FOR NON-USER DATASET 01830000 BNZ GETOUT EXIT IF NON-USER 01840000 TM XTP7RTYP,PDEF+FDEF IS THIS RESOURCE A PDEF OR FDEF? 01850000 BZ NORELOAD IF NOT, DON'T FORCE RELOAD 01860000 OI RLSTAFLG,RLSTLOAD REQUEST PD OR FD LOAD FROM DASD 01870000 NORELOAD EQU * 01880000 CLC ECEPRMD,=CL8'UPROD' CHECK JOB'S PRMODE TO SEE IF 01890000 * THIS IS A PRODUCTION JOB 01900000 BNE GETOUT IF NOT, EXIT 01910000 LH R2,XTP7LSTC GET # RLST ENTRIES IN CHAIN 01920000 *--------------------------------------------------------------------* 01930000 * CHANGE SECOND CHAR OF RESOURCE NAME TO $ TO ENSURE RESOURCE IS * 01940000 * ACCESSED FROM PRODUCTION LIBRARY. PAGEDEFS AND FORMDEFS ONLY * 01950000 * HAVE ONE RLST ENTRY, BUT THERE MAY BE MULTIPLE OVERLAYS OR PSEGS * 01960000 * SO WE HAVE TO WORK DOWN THE RLST CHAIN TO GET ALL OBJECTS. * 01970000 *--------------------------------------------------------------------* 01980000 CHNGLOOP EQU * 01990000 MVI RLSTNAME+1,C'$' ALTER RESOURCE NAME 02000000 OI RLSTAFLG,X'40' PROVIDE SUBSTITUTION MESSAGE 02010000 L RLSTPTR,RLSTNEXT POINT TO NEXT RLST ENTRY 02020000 BCT R2,CHNGLOOP ITERATE LOOP IF MORE ENTRIES 02030000 B GETOUT EXIT, WE'RE DONE 02040000 * 02050000 ********************************************************************** 02060000 * EXIT LINKAGE * 02070000 ********************************************************************** 02080000 GETOUT EQU * 02090000 SLR R15,R15 PSF EXPECTS ZERO RETURN CODE 02100000 L R13,4(,R13) RESTORE CALLERS SAVE AREA ADDR. 02110000 L R14,12(,R13) RESTORE CALLERS RETURN ADDRESS 02120000 LM R0,R12,20(R13) RESTORE CALLERS REGISTERS 02130000 BR R14 RETURN TO CALLER 02140000 * 02150000 ********************************************************************** 02160000 * EQUATES TO VERIFY TYPE OF EXIT CALL, COMPARE WITH XTP7ETYP * 02170000 ********************************************************************** 02180000 INITCALL EQU B'10000000' RESOURCE MANAGER INITIAL CALL 02190000 BDSCALL EQU B'01000000' BEGINNING OF DATA SET CALL 02200000 ACCCALL EQU B'00100000' RESOURCE ACCESS 02210000 LDBCALL EQU B'00010000' RESOURCE LOAD BEGIN 02220000 LDECALL EQU B'00001000' RESOURCE LOAD END 02230000 DSECALL EQU B'00000100' RESOURCE DELETE AT DATA SET END 02240000 TRMCALL EQU B'00000010' TERMINATION OF FSA 02250000 ********************************************************************** 02260000 * EQUATES TO VERIFY TYPE OF RESOURCE CALL, COMPARE WITH XTP7RTYP * 02270000 ********************************************************************** 02280000 PDEF EQU B'10000000' PAGEDEF 02290000 FDEF EQU B'01000000' FORMDEF 02300000 FONT EQU B'00100000' CODED FONT 02310000 OVLY EQU B'00010000' MEDIUM OVERLAY 02320000 PSEG EQU B'00001000' PAGE SEGMENT 02330000 ********************************************************************** 02340000 * EQUATES FOR RLSTATTR FLAG FIELD * 02350000 ********************************************************************** 02360000 DFLT EQU B'10000000' DEFAULT FD/PD RESOURCE 02370000 * deleted 1 line (MDFLT) @02D 02380000 INLINE EQU B'00100000' INLINE FD/PD RESOURCE 02390000 SOFTPS EQU B'00010000' SOFT PAGE SEGMENT 02400000 MEFONT EQU B'00001000' MULTIPLE ENTRY FONT 02410000 ********************************************************************** 02420000 * REGISTER EQUATES * 02430000 ********************************************************************** 02440000 R0 EQU 0 02450000 R1 EQU 1 02460000 R2 EQU 2 02470000 R3 EQU 3 02480000 R4 EQU 4 02490000 R5 EQU 5 02500000 R6 EQU 6 02510000 R7 EQU 7 02520000 R8 EQU 8 02530000 R9 EQU 9 02540000 R10 EQU 10 02550000 R11 EQU 11 02560000 R12 EQU 12 02570000 R13 EQU 13 02580000 R14 EQU 14 02590000 R15 EQU 15 02600000 GEXTPTR EQU R5 02610000 XTP7PTR EQU R6 02620000 ECAPTR EQU R7 02630000 RLSTPTR EQU R8 02640000 ECEPTR EQU R9 02650000 BASEREG EQU R12 02660000 * * 02670000 END 02680000