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