//SPNPFASX JOB CLASS=A,MSGCLASS=X,MSGLEVEL=(1,1),NOTIFY=&SYSUID //* ------------------------------------------------------------------- //* //* This is JCL to assemble a routing exit or input record exit //* for the Network Print Facility. //* //* ------------------------------------------------------------------- //ASMMOD PROC //ASM EXEC PGM=ASMA90,PARM='OBJECT,NODECK,XREF(SHORT),LIST', // REGION=2M,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSLIB DD DSN=TCPIP.SEZACMAC,DISP=SHR // DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.MODGEN,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(5,1)) //SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(2,1)) //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(2,1)) //SYSLIN DD DSN=&&OBJ,DISP=(,PASS),UNIT=SYSDA,SPACE=(TRK,(1,1)) //LKED EXEC PGM=IEWL,PARM='LIST,MAP,XREF',REGION=2M,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD SPACE=(CYL,(5,1)),UNIT=SYSDA //SYSLMOD DD DSN=USER.LINKLIB(&MEMBER),DISP=SHR //SYSLIN DD DSNAME=&&OBJ,DISP=(OLD,DELETE) // PEND //BARLINE EXEC ASMMOD,MEMBER=NPFXBARL NPFXBARL TITLE 'Input Record Exit to Generate Barline Overlay' *---------------------------------------------------------------------* * NPFXBARL NPF Input Record Exit * *---------------------------------------------------------------------* * * * COPYRIGHT = NONE * * * * Based on DELBLANK in TCPIP.SEZAINST (SMP/E Name: EZAEC043) * * * * This exit generates PCL commands at the start and end of a * * job to cause the printer to print pages of 132x60 lines in * * A4 Landscape format with a barline overlay. * * * *---------------------------------------------------------------------* NPFXBARL CSECT NPFXBARL AMODE ANY NPFXBARL RMODE ANY * Registers entry NPFXBARL exit R0 EQU 0 n/a work =entry R1 EQU 1 >>IRELIST work =entry R2 EQU 2 n/a work =entry R3 EQU 3 n/a work =entry R4 EQU 4 n/a work =entry R5 EQU 5 n/a work =entry R6 EQU 6 n/a work =entry R7 EQU 7 n/a work =entry R8 EQU 8 n/a >IRXSTATD =entry R9 EQU 9 n/a >RTDATA =entry R10 EQU 10 n/a >IRELIST =entry R11 EQU 11 n/a base 2 =entry R12 EQU 12 n/a base 1 =entry R13 EQU 13 >callsave >EXITSTG =entry R14 EQU 14 >return work =entry R15 EQU 15 >NPFXBARL retcode retcode SPACE 5 USING NPFXBARL,R15 Establish temporary base register B DELB0000 Branch around constants DC CL9'NPFXBARL' Module identifier DC CL9'&SYSDATE' Assembly date DC CL6'&SYSTIME' Assembly time DELBASE2 DC A(NPFXBARL+4096) Second base register if needed SPACE 5 DELB0000 DS 0H STM R14,R12,12(R13) Save caller's registers LR R12,R15 Change base registers DROP R15 Tell assembler USING NPFXBARL,R12,R11 L R11,DELBASE2 Establish second base register L R10,0(,R1) Get address of exit parameter list USING IRELIST,R10 Make exit parameter list addressable L R9,IRERTD Get address of routing data area USING RTDATA,R9 Make routing data area addressable L R8,IRESTRG Get address of IRE static memory USING IRXSTATD,R8 Make IRE static storage addressable ICM R1,15,IRXDSTGA Get address of IRE dynamic storage BNZ DELB0020 Storage has already been allocated LA R2,EXITSTGL Get length of program storage GETMAIN RC,LV=(R2),LOC=ANY Get program storage LTR R15,R15 Did GETMAIN work? BZ DELB0010 Yes WTO 'NPFXBARL GETMAIN FAILED FOR WORKING STORAGE' LA R15,8 No, show error B RET00010 Return to NPF DELB0010 DS 0H ST R1,IRXDSTGA Save dynamic storage address DELB0020 DS 0H ST R1,8(,R13) Complete save area pointers ST R13,4(,R1) LR R13,R1 Point to dynamic storage area USING EXITSTG,R13 Tell assembler SPACE 5 CLC RTFUNCTN(4),=CL8'OPEN' Is this OPEN call? BE OPN00000 Yes CLC RTFUNCTN(3),=CL8'PUT' Is this PUT call? BE PUT00000 Yes CLC RTFUNCTN(5),=CL8'CLOSE' Is this CLOSE call? BE CLS00000 Yes CLC RTFUNCTN(7),=CL8'RELEASE' Is this RELEASE call? BE REL00000 Yes CLC RTFUNCTN(4),=CL8'TERM' Is this TERM call? BE TRM00000 Yes WTO 'NPFXBARL UNKNOWN FUNCTION' LA R15,4 Bad function, show error B RET00000 Return to NPF SPACE 5 *---------------------------------------------------------------------* * Process OPEN call *---------------------------------------------------------------------* OPN00000 DS 0H * Issue message giving attributes of file to be written MVC OPNMSGRF,RTDARTYP Move RECFM to message L R15,RTDABLKS Load BLKSIZE CVD R15,DOUBLE OI DOUBLE+7,X'0F' UNPK OPNMSGBL,DOUBLE+5(3) L R15,RTDARECL Load LRECL CVD R15,DOUBLE OI DOUBLE+7,X'0F' UNPK OPNMSGRL,DOUBLE+5(3) L R15,RTDABUFS Load buffer size CVD R15,DOUBLE OI DOUBLE+7,X'0F' UNPK OPNMSGBF,DOUBLE+5(3) WTO TEXT=OPNMSG * Check that the file has the attributes we require CLC RTDARTYP,=C'VBA' Is output dataset RECFM=VBA? BNE OPN00090 No, cannot process this file MVI IRXFLAG,IRXNEW Set flag for new file XR R15,R15 Zero return code B RET00000 Go return to NPF OPN00090 DS 0H WTO 'NPFXBARL CANNOT PROCESS FILE: RECFM NOT VBA' LA R15,8 No, show error B RET00000 Return to NPF * Informational message to display file attributes OPNMSG DC AL2(OPNMSGLN) OPNMSGTX DC C'NPFXBARL' DC C' RECFM=' OPNMSGRF DC C'XXX' DC C' BLKSZ=' OPNMSGBL DC C'XXXXX' DC C' LRECL=' OPNMSGRL DC C'XXXXX' DC C' BUFSZ=' OPNMSGBF DC C'XXXXX' OPNMSGLN EQU *-OPNMSGTX *---------------------------------------------------------------------* * Process PUT call *---------------------------------------------------------------------* PUT00000 DS 0H CLI IRXFLAG,IRXNEW First PUT to this file? BE PUT00010 Yes, insert header record CLI IRXFLAG,IRX2ND Second PUT to this file? BE PUT00050 Yes, retrieve saved record MVI IREWFLG,X'00' Write this record MVI IRERFLG,X'00' Read next record B PUT00090 Go return to NPF * Processing for first call to the exit PUT00010 DS 0H * Make a copy of the first input record L R3,IREDLEN R3 contains length of input record GETMAIN RC,LV=(R3),LOC=ANY Get buffer storage LTR R15,R15 Did GETMAIN work? BZ PUT00015 Yes WTO 'NPFXBARL GETMAIN FAILED FOR BUFFER STORAGE' LA R15,8 No, show error B RET00000 Return to NPF PUT00015 DS 0H LR R2,R1 Save buffer storage address STM R2,R3,IRXSAVEA Save address,length of saved record L R14,IREBPTR Source for MVCL L R15,IREDLEN Length for MVCL LR R0,R2 Destination for MVCL LR R1,R3 Length for MVCL MVCL R0,R14 Copy record to temporary buffer * Copy the header record to the input record buffer L R2,IREBPTR R2 points to input record area LA R3,HL R3 contains length of header record ST R3,IREDLEN Store length of record to insert MVC 0(HL,R2),HA Move header record to buffer MVI IREWFLG,X'00' Write this record MVI IRERFLG,X'01' Present same record again MVI IRXFLAG,IRX2ND Next call is 2nd call to exit B PUT00090 Give header to NPF * Processing for second call to the exit PUT00050 DS 0H LM R2,R3,IRXSAVEA Load address,length of saved record LR R14,R2 Source for MVCL LR R15,R3 Length for MVCL L R0,IREBPTR Destination for MVCL LR R1,R15 Length for MVCL ST R1,IREDLEN Record length for NPF MVCL R0,R14 Copy saved record FREEMAIN RC,A=(R2),LV=(R3) Release saved record buffer L R2,IREBPTR Get input buffer pointer CLI 4(R2),C'1' Is it form feed? BNE PUT00060 No, pass it through MVI 4(R2),C'+' Change to overstrike PUT00060 DS 0H MVI IREWFLG,X'00' Write this record MVI IRERFLG,X'00' Read next record MVI IRXFLAG,IRXOLD Indicate finished with header PUT00090 DS 0H XR R15,R15 Zero return code B RET00000 Go return to NPF *---------------------------------------------------------------------* * Process CLOSE call *---------------------------------------------------------------------* CLS00000 DS 0H * Insert the trailer record LA R2,TA R2 points to trailer record ST R2,IREBPTR Store address of record to insert LA R3,TL R3 contains trailer record length ST R3,IREDLEN Store length of record to insert MVI IREWFLG,X'00' Write this record MVI IRERFLG,X'00' Normal return from CLOSE XR R15,R15 Zero return code B RET00000 *---------------------------------------------------------------------* * Process RELEASE or TERM call *---------------------------------------------------------------------* REL00000 DS 0H TRM00000 DS 0H LA R2,EXITSTGL Get length of dynamic storage LR R1,R13 Get address of dynamic storage L R13,SAVEAREA+4 Get address of caller's save area FREEMAIN RU,LV=(R2),A=(R1) Free dynamic storage XR R15,R15 Zero return code B RET00010 SPACE 5 *---------------------------------------------------------------------* * Return to NPF *---------------------------------------------------------------------* RET00000 DS 0H Switch back to caller's save area L R13,SAVEAREA+4 Return to caller RET00010 DS 0H Already back to caller's save area ST R15,16(R13) Set return code in saved R15 LM R14,R12,12(R13) Restore caller's registers BSM 0,R14 EJECT *---------------------------------------------------------------------* * Program constants *---------------------------------------------------------------------* LTORG *** * Header record to be transmitted before the print file *** HA EQU * Start of header record DC AL2(HL,0) Record Descriptor Word (RDW) DC C'+' Carriage Control Character (CC) DC X'27',C'E' PCL Reset DC X'27',C'&&k2G' CR=CR,LF=CR+LF,FF=CR+FF DC X'27',C'(s0p' Fixed width character spacing DC C'0T' Lineprinter font DC X'27',C'&&k4S' Elite (12cpi) DC X'27',C'&&l26a' A4 paper size DC C'1o' Landscape DC C'1l' Enable perforation skip DC C'6c' 8lpi DC C'2e' Top margin 2 lines DC C'62F' Page length 62 lines DC X'27',C'&&a3L' Left margin 3 columns * The following macro draws one horizontal stripe 3 lines deep DC X'27',C'&&f2y' Macro ID 2 DC C'0X' Start macro definition DC X'27',C'*r0F' Rotate image DC X'27',C'*v0O' Pattern transparent DC X'27',C'&&a180H' Indent 0.25" DC X'27',C'*c7920h' Rectangle width 11" DC C'270v' Rectangle height 0.375" DC C'10g' Fill 10% grey DC C'2P' Shaded fill DC X'27',C'&&a+540V' Move cursor down 0.75" DC X'27',C'&&f1x' Stop macro definition DC C'10X' Make macro permanent * The following macro defines an overlay of 10 horizontal stripes DC X'27',C'&&f1y' Macro ID 1 DC C'0x' Start macro definition DC C'0S' Save cursor DC X'27',C'&&f2y' Macro ID 2 DC C'3x3x3x3x3x3x3x3x3x3X' Call macro 10 times DC X'27',C'&&f1s' Restore cursor DC C'1x' Stop macro definition DC C'10x' Make macro permanent DC C'4X' Enable overlay HL EQU *-HA Length of header record *** * Trailer record to be transmitted after the print file *** TA EQU * Start of trailer record DC AL2(TL,0) Record Descriptor Word (RDW) DC C'+' Carriage Control Character (CC) DC X'27',C'E' PCL Reset TL EQU *-TA Length of trailer record SPACE 5 IRXSTATD DSECT 16 byte static IRE storage IRXDSTGA DS A Address of dynamic storage area IRXFLAG DS X File status flag IRXNEW EQU X'00' ... first record in file IRX2ND EQU X'01' ... second time for 1st record IRXOLD EQU X'FF' ... not first record in file DS 3X unused IRXSAVEA DS 2A Address,length of saved record SPACE 5 EXITSTG DSECT SAVEAREA DS 18F Save Area DOUBLE DS D Doubleword work area DS 0D Round up to double word boundary EXITSTGL EQU *-EXITSTG Length of dynamic storage area SPACE 5 EZAPPFCD IRE=DSECT, DSECT for input record exit parameters X RDA=DSECT DSECT for routing data area SPACE 5 END , End of NPFXBARL module