DELBLANK TITLE 'Input Record Exit to Delete Leading Blank Pages'
*---------------------------------------------------------------------*
* DELBLANK NPF Sample Input Record Exit *
*---------------------------------------------------------------------*
* *
* COPYRIGHT = NONE *
* *
* SMP/E Distribution Name: EZAEC043 *
* *
* Some applications generating SNA print data streams force a new *
* page at the beginning of independent pieces of work. This *
* correspond with the NPF end-of-file rule specified. *
* *
* Some LPD print managers force a new page between files. *
* *
* If both are true, the printed output will begin with a blank *
* page. This NPF input record exit looks at the carriage control *
* character on the first line of output in files from the NPF VTAM *
* capture point application. If it is a form feed, it is changed *
* to an overstrike so that printing will begin on the first page. *
* *
*---------------------------------------------------------------------*
DELBLANK CSECT
DELBLANK AMODE ANY
DELBLANK RMODE ANY
* Registers entry DELBLANK 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 >DELBSTG =entry
R14 EQU 14 >return work =entry
R15 EQU 15 >DELBLANK retcode retcode
SPACE 5
USING DELBLANK,R15 Establish temporary base register
B DELB0000 Branch around constants
DC CL9'DELBLANK' Module identifier
DC CL9'&SYSDATE' Assembly date
DC CL6'&SYSTIME' Assembly time
DELBASE2 DC A(DELBLANK+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 DELBLANK,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,DELBSTGL Get length of program storage
GETMAIN RC,LV=(R2),LOC=ANY Get program storage
LTR R15,R15 Did GETMAIN work?
BZ DELB0010 Yes
WTO 'DELBLANK GETMAIN FAILED'
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(0,R13) Complete save area pointers
ST R13,4(0,R1)
LR R13,R1 Point to dynamic storage area
USING DELBSTG,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 'DELBLANK UNKNOWN FUNCTION'
LA R15,4 Bad function, show error
B RET00000 Return to NPF
SPACE 5
*---------------------------------------------------------------------*
* Process OPEN call
*---------------------------------------------------------------------*
OPN00000 DS 0H
MVI IRXFLAG,IRXNEW Set flag for new file
XR R15,R15 Zero return code
B RET00000 Go return to NPF
*---------------------------------------------------------------------*
* Process PUT call
*---------------------------------------------------------------------*
PUT00000 DS 0H
CLI IRXFLAG,IRXNEW First PUT to this file?
BNE PUT00020 No, pass it through
MVI IRXFLAG,IRXOLD Only look at first PUT
CLI IRECID,C'V' Is this VTAM application?
BNE PUT00020 No, pass it through
L R2,IREBPTR Get input buffer pointer
CLI RTDARTYP,C'V' Variable length records?
BNE PUT00010 No, continue
LA R2,4(0,R2) Yes, point past record descriptor
PUT00010 DS 0H R2 points to carriage control
CLI 0(R2),C'1' Is it form feed?
BNE PUT00020 No, pass it through
MVI 0(R2),C'+' Change to overstrike
PUT00020 DS 0H
MVI IREWFLG,X'00' Write this record
MVI IRERFLG,X'00' Read next record
XR R15,R15 Zero return code
B RET00000 Go return to NPF
*---------------------------------------------------------------------*
* Process CLOSE call
*---------------------------------------------------------------------*
CLS00000 DS 0H
MVI IREWFLG,X'01' No record to write
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,DELBSTGL 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
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
IRXOLD EQU X'FF' ... not first record in file
DS 3X unused
DS D unused
SPACE 5
DELBSTG DSECT
SAVEAREA DS 18F Save Area
DS 0D Round up to double word boundary
DELBSTGL EQU *-DELBSTG 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 DELBLANK module
z/OS Communications Server: IP Network Print Facility
Copyright IBM Corporation 1990, 2014