**** START OF SPECIFICATIONS ***************************************** 00010000 * * 00020000 * * 00030000 *01* MODULE NAME = APSUX03 * 00040000 * * 00050000 * $MOD(APSUX03 ) COMP(APS) PROD(PSF) : VERSION 3.2.0 * 00060000 * * 00070000 *01* DESCRIPTIVE NAME = DATA SET HEADER INSTALLATION EXIT EXAMPLE * 00080000 * * 00090000 *01* STATUS = VERSION 3, RELEASE 2, LEVEL 0 * 00100000 * * 00110000 *01* FUNCTION = * 00120000 * PRINT A DATA SET SEPARATOR PAGE * 00130000 * * 00140000 *02* OPERATION = * 00150000 * 1. CREATE 12 BLOCK LETTER LINE RECORDS FOR THE STEP NAME * 00160000 * 2. PASS THE BLOCK LETTER LINES TO PSF. * 00170000 * * 00180000 *01* NOTES = * 00190000 *02* DEPENDENCIES = NONE * 00200000 *02* RESTRICTIONS = NONE * 00210000 *02* REGISTER CONVENTIONS = * 00220000 * SEE ASSEMBLER EQUATES * 00230000 *02* PATCH LABEL = PSPACE * 00240000 * * 00250000 *01* MODULE TYPE = PROCEDURE * 00260000 *02* PROCESSOR = ASSEMBLER * 00270000 *02* ATTRIBUTES = * 00280000 * REENTRANT, SUPERVISOR STATE, CALLER'S KEY,PAGABLE, * 00290000 * AMODE 31, RMODE ANY * 00300000 * * 00310000 *01* ENTRY POINT = APSUX03 * 00320000 *02* LINKAGE = * 00330000 * R1 = ADDRESS OF A 4 BYTE FIELD WHICH CONTAINS THE * 00340000 * ADDRESS OF APSGEXTP * 00350000 * R15 = ENTRY POINT ADDRESS * 00360000 * R13 = SAVE AREA ADDRESS * 00370000 * * 00380000 *01* INPUT = * 00390000 * * 00400000 *01* OUTPUT = * 00410000 * LINE DATA RECORDS * 00420000 * * 00430000 *01* EXIT NORMAL = RETURN TO CALLER * 00440000 * * 00450000 *01* EXIT ERROR = NONE * 00460000 * * 00470000 *01* EXTERNAL REFERENCES = * 00480000 *02* ROUTINES = * 00490000 * APSUBLK - BUILD BLOCK LETTER RECORDS * 00500000 * APSUPUT - PUT RECORD TO PSF * 00510000 *02* DATA AREAS = * 00520000 * APSGEXTP - PSF INSTALLATION EXIT PARAMETER AREA * 00530000 * APSUECA - PSF EXIT COMMUNICATIONS AREA * 00540000 * IAZJSPA - JES SEPARATOR PAGE AREA * 00550000 *02* INCLUDES = NONE * 00560000 * * 00570000 *01* MACROS = NONE * 00580000 * * 00590000 *01* MESSAGES = NONE * 00600000 * * 00610000 * 01* CHANGE ACTIVITY = * 00620000 * $H3=LAPS0003, HAF1220, 061388, B53KELJ: RELEASE 2.1 * 00630000 * $L1=LAPS0004, HAF1228, 880601, B53KELJ: RELEASE 3.0 * 00640000 * $H5=LAPS0005, HPRF102, 033189, B53KEMC: REL 2.1.0 NEW FUNCT @H5A* 00650000 * $DU=LAPS0007,HPRF310,980604,BDKURLB: Version 3.1.0 @DUA* 00660000 * $DX=LAPS0008,HPRF320,991117,BUQ4RLB: Version 3.2.0 @DXA* 00670000 * * 00680000 **** END OF SPECIFICATIONS ******************************************* 00690000 APSUX03 START 0 @H3C 00700000 TITLE 'DSECT - XTP' 00710000 APSGEXTP LIST=YES 00720000 TITLE 'DSECT - ECA' 00730000 APSUECA LIST=YES 00740000 TITLE 'DSECT - JSPA' 00750000 IAZJSPA LIST=YES 00760000 TITLE 'APSUX03 - INSTALLATION EXIT DATA SET HEADER PROCESSOR' 00770000 APSUX03 CSECT , 00780000 APSUX03 AMODE 31 @H5A 00790000 APSUX03 RMODE ANY @H5A 00800000 MAINENT DS 0H 00810000 USING *,@15 00820000 B PROLOG 00830000 DC AL1(16) 00840000 DC CL8'APSUX03' @H3C 00850000 DC CL8'&SYSDATE' @H3C 00860000 DROP @15 00870000 PROLOG DS 0H 00880000 STM @14,@12,12(@13) SAVE CALLERS REGISTERS 00890000 LR @12,@15 R12 IS THE 00900000 USING APSUX03,@12 BASE REGISTER 00910000 USING APSGEXTP,XTPPTR BASE APSGEXTP ON XTPPTR 00920000 USING APSUECA,ECAPTR BASE APSUECA ON ECAPTR 00930000 USING IAZJSPA,JSPAPTR BASE JSPA ON JSPAPTR 00940000 L @04,0(,@01) GET ADDRESS OF PARM 00950000 L @05,XTPECAP LOAD ADDRESS OF APSUECA 00960000 LR @02,@13 GET ADDRESS OF CALLERS SAVE 00970000 * AREA 00980000 LA @13,ECAUSAVE R13 POINTS TO APSUX03 SAVE 00990000 * AREA 01000000 LA ECAWKPTR,ECAWKBUF GET ECA WORK BUF ADDRESS 01010000 ST @02,4(,@13) SAVE CALLERS SAVE AREA ADDR 01020000 SLR RTNCODE,RTNCODE RESET RETURN CODE 01030000 L JSPAPTR,XTPJSPAP SET POINTER TO JSPA 01040000 L PUTPTR,ECAPUTP SET POINTER TO APSUPUT 01050000 NI ECAFLAGS,B'00111111' RESET LEFT JUSTIFY AND 01060000 * SLANT FLAG 01070000 MVI ECADRF,X'00' RESET RECORD TYPE FLAGS 01080000 OI ECADRF,B'01010000' SET LINE MODE AND MACHINE 01090000 * CODE FLAG 01100000 LA @14,1 GET LENGTH 01110000 ST @14,ECARECLN OF RECORD 01120000 USING BUFWRK,ECAWKPTR BASED BUFWRK ON ECAWKPTR 01130000 LA @00,BUFWRK GET ADDRESS OF 01140000 ST @00,ECARECAD RECORD 01150000 ********************************************************************** 01160000 * PRINT SHORT LINES DOWN THE PAGE TO STEP NAME LINE 01170000 ********************************************************************** 01180000 MVC ECARECLN(4),TWO SET LENGTH OF PRINT LINE 01190000 MVI WRKCC,X'09' SET CC TO WRITE 01200000 MVC PRINTPOS(1),BLANK SET PRINT POSITION TO BLANK 01210000 STH @14,INDEX LOOP INDEX 01220000 LOOP1 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 01230000 BNZ NEXT1 NOT ZERO, EXIT THE LOOP 01240000 LR @15,PUTPTR CALL 01250000 BALR @14,@15 APSUPUT 01260000 LA @14,1 CHECK 01270000 AH @14,INDEX IF 01280000 STH @14,INDEX PRINTED 01290000 C @14,FIFTEEN 15 01300000 BNH LOOP1 LINES 01310000 NEXT1 DS 0H 01320000 ********************************************************************** 01330000 * PRINT THE STEP NAME IN STRAIGHT BLOCK LETTERS 01340000 ********************************************************************** 01350000 LTR RTNCODE,RTNCODE IF RETURN CODE NOT ZERO 01360000 BNZ OUT EXIT 01370000 MVC ECABLKIN(8),JSPJDSSN GET STEP NAME 01380000 L @15,BLKPTR CALL 01390000 BALR @14,@15 APSUBLK 01400000 MVC ECARECLN(4),RECLGTH SET LENGTH OF RECORD 01410000 LA @14,BUFWRK GET RECORD 01420000 ST @14,ECARECAD ADDRESS 01430000 MVI PRINTCC(@14),X'09' SET CC 01440000 LA @14,1 LOOP 01450000 STH @14,INDEX INDEX 01460000 LOOP2 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 01470000 BNZ NEXT2 NOT ZERO, EXIT LOOP 01480000 LR @15,PUTPTR CALL 01490000 BALR @14,@15 APSUPUT 01500000 LA @14,132 GET NEXT 01510000 AL @14,ECARECAD RECORD TO 01520000 ST @14,ECARECAD PRINT 01530000 MVI PRINTCC(@14),X'09' SET CC 01540000 LA @14,1 CHECK 01550000 AH @14,INDEX IF 01560000 STH @14,INDEX PRINTED 01570000 C @14,TWELVE 12 01580000 BNH LOOP2 LINES 01590000 NEXT2 DS 0H 01600000 LTR RTNCODE,RTNCODE IF NON-ZERO RETURN CODE 01610000 BNZ OUT EXIT 01620000 ********************************************************************** 01630000 * PROVIDE 3 BLANK LINES BETWEEN BLOCK LETTER GROUPS 01640000 ********************************************************************** 01650000 LA @14,BUFWRK GET RECORD 01660000 ST @14,ECARECAD ADDRESS 01670000 MVC ECARECLN(4),TWO SET LENGTH OF RECORD 01680000 MVI WRKCC,X'09' SET CC 01690000 MVC PRINTPOS(1),BLANK SET BLANK LINE 01700000 LA @14,1 LOOP 01710000 STH @14,INDEX INDEX 01720000 LOOP3 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 01730000 BNZ NEXT3 NOT ZERO, EXIT 01740000 LR @15,PUTPTR CALL 01750000 BALR @14,@15 APSUPUT 01760000 LA @14,1 CHECK IF 01770000 AH @14,INDEX PRINTED 01780000 STH @14,INDEX THREE 01790000 C @14,THREE LINES 01800000 BNH LOOP3 01810000 NEXT3 DS 0H 01820000 LTR RTNCODE,RTNCODE IF NON-ZERO RETURN CODE 01830000 BNZ OUT EXIT 01840000 ********************************************************************** 01850000 * PRINT THE DD NAME IN BLOCK LETTERS 01860000 ********************************************************************** 01870000 MVC ECABLKIN(8),JSPJDSDD GET DD NAME 01880000 L @15,BLKPTR CALL 01890000 BALR @14,@15 APSUBLK 01900000 MVC ECARECLN(4),RECLGTH SET LENGTH OF RECORD 01910000 LA @14,BUFWRK GET RECORD 01920000 ST @14,ECARECAD ADDRESS 01930000 MVI PRINTCC(@14),X'09' SET CC 01940000 LA @14,1 LOOP 01950000 STH @14,INDEX INDEX 01960000 LOOP4 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 01970000 BNZ NEXT4 NOT ZERO, EXIT 01980000 LR @15,PUTPTR CALL 01990000 BALR @14,@15 APSUPUT 02000000 LA @14,132 GET NEXT 02010000 AL @14,ECARECAD RECORD 02020000 ST @14,ECARECAD TO PRINT 02030000 MVI PRINTCC(@14),X'09' SET CC 02040000 LA @14,1 CHECK IF 02050000 AH @14,INDEX PRINTED 02060000 STH @14,INDEX 12 02070000 C @14,TWELVE LINES 02080000 BNH LOOP4 02090000 NEXT4 DS 0H 02100000 LTR RTNCODE,RTNCODE IF NON-ZERO RETURN CODE 02110000 BNZ OUT EXIT 02120000 ********************************************************************** 02130000 * PROVIDE 3 BLANK LINES BETWEEN BLOCK LETTER GROUPS 02140000 ********************************************************************** 02150000 LA @14,BUFWRK SET RECORD 02160000 ST @14,ECARECAD ADDRESS 02170000 MVC ECARECLN(4),TWO SET LENGTH OF RECORD 02180000 MVI WRKCC,X'09' SET CC 02190000 MVC PRINTPOS(1),BLANK SET BLANK PRINT LINE 02200000 LA @14,1 LOOP 02210000 STH @14,INDEX INDEX 02220000 LOOP5 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 02230000 BNZ NEXT5 NOT ZERO, EXIT 02240000 LR @15,PUTPTR CALL 02250000 BALR @14,@15 APSUPUT 02260000 LA @14,1 CHECK IF 02270000 AH @14,INDEX PRINTED 02280000 STH @14,INDEX THREE 02290000 C @14,THREE BLANK LINES 02300000 BNH LOOP5 02310000 NEXT5 DS 0H 02320000 LTR RTNCODE,RTNCODE IF RETURN CODE NOT ZERO 02330000 BNZ OUT EXIT 02340000 ********************************************************************** 02350000 * PRINT THE SYSOUT CLASS & PRIORITY IN BLOCK LETTERS 02360000 ********************************************************************** 02370000 MVI ECABLKIN+1,C' ' RESET 02380000 MVC ECABLKIN+2(6),ECABLKIN+1 INPUT AREA 02390000 MVC ECABLKIN(1),BLANK TO BLANKS 02400000 MVC ECABLKIN+1(1),JSPJSOCL SET SYSOUT CLASS 02410000 CLI JSPJPRIO,0 IS PRIORITY # SET ? 02420000 BE NOPRTY NOT SET 02430000 BAL @14,CONVERT IF SET, CONVERT PRIORITY 02440000 * # TO PRINTABLE FORM 02450000 NOPRTY DS 0H PRIORITY # IS 0 02460000 L @15,BLKPTR CALL 02470000 BALR @14,@15 APSUBLK 02480000 MVC ECARECLN(4),RECLGTH SET LENGTH OF RECORD 02490000 LA @14,BUFWRK GET RECORD 02500000 ST @14,ECARECAD ADDRESS 02510000 MVI PRINTCC(@14),X'09' SET CC 02520000 LA @14,1 LOOP 02530000 STH @14,INDEX INDEX 02540000 LOOP6 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 02550000 BNZ NEXT6 NOT ZERO, EXIT 02560000 LR @15,PUTPTR CALL 02570000 BALR @14,@15 APSUPUT 02580000 LA @14,132 GET NEXT 02590000 AL @14,ECARECAD RECORD 02600000 ST @14,ECARECAD TO PRINT 02610000 MVI PRINTCC(@14),X'09' SET CC 02620000 LA @14,1 CHECK IF 02630000 AH @14,INDEX PRINTED 02640000 STH @14,INDEX TWELVE 02650000 C @14,TWELVE LINES 02660000 BNH LOOP6 02670000 NEXT6 DS 0H 02680000 OUT DS 0H 02690000 ********************************************************************** 02700000 * EPILOGUE 02710000 ********************************************************************** 02720000 SLR RTNCODE,RTNCODE RESET RETURN CODE 02730000 L @13,4(,@13) RESTORE CALLERS SAVE AREA @ 02740000 L @14,12(,@13) RESTORE CALLERS RETURN @ 02750000 LM @00,@12,20(@13) RESTORE CALLERS REGISTERS 02760000 BR @14 RETURN TO CALLER 02770000 ********************************************************************** 02780000 * CONVERSION ROUTINE TO CONVERT THE DATA SET PRIORITY NUMBER 02790000 * FROM BINARY TO PRINTABLE EBCDIC. 02800000 ********************************************************************** 02810000 CONVERT DS 0H 02820000 SLR PRIOREG,PRIOREG SET PRIORITY # 02830000 IC PRIOREG,JSPJPRIO INTO REGISTER 02840000 CVD PRIOREG,WRKCVD CONVERT THE # TO DEC 02850000 UNPK WRKUNPCK(8),WRKCVD(8) UNPACK THE # 02860000 OI WRKPOS1,X'F0' SET SIGN NIBBLE 02870000 CLI WRKPOS3,X'F0' CHECK FOR PRECEEDING ZERO 02880000 BNE NOZERO NOT ZERO 02890000 MVC WRKPOS3(1),BLANK SET PRECEEDING 0 TO BLANK 02900000 CLI WRKPOS2,X'F0' CHECK FOR PRECEEDING ZERO 02910000 BNE NOZERO NOT ZERO 02920000 MVC WRKPOS2(1),BLANK SET PRECEEDING 0 TO BLANK 02930000 CLI WRKPOS1,X'F0' CHECK FOR PRECEEDING ZERO 02940000 BNE NOZERO NOT ZERO 02950000 MVC WRKPOS1(1),BLANK SET PRECEEDING 0 TO BLANK 02960000 NOZERO DS 0H 02970000 MVC ECABLKIN+4(3),WRKPNUM SET PRIORITY # INTO BLOCK 02980000 * LETTER INPUT FIELD 02990000 BR @14 RETURN TO CALLER 03000000 DS 0H 03010000 PSIZE EQU ((*-APSUX03+99)/100)*5 03020000 DC C'PATCH AREA - APSUX03 88.XXX' 03030000 PSPACE DC 25S(*) 03040000 ORG PSPACE 03050000 DC ((PSIZE+1)/2)S(*) 03060000 ORG , 03070000 APSUX03 CSECT 03080000 ********************************************************************** 03090000 * MISC CONTANTS 03100000 ********************************************************************** 03110000 TWO DC F'2' 03120000 THREE DC F'3' 03130000 TWELVE DC F'12' 03140000 FIFTEEN DC F'15' 03150000 RECLGTH DC F'127' 03160000 BLANK DC X'40' 03170000 ********************************************************************** 03180000 * EQUATES FOR REGISTERS 0-15 03190000 ********************************************************************** 03200000 @00 EQU 00 03210000 @01 EQU 01 03220000 @02 EQU 02 03230000 @03 EQU 03 03240000 @04 EQU 04 03250000 @05 EQU 05 03260000 @06 EQU 06 03270000 @07 EQU 07 03280000 @08 EQU 08 03290000 @09 EQU 09 03300000 @10 EQU 10 03310000 @11 EQU 11 03320000 @12 EQU 12 03330000 @13 EQU 13 03340000 @14 EQU 14 03350000 @15 EQU 15 03360000 ********************************************************************** 03370000 * POINTER REGISTERS AND ROUTINES 03380000 ********************************************************************** 03390000 WRKPTR EQU @02 WORK AREA POINTER 03400000 XTPPTR EQU @04 APSGEXTP POINTER 03410000 ECAPTR EQU @05 APSUECA POINTER 03420000 PRIOREG EQU @06 REGISTER FOR PRIORITY # 03430000 ECAWKPTR EQU @09 ECA WORK BUF POINTER 03440000 PUTPTR EQU @10 APSUPUT POINTER 03450000 JSPAPTR EQU @11 JSPA POINTER 03460000 RTNCODE EQU @15 RETURN CODE 03470000 APSUPUT EQU 0 03480000 APSUBLK EQU 0 03490000 BUFPRI EQU 0 03500000 PRINTCC EQU BUFPRI CC 03510000 BLKPTR EQU ECABLKP APSUBLK POINTER 03520000 ********************************************************************** 03530000 * ECA WORK BUFFER 03540000 ********************************************************************** 03550000 BUFWRK DSECT SEPARATOR WORK BUFFER 03560000 WRKCC DS CL1 CC 03570000 WRKDATA DS CL132 DATA LINE 03580000 BUFBLK EQU WRKDATA WORK BUFFER FOR BLK LETTER 03590000 * ROUTINE 03600000 ORG WRKDATA 03610000 SHORTLIN EQU WRKDATA MAP OF SHORT PRINT LINE 03620000 ORG SHORTLIN 03630000 PRINTPOS DS CL1 SINGLE PRINT POSITION LINE 03640000 * A SHORT LINE IS USED SO 03650000 * THAT EACH LINE ON THE 03660000 * SEPARATOR PAGE CAN BE 03670000 * OVERLAID WITH 'FIXED AREA' 03680000 WORKWRK EQU WRKDATA CONVERSION WORK AREA 03690000 ORG WORKWRK 03700000 DS CL7 03710000 WRKCVD DS CL8 CONVERT TO DEC WORK AREA 03720000 WRKUNPCK DS CL8 UNPACK WORK AREA 03730000 ORG WRKUNPCK 03740000 DS CL5 03750000 WRKPNUM DS CL3 CONVERTED PRIORITY # 03760000 ORG WRKPNUM 03770000 WRKPOS3 DS CL1 PRIORITY POSITION 3 03780000 WRKPOS2 DS CL1 PRIORITY POSITION 2 03790000 WRKPOS1 DS CL1 PRIORITY POSITION 1 03800000 INDEX EQU ECAGWRK 03810000 END APSUX03 03820000