**** START OF SPECIFICATIONS ***************************************** 00010000 * * 00020000 *01* MODULE NAME = APSUX07W * 00030000 * * 00040000 * $MOD (APSUX07W) COMP(APS) PROD(PSF) : VERSION 3.2.0 * 00050000 * * 00060000 *01* DESCRIPTIVE NAME = RESOURCE EXIT - SAMPLE 8 * 00070000 * * 00080000 *01* STATUS = VERSION 3, RELEASE 2, LEVEL 0 * 00090000 * * 00100000 *01* FUNCTION = * 00110000 * THIS SAMPLE EXIT IS INTENDED TO DEMONSTRATE HOW TO INDICATE * 00120000 * TO PSF TO PERFORM MANY OF THE FUNCTIONS THAT CAN BE REQUESTED * 00130000 * ON THE RESOURCE ACCESS (XTP7ACC) OR DATA SET END (XTP7DSE) * 00140000 * CALLS. THE CODE IN THIS EXIT IS COMMENTED OUT TO ACTIVATE * 00150000 * THESE CALLS. TO ACTIVATE JUST UNCOMMENT THE APPROPRIATE LINES * 00160000 * AND FILL IN ANY NECESSARY CONSTANTS. * 00170000 * * 00180000 *02* OPERATION = * 00190000 * THE RESOURCE ACCESS CALL CAN BE ACTIVATED FOR FORMDEFS, * 00200000 * PAGEDEFS, FONTS, OVERLAYS, PAGE SEGMENTS, AND OBJECT * 00210000 * CONTAINERS. UP TO 2 RESOURCES OF EACH TYPE CAN BE RELOADED, * 00220000 * UP TO 2 RESOURCES OF EACH TYPE CAN BE SUBSTITUTED FOR, AND * 00230000 * FOR SUBSTITUTED FONTS THE VERTICAL FONT SIZE, HORIZONTAL * 00240000 * FONT SIZE, AND HORIZONTAL SCALE FACTOR CAN BE SET. * 00250000 * * 00260000 * THE DATA SET END CALL CAN BE ACTIVATED FOR FORMDEFS, * 00270000 * PAGEDEFS, FONTS, OVERLAYS, AND PAGE SEGMENTS. UP TO 2 * 00280000 * RESOURCES OF EACH TYPE CAN BE KEPT OR DELETED AT THE * 00290000 * END OF EACH DATA SET. ALSO THE RRLV FOR EACH TYPE OF * 00300000 * RESOURCE CAN BE SET TO KEEP THE NUMBER OF RESOURCES LOADED * 00310000 * AT A MANAGEABLE LEVEL. * 00320000 * * 00330000 *01* NOTES = * 00340000 *02* DEPENDENCIES = NONE * 00350000 *02* RESTRICTIONS = NONE * 00360000 *02* REGISTER CONVENTIONS = * 00370000 * R2-R12 = SEE ASSEMBLER EQUATES BELOW * 00380000 * * 00390000 *01* MODULE TYPE = PROCEDURE * 00400000 *02* PROCESSOR = ASSEMBLER * 00410000 *02* ATTRIBUTES = REENTRANT * 00420000 * AMODE 31 * 00430000 * RMODE ANY * 00440000 * * 00450000 *01* ENTRY POINT = APSUX07 * 00460000 *02* LINKAGE = * 00470000 * R15 = ENTRY POINT ADDRESS * 00480000 * R13 = SAVE AREA ADDRESS * 00490000 * R1 = ADDRESS OF A 4 BYTE FIELD WHICH CONTAINS THE ADDRESS * 00500000 * OF APSGEXTP * 00510000 * * 00520000 *01* INPUT = * 00530000 * APSGEXTP - PSF INSTALLATION EXIT PARAMETER AREA * 00540000 * * 00550000 *01* OUTPUT = * 00560000 * NONE * 00570000 * * 00580000 *01* EXIT NORMAL = RETURN TO CALLER * 00590000 * * 00600000 *01* EXIT ERROR = NONE * 00610000 * * 00620000 *01* EXTERNAL REFERENCES = * 00630000 *02* ROUTINES = NONE * 00640000 *02* DATA AREAS = * 00650000 * APSGEXTP - PSF INSTALLATION EXIT PARAMETER AREA * 00660000 * APSUECA - PSF EXIT COMMUNICATIONS AREA * 00670000 * APSURLST - PSF EXIT RESOURCE LIST AREA * 00680000 * IAZJSPA - JES SEPARATOR PAGE AREA * 00690000 *02* INCLUDES = NONE * 00700000 * * 00710000 *01* MACROS = NONE * 00720000 * * 00730000 *01* MESSAGES = NONE * 00740000 * * 00750000 * 01* CHANGE ACTIVITY = * 00760000 * $DG=LAPS0007, HPRF310, 980427, BDKURLD: New sample exit 07 @DGA* 00770000 * $DX=LAPS0008,HPRF320,991117,BUQ4RLB: Version 3.2.0 @DXA* 00780000 * * 00790000 **** END OF SPECIFICATIONS ******************************************* 00800000 APSUX07 START 0 00810000 TITLE 'DSECT - GEXTP' 00820000 APSGEXTP LIST=YES 00830000 TITLE 'DSECT - UECA' 00840000 APSUECA LIST=YES 00850000 TITLE 'DSECT - RLST' 00860000 APSURLST LIST=YES 00870000 TITLE 'APSUX07 - INSTALLATION EXIT 7 - RESOURCE EXIT' 00880000 APSUX07 CSECT 00890000 APSUX07 AMODE 31 00900000 APSUX07 RMODE ANY 00910000 USING *,R15 00920000 B START 00930000 DC AL1(16) LENGTH OF FOLLOWING FIELDS 00940000 DC CL8'APSUX07 ' NAME OF THIS ROUTINE 00950000 DC CL8'&SYSDATE' DATE OF THIS ASSEMBLY 00960000 DROP R15 00970000 START DS 0H 00980000 STM R14,R12,R12(R13) SAVE CALLERS REGISTERS 00990000 USING APSUX07,BASEREG NEW ADDRESSABILITY 01000000 LR BASEREG,R15 SWITCH BASE REGISTER 01010000 * 01020000 ********************************************************************** 01030000 * GET BASING FOR CONTROL BLOCKS * 01040000 ********************************************************************** 01050000 * 01060000 USING APSGEXTP,GEXTPTR SET ADDRESSABILITY TO GEXTP 01070000 USING XTP7,XTP7PTR SET ADDRESSABILITY TO XTP7 01080000 USING APSUECA,ECAPTR SET ADDRESSABILITY TO APSUECA 01090000 USING APSURLST,RLSTPTR SET ADDRESSABILITY TO APSURLST 01100000 USING RLSTFEXT,RLSTEPTR SET ADDRESSABILITY TO EXTENSION 01110000 L GEXTPTR,0(,R1) LOAD ADDRESS OF GEXTP 01120000 L ECAPTR,XTPECAP LOAD ADDRESS OF APSUECA 01130000 LR R2,R13 LOAD ADDRESS OF CALLERS SAVE 01140000 LA R13,ECARSCSV ADDR OF APSUX07 SAVE AREA 01150000 ST R2,4(,R13) SAVE CALLERS SAVE AREA ADDRESS 01160000 ST R13,8(,R2) SAVE APSUX07 SAVE AREA ADDR 01170000 L XTP7PTR,XTPRECP LOAD ADDRESS OF XTP7 01180000 L RLSTPTR,XTP7LSTP LOAD ADDRESS OF APSURLST 01190000 L RLSTEPTR,RLSTEXTP LOAD ADDRESS OF EXTENSION 01200000 * 01210000 ********************************************************************** 01220000 * DETERMINE WHAT TYPE OF CALL IS BEING MADE TO THE EXIT * 01230000 ********************************************************************** 01240000 * 01250000 CALLTYPE EQU * 01260000 TM XTP7ETYP,INITCALL INITIALIZATION CALL? 01270000 BO INITRTN YES, GOTO INIT ROUTINE 01280000 TM XTP7ETYP,ACCCALL RESOURCE ACCESS TIME CALL? 01290000 BO ACCRTN YES, GOTO ACCESS ROUTINE 01300000 TM XTP7ETYP,DSECALL DATASET END CALL? 01310000 BO DSERTN YES, GOTO DATASET END ROUTINE 01320000 B GETOUT THIS SHOULD NEVER HAPPEN 01330000 * 01340000 ********************************************************************** 01350000 * INITIALIZATION ROUTINE: * 01360000 * FUNCTION: * 01370000 * - REQUEST CONTROL AT ACCESS TIME FOR FORMDEFS AND PAGEDEFS * 01380000 * AND FONTS AND OVERLAYS AND PAGE SEGMENTS AND OBJECT * 01390000 * CONTAINERS. * 01400000 * - TO ACTIVATE THE FUNCTION JUST UNCOMMENT THE LINE WITH * 01410000 * XTP7NACC * 01420000 * - REQUEST CONTROL AT DSE TIME FOR FORMDEFS AND PAGEDEFS * 01430000 * AND FONTS AND OVERLAYS AND PAGE SEGMENTS * 01440000 * - TO ACTIVATE THE FUNCTION JUST UNCOMMENT THE LINE WITH * 01450000 * XTP7NDEL * 01460000 ********************************************************************** 01470000 * 01480000 INITRTN EQU * 01490000 * REQUEST CONTROL AT ACCESS TIME 01500000 * MVI XTP7NACC,XTP7AFD+XTP7APD+XTP7ACF+XTP7AMO+XTP7APS+XTP7AOC 01510000 * REQUEST CONTROL AT DATA SET END TIME 01520000 * MVI XTP7NDEL,XTP7DPD+XTP7DFD+XTP7DCF+XTP7DMO+XTP7DPS 01530000 B GETOUT EXIT APSUX07 01540000 * 01550000 ********************************************************************** 01560000 * ACCESS ROUTINE: * 01570000 * FUNCTION: * 01580000 * - CHECK DATASET TYPE AND DON'T PROCESS THE SYSTEM DEFAULT, * 01590000 * JOB HEADER, JOB TRAILER, DATA SET HEADER, AND MESSAGE DATA * 01600000 * SET * 01610000 * - DETERMINE RESOURCE TYPE * 01620000 * - JUST UNCOMMENT THE LINES FOR THE RESOURCES THAT YOU * 01630000 * WISH TO BE CALLED FOR IN THE ACCESS CALL * 01640000 ********************************************************************** 01650000 * 01660000 ACCRTN EQU * 01670000 * TEST FLAGS FOR NON-USER DATASET 01680000 TM XTP7DSAT,XTP7PDFT+XTP7PJHD+XTP7PJTR+XTP7PDSH+XTP7PMDS 01690000 BNZ GETOUT EXIT IF NON-USER DATA SET 01700000 * 01710000 * TM XTP7RTYP,PDEF IS THIS A PAGEDEF? 01720000 * BO ACCPDEF YES 01730000 * TM XTP7RTYP,FDEF IS THIS A FORMDEF? 01740000 * BO ACCFDEF YES 01750000 * TM XTP7RTYP,FONT IS THIS A FONT? 01760000 * BO ACCFONT YES 01770000 * TM XTP7RTYP,OVLY IS THIS AN OVERLAY? 01780000 * BO ACCOVLY YES 01790000 * TM XTP7RTYP,PSEG IS THIS A PAGE SEGMENT? 01800000 * BO ACCPSEG YES 01810000 * TM XTP7RTYP,OC IS THIS AN OBJECT CONTAINER? 01820000 * BO ACCOC YES 01830000 B GETOUT EXIT, WE'RE DONE 01840000 * 01850000 ********************************************************************** 01860000 * PAGEDEFS 01870000 * 01880000 * - RELOADS UP TO 2 PAGEDEFS (MORE CAN BE RELOADED JUST BY 01890000 * REPLICATING THE CODE) 01900000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 01910000 * - SUBSTITUTES FOR UP TO 2 PAGEDEFS (MORE CAN BE SUBSTITUTED 01920000 * FOR BY REPLICATING THE CODE) 01930000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 01940000 ********************************************************************** 01950000 * 01960000 ACCPDEF EQU * 01970000 WTO '***EXIT 07 ACCESS FOR PAGEDEF***',ROUTCDE=2,DESC=6 01980000 CLC RLSTNAME,LDPDEF1 CHECK TO SEE IF RELOAD 01990000 BNE RLDPDEF2 CHECK FOR ANOTHER PDEF RELOAD 02000000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02010000 WTO '**PAGEDEF 1 RELOADED**',ROUTCDE=2,DESC=6 02020000 RLDPDEF2 CLC RLSTNAME,LDPDEF2 CHECK TO SEE IF RELOAD 02030000 BNE SBPDEF1 IF NOT RELOAD THEN CHECK SUBST 02040000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02050000 WTO '**PAGEDEF 2 RELOADED**',ROUTCDE=2,DESC=6 02060000 SBPDEF1 CLC RLSTNAME,SUBPDEF1 CHECK TO SEE IF SUBSTITUTION 02070000 BNE SBPDEF2 CHECK FOR ANOTHER PDEF SUBST 02080000 MVC RLSTNAME,NEWPDEF1 SUBSTITUTE NEW PAGEDEF 02090000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 02100000 WTO '**PAGEDEF 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 02110000 SBPDEF2 CLC RLSTNAME,SUBPDEF2 CHECK TO SEE IF SUBSTITUTION 02120000 BNE GETOUT EXIT WE ARE DONE 02130000 MVC RLSTNAME,NEWPDEF2 SUBSTITUTE NEW PAGEDEF 02140000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 02150000 WTO '**PAGEDEF 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 02160000 B GETOUT EXIT, WE'RE DONE 02170000 * 02180000 ********************************************************************** 02190000 * FORMDEFS 02200000 * 02210000 * - RELOADS UP TO 2 FORMDEFS (MORE CAN BE RELOADED JUST BY 02220000 * REPLICATING THE CODE) 02230000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 02240000 * - SUBSTITUTES FOR UP TO 2 FORMDEFS (MORE CAN BE SUBSTITUTED 02250000 * FOR BY REPLICATING THE CODE) 02260000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 02270000 ********************************************************************** 02280000 * 02290000 ACCFDEF EQU * 02300000 WTO '***EXIT 07 ACCESS FOR FORMDEF***',ROUTCDE=2,DESC=6 02310000 CLC RLSTNAME,LDFDEF1 CHECK TO SEE IF RELOAD 02320000 BNE RLDFDEF2 CHECK FOR ANOTHER FDEF RELOAD 02330000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02340000 WTO '**FORMDEF 1 RELOADED**',ROUTCDE=2,DESC=6 02350000 RLDFDEF2 CLC RLSTNAME,LDFDEF2 CHECK TO SEE IF RELOAD 02360000 BNE SBFDEF1 IF NOT RELOAD THEN CHECK SUBST 02370000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02380000 WTO '**FORMDEF 2 RELOADED**',ROUTCDE=2,DESC=6 02390000 SBFDEF1 CLC RLSTNAME,SUBFDEF1 CHECK TO SEE IF SUBSTITUTION 02400000 BNE SBFDEF2 CHECK IF ANOTHER FDEF SUBST 02410000 MVC RLSTNAME,NEWFDEF1 SUBSTITUTE NEW FORMDEF 02420000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 02430000 WTO '**FORMDEF 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 02440000 SBFDEF2 CLC RLSTNAME,SUBFDEF2 CHECK TO SEE IF SUBSTITUTION 02450000 BNE GETOUT EXIT WE ARE DONE 02460000 MVC RLSTNAME,NEWFDEF2 SUBSTITUTE NEW FORMDEF 02470000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 02480000 WTO '***FORMDEF 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 02490000 B GETOUT EXIT, WE'RE DONE 02500000 * 02510000 ********************************************************************** 02520000 * FONTS 02530000 * 02540000 * - HANDLES CODED FONTS AS WELL AS CP/FN PAIRS 02550000 * - RELOADS UP TO 2 FONTS (MORE CAN BE RELOADED JUST BY 02560000 * REPLICATING THE CODE) 02570000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 02580000 * - SUBSTITUTES FOR UP TO 2 FONTS (MORE CAN BE SUBSTITUTED 02590000 * FOR BY REPLICATING THE CODE) 02600000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 02610000 * - CAN SET THE VERTICAL FONT SIZE, HORIZONTAL FONT SIZE, AND 02620000 * HORIZONTAL SCALE FONT OF THE SUBSTITUTED FONT 02630000 * - JUST UNCOMMENT THE CODE AND FILL IN THE CORRECT CONSTANT 02640000 ********************************************************************** 02650000 * 02660000 ACCFONT EQU * 02670000 WTO '***EXIT 07 ACCESS FOR FONT***',ROUTCDE=2,DESC=6 02680000 CLC RLSTNAME,NULLFONT IF NOT CODED FONT 02690000 BE CPFN PROCESS CP/FN PAIR 02700000 CLC RLSTNAME,LDFONT1 CHECK TO SEE IF RELOAD 02710000 BNE RLDFONT2 IF NOT RELOAD THEN CHECK SUBST 02720000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02730000 WTO '**FONT 1 RELOADED**',ROUTCDE=2,DESC=6 02740000 B SBFONT1 CHECK FOR FONT SUBST @DXC 02750000 RLDFONT2 CLC RLSTNAME,LDFONT2 CHECK TO SEE IF RELOAD 02760000 BNE SBFONT1 IF NOT RELOAD THEN CHECK SUBST 02770000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 02780000 WTO '**FONT 2 RELOADED**',ROUTCDE=2,DESC=6 02790000 SBFONT1 CLC RLSTNAME,SUBFONT1 CHECK TO SEE IF SUBSTITUTION 02800000 BNE SBFONT2 CHECK IF ANOTHER FONT SUBST 02810000 MVC RLSTNAME,NEWFONT1 SUBSTITUTE NEW FONT 02820000 WTO '**FONT 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 02830000 * MVC RLSTVFS(2),VFS SET VERTICAL FONT SIZE 02840000 * WTO '**VERTICAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 02850000 * MVC RLSTHFS(2),HFS SET HORIZONTAL FONT SIZE 02860000 * WTO '**HORIZONTAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 02870000 * MVC RLSTHSCF(2),HSF SET HORIZONTAL SCALE FACTOR 02880000 * WTO '**HORIZONTAL SCALE FACTOR CHANGED**',ROUTCDE=2,DESC=6 02890000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 02900000 B NEXTFONT CHECK TO SEE IF ANOTHER FONT 02910000 SBFONT2 CLC RLSTNAME,SUBFONT2 CHECK TO SEE IF SUBSTITUTION 02920000 BNE NEXTFONT CHECK TO SEE IF ANOTHER FONT 02930000 MVC RLSTNAME,NEWFONT2 SUBSTITUTE NEW FONT 02940000 WTO '**FONT 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 02950000 * MVC RLSTVFS(2),VFS SET VERTICAL FONT SIZE 02960000 * WTO '**VERTICAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 02970000 * MVC RLSTHFS(2),HFS SET HORIZONTAL FONT SIZE 02980000 * WTO '**HORIZONTAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 02990000 * MVC RLSTHSCF(2),HSF SET HORIZONTAL SCALE FACTOR 03000000 * WTO '**HORIZONTAL SCALE FACTOR CHANGED**',ROUTCDE=2,DESC=6 03010000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 03020000 B NEXTFONT CHECK TO SEE IF ANOTHER FONT 03030000 CPFN CLC RLSTPAIR,LDCPFN1 CHECK TO SEE IF RELOAD 03040000 BNE RLDCPFN2 IF NOT RELOAD THEN CHECK SUBST 03050000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 03060000 WTO '**CPFN 1 RELOADED**',ROUTCDE=2,DESC=6 03070000 B SBCPFN1 CHECK FOR SUBST @DXC 03080000 RLDCPFN2 CLC RLSTPAIR,LDCPFN2 CHECK TO SEE IF RELOAD 03090000 BNE SBCPFN1 IF NOT RELOAD THEN CHECK SUBST 03100000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 03110000 WTO '**CPFN 2 RELOADED**',ROUTCDE=2,DESC=6 03120000 SBCPFN1 CLC RLSTPAIR,SUBCPFN1 CHECK TO SEE IF SUBSTITUTION 03130000 BNE SBCPFN2 CHECK IF ANOTHER FONT SUBST 03140000 MVC RLSTPAIR,NEWCPFN1 SUBSTITUTE NEW FONT 03150000 WTO '**CPFN 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 03160000 * MVC RLSTVFS(2),VFS SET VERTICAL FONT SIZE 03170000 * WTO '**VERTICAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 03180000 * MVC RLSTHFS(2),HFS SET HORIZONTAL FONT SIZE 03190000 * WTO '**HORIZONTAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 03200000 * MVC RLSTHSCF(2),HSF SET HORIZONTAL SCALE FACTOR 03210000 * WTO '**HORIZONTAL SCALE FACTOR CHANGED**',ROUTCDE=2,DESC=6 03220000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 03230000 B NEXTFONT CHECK TO SEE IF ANOTHER FONT 03240000 SBCPFN2 CLC RLSTPAIR,SUBCPFN2 CHECK TO SEE IF SUBSTITUTION 03250000 BNE NEXTFONT CHECK TO SEE IF ANOTHER FONT 03260000 MVC RLSTPAIR,NEWCPFN2 SUBSTITUTE NEW FONT 03270000 WTO '**CPFN 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 03280000 * MVC RLSTVFS(2),VFS SET VERTICAL FONT SIZE 03290000 * WTO '**VERTICAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 03300000 * MVC RLSTHFS(2),HFS SET HORIZONTAL FONT SIZE 03310000 * WTO '**HORIZONTAL FONT SIZE CHANGED**',ROUTCDE=2,DESC=6 03320000 * MVC RLSTHSCF(2),HSF SET HORIZONTAL SCALE FACTOR 03330000 * WTO '**HORIZONTAL SCALE FACTOR CHANGED**',ROUTCDE=2,DESC=6 03340000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 03350000 B NEXTFONT CHECK TO SEE IF ANOTHER FONT 03360000 NEXTFONT EQU * 03370000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 03380000 BE GETOUT EXIT, WE ARE DONE 03390000 L RLSTPTR,RLSTNEXT YES, NOVE POINTER TO NEXT RLST 03400000 L RLSTEPTR,RLSTEXTP LOAD ADDRESS OF EXTENSION 03410000 B ACCFONT BRANCH TO CHECK THE NEXT FONT 03420000 * 03430000 ********************************************************************** 03440000 * OVERLAYS 03450000 * 03460000 * - RELOADS UP TO 2 OVERLAYS (MORE CAN BE RELOADED JUST BY 03470000 * REPLICATING THE CODE) 03480000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 03490000 * - SUBSTITUTES FOR UP TO 2 OVERLAYS (MORE CAN BE SUBSTITUTED 03500000 * FOR BY REPLICATING THE CODE) 03510000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 03520000 ********************************************************************** 03530000 * 03540000 ACCOVLY EQU * 03550000 WTO '***EXIT 07 ACCESS FOR OVERLAY***',ROUTCDE=2,DESC=6 03560000 CLC RLSTNAME,LDOVLY1 CHECK TO SEE IF RELOAD 03570000 BNE RLDOVLY2 CHECK IF ANOTHER OVLY RELOAD 03580000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 03590000 WTO '**OVERLAY 1 RELOADED**',ROUTCDE=2,DESC=6 03600000 B SBOVLY1 CHECK FOR SUBST @DXC 03610000 RLDOVLY2 CLC RLSTNAME,LDOVLY2 CHECK TO SEE IF RELOAD 03620000 BNE SBOVLY1 IF NOT RELOAD THEN CHECK SUBST 03630000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 03640000 WTO '**OVERLAY 2 RELOADED**',ROUTCDE=2,DESC=6 03650000 SBOVLY1 CLC RLSTNAME,SUBOVLY1 CHECK TO SEE IF SUBSTITUTION 03660000 BNE SBOVLY2 CHECK IF ANOTHER OVLY SUBST 03670000 MVC RLSTNAME,NEWOVLY1 SUBSTITUTE NEW OVERLAY 03680000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 03690000 WTO '***OVERLAY 1 SUBSTITUTED***',ROUTCDE=2,DESC=6 03700000 B NEXTOVLY GO TO NEXT OVLY IF THERE IS ONE 03710000 SBOVLY2 CLC RLSTNAME,SUBOVLY2 CHECK TO SEE IF SUBSTITUTION 03720000 BNE NEXTOVLY GO TO NEXT OVLY @DXC 03730000 * IF THERE IS ONE @DXA 03740000 MVC RLSTNAME,NEWOVLY2 SUBSTITUTE NEW FORMDEF 03750000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 03760000 WTO '***OVERLAY 2 SUBSTITUTED***',ROUTCDE=2,DESC=6 03770000 B NEXTOVLY GO TO NEXT OVLY IF THERE IS ONE 03780000 NEXTOVLY EQU * 03790000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 03800000 BE GETOUT EXIT, WE ARE DONE 03810000 L RLSTPTR,RLSTNEXT YES, NOVE POINTER TO NEXT RLST 03820000 B ACCOVLY BRANCH TO CHECK THE NEXT OVLY 03830000 * 03840000 ********************************************************************** 03850000 * PAGE SEGMENTS 03860000 * 03870000 * - RELOADS UP TO 2 PAGE SEGMENTS (MORE CAN BE RELOADED JUST BY 03880000 * REPLICATING THE CODE) 03890000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 03900000 * - SUBSTITUTES FOR UP TO 2 PAGE SEGMENTS (MORE CAN BE SUBSTITUTED 03910000 * FOR BY REPLICATING THE CODE) 03920000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 03930000 ********************************************************************** 03940000 * 03950000 ACCPSEG EQU * 03960000 WTO '***EXIT 07 ACCESS FOR PAGE SEGMENT*',ROUTCDE=2,DESC=6 03970000 CLC RLSTNAME,LDPSEG1 CHECK TO SEE IF RELOAD 03980000 BNE RLDPSEG2 IF NOT RELOAD THEN CHECK SUBST 03990000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 04000000 WTO '***PAGE SEGMENT 1 RELOADED***',ROUTCDE=2,DESC=6 @DXC 04010000 B SBPSEG1 CHECK FOR SUBST @DXC 04020000 RLDPSEG2 CLC RLSTNAME,LDPSEG2 CHECK TO SEE IF RELOAD 04030000 BNE SBPSEG1 IF NOT RELOAD THEN CHECK SUBST 04040000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 04050000 WTO '***PAGE SEGMENT 2 RELOADED***',ROUTCDE=2,DESC=6 @DXC 04060000 SBPSEG1 CLC RLSTNAME,SUBPSEG1 CHECK TO SEE IF SUBSTITUTION 04070000 BNE SBPSEG2 CHECK IF ANOTHER PSEG SUBST 04080000 MVC RLSTNAME,NEWPSEG1 SUBSTITUTE NEW FORMDEF 04090000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 04100000 WTO '**PAGE SEGMENT 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 @DXC 04110000 B NEXTPSEG CHECK IF ANOTHER PSEG 04120000 SBPSEG2 CLC RLSTNAME,SUBPSEG2 CHECK TO SEE IF SUBSTITUTION 04130000 BNE NEXTPSEG EXIT WE ARE DONE 04140000 MVC RLSTNAME,NEWPSEG2 SUBSTITUTE NEW FORMDEF 04150000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 04160000 WTO '**PAGE SEGMENT 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 @DXC 04170000 NEXTPSEG EQU * 04180000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 04190000 BE GETOUT EXIT, WE ARE DONE 04200000 L RLSTPTR,RLSTNEXT YES, NOVE POINTER TO NEXT RLST 04210000 B ACCPSEG BRANCH TO CHECK THE NEXT PSEG 04220000 * 04230000 ********************************************************************** 04240000 * OBJECT CONTAINERS 04250000 * 04260000 * - RELOADS UP TO 2 OBJECT CONTAINERS (MORE CAN BE RELOADED JUST BY 04270000 * REPLICATING THE CODE) 04280000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 04290000 * - SUBSTITUTES FOR UP TO 2 OBJECT CONTAINERS (MORE CAN BE 04300000 * SUBSTITUTED FOR BY REPLICATING THE CODE) 04310000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 04320000 ********************************************************************** 04330000 * 04340000 ACCOC EQU * 04350000 WTO '***EXIT 07 ACCESS FOR OBJ CONT***',ROUTCDE=2,DESC=6 04360000 CLC RLSTNAME,LDOC1 CHECK TO SEE IF RELOAD 04370000 BNE RLDOC2 CHECK FOR ANOTHER OC RELOAD 04380000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 04390000 WTO '**OBJ CONT 1 RELOADED**',ROUTCDE=2,DESC=6 04400000 RLDOC2 CLC RLSTNAME,LDOC2 CHECK TO SEE IF RELOAD 04410000 BNE SBOC1 IF NOT RELOAD THEN CHECK SUBST 04420000 OI RLSTAFLG,RLSTLOAD REQUEST RESOURCE LOAD FROM DASD 04430000 WTO '**OBJ CONT 2 RELOADED**',ROUTCDE=2,DESC=6 04440000 SBOC1 CLC RLSTNAME,SUBOC1 CHECK TO SEE IF SUBSTITUTION 04450000 BNE SBOC2 CHECK FOR ANOTHER OC SUBST 04460000 MVC RLSTNAME,NEWOC1 SUBSTITUTE NEW OBJ CONT 04470000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 04480000 WTO '**OBJ CONT 1 SUBSTITUTED**',ROUTCDE=2,DESC=6 04490000 SBOC2 CLC RLSTNAME,SUBOC2 CHECK TO SEE IF SUBSTITUTION 04500000 BNE GETOUT EXIT WE ARE DONE 04510000 MVC RLSTNAME,NEWOC2 SUBSTITUTE NEW OBJ CONT 04520000 OI RLSTAFLG,RLSTSMSG ISSUE SUBSTITUTION MESSAGE 04530000 WTO '**OBJ CONT 2 SUBSTITUTED**',ROUTCDE=2,DESC=6 04540000 B GETOUT EXIT, WE'RE DONE 04550000 * 04560000 ********************************************************************** 04570000 * DATA SET END ROUTINE 04580000 * 04590000 * - DETERMINE RESOURCE TYPE 04600000 ********************************************************************** 04610000 * 04620000 DSERTN EQU * 04630000 * TM XTP7RTYP,PDEF IS THIS A PAGEDEF? 04640000 * BO DSEPDEF YES 04650000 * TM XTP7RTYP,FDEF IS THIS A FORMDEF? 04660000 * BO DSEFDEF YES 04670000 * TM XTP7RTYP,FONT IS THIS A FONT? 04680000 * BO DSEFONT YES 04690000 * TM XTP7RTYP,OVLY IS THIS AN OVERLAY? 04700000 * BO DSEOVLY YES 04710000 * TM XTP7RTYP,PSEG IS THIS A PAGE SEGMENT? 04720000 * BO DSEPSEG YES 04730000 B GETOUT EXIT, WE'RE DONE 04740000 * 04750000 ********************************************************************** 04760000 * PAGEDEFS 04770000 * 04780000 * - SET RRLV FOR PAGEDEF 04790000 * - TO SET THE RRLV VALUE JUST UNCOMMENT THE CODE FOR THE 04800000 * RRLV AND THEN CHANGE THE CONSTANT FOR THE RRLV FROM 0 04810000 * TO THE DESIRED VALUE. 04820000 * - KEEPS OR DELETES UP TO 2 PAGEDEFS (MORE CAN BE KEPT OR DELETED 04830000 * BY REPLICATING THE CODE) 04840000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 04850000 * AND UNCOMMENT THE APPROPRIATE CODE 04860000 ********************************************************************** 04870000 * 04880000 DSEPDEF EQU * 04890000 WTO '***EXIT 07 DSE FOR PAGEDEF***',ROUTCDE=2,DESC=6 04900000 * MVC XTP7RPD,PDRRLV Set the page def RRLV 04910000 * WTO '**PAGE DEF RRLV CHANGED**',ROUTCDE=2,DESC=6 04920000 CLC RLSTNAME,DSEPDEF1 CHECK TO SEE IF KEEP RESOURCE 04930000 BNE DSEPDEFX CHECK FOR ANOTHER PDEF KEEP 04940000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 04950000 * WTO '**PAGEDEF KEPT**',ROUTCDE=2,DESC=6 04960000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 04970000 * WTO '**PAGEDEF DELETED**',ROUTCDE=2,DESC=6 04980000 B NXTPDEF1 EXIT WE ARE DONE 04990000 DSEPDEFX CLC RLSTNAME,DSEPDEF2 CHECK TO SEE IF KEEP RESOURCE 05000000 BNE NXTPDEF1 IF NO MATCH THEN TRY NEXT 05010000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05020000 * WTO '**PAGEDEF KEPT**',ROUTCDE=2,DESC=6 05030000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05040000 * WTO '**PAGEDEF DELETED**',ROUTCDE=2,DESC=6 05050000 NXTPDEF1 EQU * 05060000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 05070000 BE GETOUT EXIT, WE ARE DONE 05080000 L RLSTPTR,RLSTNEXT YES, MOVE POINTER TO NEXT RLST 05090000 B DSEPDEF BRANCH TO CHECK THE NEXT PDEF 05100000 * 05110000 ********************************************************************** 05120000 * FORMDEFS 05130000 * 05140000 * - SET RRLV FOR FORMDEF 05150000 * - TO SET THE RRLV VALUE JUST UNCOMMENT THE CODE FOR THE 05160000 * RRLV AND THEN CHANGE THE CONSTANT FOR THE RRLV FROM 0 05170000 * TO THE DESIRED VALUE. 05180000 * - KEEPS OR DELETES UP TO 2 FORMDEFS (MORE CAN BE KEPT OR DELETED 05190000 * BY REPLICATING THE CODE) 05200000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 05210000 * AND UNCOMMENT THE APPROPRIATE CODE 05220000 ********************************************************************** 05230000 * 05240000 DSEFDEF EQU * 05250000 WTO '***EXIT 07 DSE FOR FORMDEF***',ROUTCDE=2,DESC=6 05260000 * MVC XTP7RFD,FDRRLV Set the form def RRLV 05270000 * WTO '**FORM DEF RRLV CHANGED**',ROUTCDE=2,DESC=6 05280000 CLC RLSTNAME,DSEFDEF1 CHECK TO SEE IF KEEP RESOURCE 05290000 BNE DSEFDEFX CHECK FOR ANOTHER FDEF KEEP 05300000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05310000 * WTO '**FORMDEF KEPT**',ROUTCDE=2,DESC=6 05320000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05330000 * WTO '**FORMDEF DELETED**',ROUTCDE=2,DESC=6 05340000 B NXTFDEF1 EXIT WE ARE DONE 05350000 DSEFDEFX CLC RLSTNAME,DSEFDEF2 CHECK TO SEE IF KEEP RESOURCE 05360000 BNE NXTFDEF1 IF NO MATCH THEN TRY NEXT 05370000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05380000 * WTO '**FORMDEF KEPT**',ROUTCDE=2,DESC=6 05390000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05400000 * WTO '**FORMDEF DELETED**',ROUTCDE=2,DESC=6 05410000 NXTFDEF1 EQU * 05420000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 05430000 BE GETOUT EXIT, WE ARE DONE 05440000 L RLSTPTR,RLSTNEXT YES, MOVE POINTER TO NEXT RLST 05450000 B DSEFDEF BRANCH TO CHECK THE NEXT PDEF 05460000 * 05470000 ********************************************************************** 05480000 * OVERLAYS 05490000 * 05500000 * - KEEPS OR DELETES UP TO 2 OVERLAYS (MORE CAN BE KEPT OR DELETED 05510000 * BY REPLICATING THE CODE) 05520000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 05530000 * AND UNCOMMENT THE APPROPRIATE CODE 05540000 ********************************************************************** 05550000 * 05560000 DSEOVLY EQU * 05570000 WTO '***EXIT 07 DSE FOR OVERLAY***',ROUTCDE=2,DESC=6 05580000 CLC RLSTNAME,DSEOVLY1 CHECK TO SEE IF KEEP RESOURCE 05590000 BNE DSEOVLYX CHECK FOR ANOTHER OVLY KEEP 05600000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05610000 * WTO '**OVERLAY KEPT**',ROUTCDE=2,DESC=6 05620000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05630000 * WTO '**OVERLAY DELETED**',ROUTCDE=2,DESC=6 05640000 B NXTOVLY1 EXIT WE ARE DONE 05650000 DSEOVLYX CLC RLSTNAME,DSEOVLY2 CHECK TO SEE IF KEEP RESOURCE 05660000 BNE NXTOVLY1 IF NO MATCH THEN TRY NEXT 05670000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05680000 * WTO '**OVERLAY KEPT**',ROUTCDE=2,DESC=6 05690000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05700000 * WTO '**OVERLAY DELETED**',ROUTCDE=2,DESC=6 05710000 NXTOVLY1 EQU * 05720000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 05730000 BE GETOUT EXIT, WE ARE DONE 05740000 L RLSTPTR,RLSTNEXT YES, MOVE POINTER TO NEXT RLST 05750000 B DSEOVLY BRANCH TO CHECK THE NEXT PDEF 05760000 * 05770000 ********************************************************************** 05780000 * PAGE SEGMENTS 05790000 * 05800000 * - SET RRLV FOR PAGE SEGMENTS 05810000 * - TO SET THE RRLV VALUE JUST UNCOMMENT THE CODE FOR THE 05820000 * RRLV AND THEN CHANGE THE CONSTANT FOR THE RRLV FROM 0 05830000 * TO THE DESIRED VALUE. 05840000 * - KEEPS OR DELETES UP TO 2 PAGE SEGMENTS (MORE CAN BE KEPT OR 05850000 * DELETED BY REPLICATING THE CODE) 05860000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 05870000 * AND UNCOMMENT THE APPROPRIATE CODE 05880000 ********************************************************************** 05890000 * 05900000 DSEPSEG EQU * 05910000 WTO '***EXIT 07 DSE FOR PAGE SEGMENT***',ROUTCDE=2,DESC=6 05920000 * MVC XTP7RPS,PSRRLV Set the page segment RRLV 05930000 * WTO '**PAGE SEGMENT RRLV CHANGED**',ROUTCDE=2,DESC=6 05940000 CLC RLSTNAME,DSEPSEG1 CHECK TO SEE IF KEEP RESOURCE 05950000 BNE DSEPSEGX CHECK FOR ANOTHER PSEG KEEP 05960000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 05970000 * WTO '**PAGE SEGMENT KEPT**',ROUTCDE=2,DESC=6 05980000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 05990000 * WTO '**PAGE SEGMENT DELETED**',ROUTCDE=2,DESC=6 06000000 B NXTPSEG1 EXIT WE ARE DONE 06010000 DSEPSEGX CLC RLSTNAME,DSEPSEG2 CHECK TO SEE IF KEEP RESOURCE 06020000 BNE NXTPSEG1 IF NO MATCH THEN TRY NEXT 06030000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 06040000 * WTO '**PAGE SEGMENT KEPT**',ROUTCDE=2,DESC=6 06050000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 06060000 * WTO '**PAGE SEGMENT DELETED**',ROUTCDE=2,DESC=6 06070000 NXTPSEG1 EQU * 06080000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 06090000 BE GETOUT EXIT, WE ARE DONE 06100000 L RLSTPTR,RLSTNEXT YES, MOVE POINTER TO NEXT RLST 06110000 B DSEPSEG BRANCH TO CHECK THE NEXT PDEF 06120000 * 06130000 ********************************************************************** 06140000 * FONTS 06150000 * 06160000 * - SET RRLV FOR FONTS 06170000 * - TO SET THE RRLV VALUE JUST UNCOMMENT THE CODE FOR THE 06180000 * RRLV AND THEN CHANGE THE CONSTANT FOR THE RRLV FROM 0 06190000 * TO THE DESIRED VALUE. 06200000 * - HANDLES CODED FONTS AS WELL AS CP/FN PAIRS 06210000 * - KEEPS OR DELETES UP TO 2 FONTS (MORE CAN BE KEPT OR 06220000 * DELETED BY REPLICATING THE CODE) 06230000 * - TO ACTIVATE JUST FILL IN THE APPROPRIATE CONSTANTS BELOW 06240000 * AND UNCOMMENT THE APPROPRIATE CODE 06250000 ********************************************************************** 06260000 * 06270000 DSEFONT EQU * 06280000 WTO '***EXIT 07 DSE FOR FONT***',ROUTCDE=2,DESC=6 06290000 * MVC XTP7RCF,CFRRLV Set the coded font RRLV 06300000 * WTO '**CODED FONT RRLV CHANGED**',ROUTCDE=2,DESC=6 06310000 CLC RLSTNAME,NULLFONT IF NOT CODED FONT 06320000 BE CPFNX PROCESS CP/FN PAIR 06330000 CLC RLSTNAME,DSEFONT1 CHECK TO SEE IF KEEP RESOURCE 06340000 BNE DSEFONTX CHECK FOR ANOTHER FONT KEEP 06350000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 06360000 * WTO '**FONT KEPT**',ROUTCDE=2,DESC=6 06370000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 06380000 * WTO '**FONT DELETED**',ROUTCDE=2,DESC=6 06390000 B NXTFONT1 CHECK TO SEE IF ANOTHER FONT 06400000 DSEFONTX CLC RLSTNAME,DSEFONT2 CHECK TO SEE IF KEEP RESOURCE 06410000 BNE NXTFONT1 IF NO MATCH THEN TRY NEXT 06420000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 06430000 * WTO '**FONT KEPT**',ROUTCDE=2,DESC=6 06440000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 06450000 * WTO '**FONT DELETED**',ROUTCDE=2,DESC=6 06460000 B NXTFONT1 CHECK TO SEE IF ANOTHER FONT 06470000 CPFNX CLC RLSTPAIR,DSECPFN1 CHECK TO SEE IF KEEP RESOURCE 06480000 BNE DSECPFNX CHECK FOR ANOTHER CPFN KEEP 06490000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 06500000 * WTO '**CPFN KEPT**',ROUTCDE=2,DESC=6 06510000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 06520000 * WTO '**CPFN DELETED**',ROUTCDE=2,DESC=6 06530000 B NXTFONT1 CHECK TO SEE IF ANOTHER FONT 06540000 DSECPFNX CLC RLSTPAIR,DSECPFN2 CHECK TO SEE IF KEEP RESOURCE 06550000 BNE NXTFONT1 IF NO MATCH THEN TRY NEXT 06560000 * OI RLSTDFLG,RLSTKEEP KEEP THE RESOURCE 06570000 * WTO '**CPFN KEPT**',ROUTCDE=2,DESC=6 06580000 * NI RLSTDFLG,B'01111111' DO NOT KEEP THE RESOURCE 06590000 * WTO '**CPFN DELETED**',ROUTCDE=2,DESC=6 06600000 NXTFONT1 EQU * 06610000 CLC RLSTNEXT,ZERO IS THERE ANOTHER RLST? 06620000 BE GETOUT EXIT, WE ARE DONE 06630000 L RLSTPTR,RLSTNEXT YES, NOVE POINTER TO NEXT RLST 06640000 L RLSTEPTR,RLSTEXTP LOAD ADDRESS OF EXTENSION 06650000 B DSEFONT BRANCH TO CHECK THE NEXT FONT 06660000 ********************************************************************** 06670000 * EXIT LINKAGE * 06680000 ********************************************************************** 06690000 * 06700000 GETOUT EQU * 06710000 SLR R15,R15 PSF EXPECTS ZERO RETURN CODE 06720000 L R13,4(,R13) RESTORE CALLERS SAVE AREA ADDR. 06730000 L R14,12(,R13) RESTORE CALLERS RETURN ADDRESS 06740000 LM R0,R12,20(R13) RESTORE CALLERS REGISTERS 06750000 BR R14 RETURN TO CALLER 06760000 * 06770000 ********************************************************************** 06780000 * EQUATES TO VERIFY TYPE OF EXIT CALL, COMPARE WITH XTP7ETYP * 06790000 ********************************************************************** 06800000 INITCALL EQU B'10000000' RESOURCE MANAGER INITIAL CALL 06810000 BDSCALL EQU B'01000000' BEGINNING OF DATA SET CALL 06820000 ACCCALL EQU B'00100000' RESOURCE ACCESS 06830000 LDBCALL EQU B'00010000' RESOURCE LOAD BEGIN 06840000 LDECALL EQU B'00001000' RESOURCE LOAD END 06850000 DSECALL EQU B'00000100' RESOURCE DELETE AT DATA SET END 06860000 TRMCALL EQU B'00000010' TERMINATION OF FSA 06870000 ********************************************************************** 06880000 * EQUATES TO VERIFY TYPE OF RESOURCE CALL, COMPARE WITH XTP7RTYP * 06890000 ********************************************************************** 06900000 PDEF EQU B'10000000' PAGEDEF 06910000 FDEF EQU B'01000000' FORMDEF 06920000 FONT EQU B'00100000' CODED FONT 06930000 OVLY EQU B'00010000' MEDIUM OVERLAY 06940000 PSEG EQU B'00001000' PAGE SEGMENT 06950000 OC EQU B'00000100' OBJECT CONTAINER 06960000 ********************************************************************** 06970000 * EQUATES FOR RLSTATTR FLAG FIELD * 06980000 ********************************************************************** 06990000 DFLT EQU B'10000000' DEFAULT FD/PD RESOURCE 07000000 MDFLT EQU B'01000000' MODIFIED DEFAULT FD/PD RESOURCE 07010000 INLINE EQU B'00100000' INLINE FD/PD RESOURCE 07020000 SOFTPS EQU B'00010000' SOFT PAGE SEGMENT 07030000 MEFONT EQU B'00001000' MULTIPLE ENTRY FONT 07040000 ********************************************************************** 07050000 * REGISTER EQUATES * 07060000 ********************************************************************** 07070000 R0 EQU 0 07080000 R1 EQU 1 07090000 R2 EQU 2 07100000 R3 EQU 3 07110000 R4 EQU 4 07120000 R5 EQU 5 07130000 R6 EQU 6 07140000 R7 EQU 7 07150000 R8 EQU 8 07160000 R9 EQU 9 07170000 R10 EQU 10 07180000 R11 EQU 11 07190000 R12 EQU 12 07200000 R13 EQU 13 07210000 R14 EQU 14 07220000 R15 EQU 15 07230000 GEXTPTR EQU R5 07240000 XTP7PTR EQU R6 07250000 ECAPTR EQU R7 07260000 RLSTPTR EQU R8 07270000 RLSTEPTR EQU R9 07280000 CULPTR EQU R11 07290000 BASEREG EQU R12 07300000 * * 07310000 ********************************************************************** 07320000 * RESOURCE NAME TO BE RELOADED 07330000 * 07340000 * - TO RELOAD A RESOURCE JUST PLACE THE RESOURCE NAME IN THE 07350000 * APPROPRIATE CONSTANT BELOW 07360000 * - UP TO 2 OF EACH TYPE OF RESOURCE CAN BE RELOADED 07370000 * - TO RELOAD MORE JUST REPLICATE THE CONSTANTS AND THE CODE 07380000 * THAT USES THE CONSTANTS 07390000 ********************************************************************** 07400000 * * 07410000 LDPDEF1 DC CL8'XXXXXXXX' PAGEDEF 07420000 LDPDEF2 DC CL8'XXXXXXXX' PAGEDEF 07430000 LDFDEF1 DC CL8'XXXXXXXX' FORMDEF 07440000 LDFDEF2 DC CL8'XXXXXXXX' FORMDEF 07450000 LDFONT1 DC CL8'XXXXXXXX' FONT 07460000 LDFONT2 DC CL8'XXXXXXXX' FONT 07470000 LDOVLY1 DC CL8'XXXXXXXX' OVERLAY 07480000 LDOVLY2 DC CL8'XXXXXXXX' OVERLAY 07490000 LDPSEG1 DC CL8'XXXXXXXX' PAGE SEGMENT 07500000 LDPSEG2 DC CL8'XXXXXXXX' PAGE SEGMENT 07510000 LDOC1 DC CL8'XXXXXXXX' OBJECT CONTAINER 07520000 LDOC2 DC CL8'XXXXXXXX' OBJECT CONTAINER 07530000 NULLFONT DC XL8'FFFFFFFFFFFFFFFF' NULL FONT NAME 07540000 LDCPFN1 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 07550000 LDCPFN2 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 07560000 ZERO DC F'0' 07570000 * * 07580000 ********************************************************************** 07590000 * RESOURCE NAME TO BE COMPARED FOR SUBSTITUTION 07600000 * 07610000 * - TO SUBSTITUTE FOR A RESOURCE JUST PLACE THE RESOURCE NAME 07620000 * TO BE SUBSTITUTED FOR IN THE APPROPRIATE CONSTANT BELOW AND 07630000 * THE NAME OF THE NEW RESOURCE IN THE NEXT SECTION IN THE 07640000 * APPROPRIATE CONSTANT 07650000 * - UP TO 2 OF EACH TYPE OF RESOURCE CAN BE SUBSTITUTED FOR 07660000 * - TO SUBSTITUTE FOR MORE JUST REPLICATE THE CONSTANTS AND 07670000 * THE CODE THAT USES THE CONSTANTS 07680000 ********************************************************************** 07690000 * * 07700000 SUBPDEF1 DC CL8'YYYYYYYY' PAGEDEF 07710000 SUBPDEF2 DC CL8'YYYYYYYY' PAGEDEF 07720000 SUBFDEF1 DC CL8'YYYYYYYY' FORMDEF 07730000 SUBFDEF2 DC CL8'YYYYYYYY' FORMDEF 07740000 SUBFONT1 DC CL8'YYYYYYYY' FONT 07750000 SUBFONT2 DC CL8'YYYYYYYY' FONT 07760000 SUBOVLY1 DC CL8'YYYYYYYY' OVERLAY 07770000 SUBOVLY2 DC CL8'YYYYYYYY' OVERLAY 07780000 SUBPSEG1 DC CL8'YYYYYYYY' PAGE SEGMENT 07790000 SUBPSEG2 DC CL8'YYYYYYYY' PAGE SEGMENT 07800000 SUBOC1 DC CL8'YYYYYYYY' OBJECT CONTAINER 07810000 SUBOC2 DC CL8'YYYYYYYY' OBJECT CONTAINER 07820000 SUBCPFN1 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 07830000 SUBCPFN2 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 07840000 * * 07850000 ********************************************************************** 07860000 * NEW RESOURCE NAME TO BE USED 07870000 * 07880000 * - TO SUBSTITUTE FOR A RESOURCE JUST PLACE THE NEW RESOURCE 07890000 * NAME IN THE APPROPRIATE CONSTANT BELOW AND THE NAME OF THE 07900000 * RESOURCE TO BE SUBSTITUTED FOR IN THE PREVIOUS SECTION IN 07910000 * THE APPROPRIATE CONSTANT 07920000 * - UP TO 2 OF EACH TYPE OF RESOURCE CAN BE SUBSTITUTED FOR 07930000 * - TO SUBSTITUTE FOR MORE JUST REPLICATE THE CONSTANTS AND 07940000 * THE CODE THAT USES THE CONSTANTS 07950000 ********************************************************************** 07960000 * * 07970000 NEWPDEF1 DC CL8'ZZZZZZZZ' PAGEDEF 07980000 NEWPDEF2 DC CL8'ZZZZZZZZ' PAGEDEF 07990000 NEWFDEF1 DC CL8'ZZZZZZZZ' FORMDEF 08000000 NEWFDEF2 DC CL8'ZZZZZZZZ' FORMDEF 08010000 NEWFONT1 DC CL8'ZZZZZZZZ' FONT 08020000 NEWFONT2 DC CL8'ZZZZZZZZ' FONT 08030000 NEWOVLY1 DC CL8'ZZZZZZZZ' OVERLAY 08040000 NEWOVLY2 DC CL8'ZZZZZZZZ' OVERLAY 08050000 NEWPSEG1 DC CL8'ZZZZZZZZ' PAGE SEGMENT 08060000 NEWPSEG2 DC CL8'ZZZZZZZZ' PAGE SEGMENT 08070000 NEWOC1 DC CL8'ZZZZZZZZ' OBJECT CONTAINER 08080000 NEWOC2 DC CL8'ZZZZZZZZ' OBJECT CONTAINER 08090000 NEWCPFN1 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 08100000 NEWCPFN2 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 08110000 * * 08120000 ********************************************************************** 08130000 * RESOURCE NAME TO BE DELETED OR KEPT AT DSE CALL 08140000 * 08150000 * - TO DELETE OR KEEP A RESOURCE JUST PLACE THE RESOURCE 08160000 * NAME IN THE APPROPRIATE CONSTANT BELOW 08170000 * - UP TO 2 OF EACH TYPE OF RESOURCE CAN BE KEPT OR DELETED 08180000 * - TO KEEP OR DELETE MORE JUST REPLICATE THE CONSTANTS AND 08190000 * THE CODE THAT USES THE CONSTANTS 08200000 ********************************************************************** 08210000 * * 08220000 DSEPDEF1 DC CL8'ZZZZZZZZ' PAGEDEF 08230000 DSEPDEF2 DC CL8'ZZZZZZZZ' PAGEDEF 08240000 DSEFDEF1 DC CL8'ZZZZZZZZ' FORMDEF 08250000 DSEFDEF2 DC CL8'ZZZZZZZZ' FORMDEF 08260000 DSEFONT1 DC CL8'ZZZZZZZZ' FONT 08270000 DSEFONT2 DC CL8'ZZZZZZZZ' FONT 08280000 DSEOVLY1 DC CL8'ZZZZZZZZ' OVERLAY 08290000 DSEOVLY2 DC CL8'ZZZZZZZZ' OVERLAY 08300000 DSEPSEG1 DC CL8'ZZZZZZZZ' PAGE SEGMENT 08310000 DSEPSEG2 DC CL8'ZZZZZZZZ' PAGE SEGMENT 08320000 DSECPFN1 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 08330000 DSECPFN2 DC CL16'XXXXXXXXXXXXXXXX' CPFN PAIR 08340000 * * 08350000 ********************************************************************** 08360000 * MISCELLANEOUS CONSTANTS * 08370000 ********************************************************************** 08380000 * * 08390000 VFS DC H'0' Vertical font size 08400000 HFS DC H'0' Horizontal font size 08410000 HSF DC H'0' Horizontal scale factor 08420000 * * 08430000 ********************************************************************** 08440000 * RRLV CONSTANTS * 08450000 ********************************************************************** 08460000 * * 08470000 PDRRLV DC H'0' Page definition RRLV value 08480000 FDRRLV DC H'0' Form definition RRLV value 08490000 PSRRLV DC H'0' Page segment RRLV value 08500000 CFRRLV DC H'0' Coded font RRLV value 08510000 END 08520000