 |
If you specify EXIT(TRMEXIT(MYEXIT)), the exit allows the assembler
to open the terminal data set. The exit issues a WTO for the first
68 characters of each terminal record.
If you specify EXIT(TRMEXIT(MYEXIT(EXIT))), the exit opens the
terminal data set. The exit issues a WTO for the first 68 characters
of each terminal record passed to the exit. Figure 1. Example of a user exit (part 1 of
17)MYEXIT TITLE '- EXAMPLE OF A USER EXIT'
***********************************************************************
* *
* This sample user exit demonstrates how to code a user exit. *
* It has code to demonstrate the use of SOURCE, LIBRARY, LISTING, *
* PUNCH, OBJECT, ADATA and TERM exits. *
* *
* This user exit uses the field AXPUSER to anchor the storage it has *
* acquired to make it reenterable. If the user exit does not need to *
* be reenterable, this code is not required. *
* *
* REGISTER USAGE: *
* R0 - WORK *
* R1 - WORK *
* R2 - WORK *
* R3 - WORK *
* R4 - WORK *
* R5 - POINTER TO DCB (z/OS/CMS) ONLY *
* R6 - POINTER TO SOURCE INFORMATION *
* R7 - POINTER TO ERROR BUFFER *
* R8 - POINTER TO BUFFER *
* R9 - POINTER TO REQUEST INFORMATION *
* R10 - POINTER TO ORIGINAL PASSED PARAMETER *
* R11 - NOT USED. *
* R12 - PROGRAM SECTION BASE REGISTER *
* R13 - SAVEAREA AND DYNAMIC STORAGE AREA *
* R14 - RETURN ADDRESS OF CALLING MODULE *
* R15 - ENTRY POINT OF CALLED MODULE *
* *
***********************************************************************
PRINT NOGEN
EJECT
Figure 2. Example of a user exit (part 2 of
17)***********************************************************************
* MYEXIT Entry *
* - Save the registers. *
* - Acquire the dynamic storage on the first entry and save the *
* address in AXPUSER. *
* - Chain the save areas using the forward and backward pointers. *
* - Address the data areas passed. *
* - Process the required exit according to the 'Exit type' passed. *
***********************************************************************
MYEXIT CSECT
STM R14,R12,12(R13) Save registers
LR R12,R15 Set up first base register
USING MYEXIT,R12,R11
LA R11,2048(,R12)
LA R11,2048(,R11) Set up second base register
LR PARMREG,R1 Save parameter list address
USING AXPXITP,PARMREG
L REQREG,AXPRIP Get address of exit parm list
USING AXPRIL,REQREG
ICM R1,B'1111',AXPUSER Get address of user area
BNZ CHAIN Yes, use area
LA 0,WORKLEN Otherwise, get length
GETMAIN R,LV=(0) and getmain storage
ST R1,AXPUSER Save it for later
XC 0(WORKLEN,R1),0(R1) Clear area
CHAIN DS 0H
ST R13,4(R1) Save previous pointer
ST R1,8(R13) Save next pointer
LR R13,R1 Set savearea/workarea address
USING WORKAREA,R13
SPACE 1
L BUFREG,AXPBUFP Get address of buffer
USING BUFF,BUFREG
L ERRREG,AXPERRP Get address of error buffer
USING ERRBUFF,ERRREG
L SRCREG,AXPSIP Get address of source info
USING AXPSIL,SRCREG
L DCBREG,AXPDCBP Get address of DCB
USING IHADCB,DCBREG
SPACE 1
XC AXPRETC,AXPRETC Zero the return code
L R15,AXPTYPE Load the exit type value (1-7)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,EXITADDR(R15) Index into address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
SPACE 1
EXITADDR DC Y(SOURCE-MYEXIT)
DC Y(LIBRARY-MYEXIT)
DC Y(LISTING-MYEXIT)
DC Y(PUNCH-MYEXIT)
DC Y(OBJECT-MYEXIT)
DC Y(ADATA-MYEXIT)
DC Y(TERM-MYEXIT)
DC Y(*-*)
EJECT
Figure 3. Example of a user exit (part 3 of 17)***********************************************************************
* MYEXIT Exit1 *
* - Restore the callers register 13 *
* - Restore the registers and set the register 15 to zero. *
* - Return to the caller. *
***********************************************************************
EXIT1 DS 0H
MVC LASTOP,AXPRTYP+3 Save last operation code
L R13,4(,R13) Unchain save areas
EXIT2 DS 0H
LM R14,R12,12(R13) Restore callers registers
LA R15,0 Set the return code
BSM R0,R14 Return to caller
SPACE 1
***********************************************************************
* MYEXIT - Free storage *
* - Called on a CLOSE request. *
* - Free the storage acquired and zero AXPUSER. *
* - Go to EXIT (after R13 is restored) *
***********************************************************************
FREESTOR DS 0H
XC AXPUSER,AXPUSER Zero User field
LA 0,WORKLEN Length of area to free
LR R1,R13 Address of area to free
L R13,4(,R13) Restore callers register 13
FREEMAIN R,A=(1),LV=(0) Free the storage acquired
B EXIT2
SPACE 1
***********************************************************************
* MYEXIT - Logic error *
* - If an error occurred, set up the error message in the buffer *
* and length in AXPERRL. Set the severity code. *
* - Set the return code to 20. *
* - Return to the caller. *
***********************************************************************
LOGICERR DS 0H
MVC AXPRETC,=A(AXPCBAD) Severe error occurred
MVC ERRBUFF(ERRMSGL),ERRMSG Set up error message
MVC AXPERRL,=A(ERRMSGL) Set up error message length
MVC AXPSEVC,=A(20) Set up error message severity
B EXIT1
EJECT
***********************************************************************
* SOURCE EXIT *
* - Process required request type *
***********************************************************************
SOURCE DS 0H
L R15,AXPRTYP Get the request type value (1-5)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,SOURCE_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
SOURCE_ADDR DC Y(SOURCE_OPEN-MYEXIT)
DC Y(SOURCE_CLOSE-MYEXIT)
DC Y(SOURCE_READ-MYEXIT)
DC Y(SOURCE_WRITE-MYEXIT)
DC Y(SOURCE_PROCESS-MYEXIT)
DC Y(*-*)
SPACE 1
Figure 4. Example of a user exit (part 4 of 17)***********************************************************************
* SOURCE EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler or user exit *
* will open the primary input data set. *
* - Open data set if required. *
***********************************************************************
SOURCE_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ SOURCE_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
SOURCE_NOSTR DS 0H
CLC OPENPARM(8),=CL8'EXIT' Will user exit read input?
BE SOURCE_OPEN_EXIT Yes
MVC AXPRETC,=A(0) assembler to read primary input
B EXIT1 Return
SOURCE_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to read primary input
LA R1,SRC1 Address first source record
ST R1,CURR_PTR Set up pointer
B EXIT1 Return
SPACE 1
***********************************************************************
* SOURCE EXIT - Process CLOSE request *
* - Close data set if required. *
* - Free storage and return. *
***********************************************************************
SOURCE_CLOSE DS 0H
B FREESTOR
SPACE 1
Figure 5. Example of a user exit (part 5 of 17)***********************************************************************
* SOURCE EXIT - Process READ request *
* - Provide source information about first read. *
* - Read primary input record and place in buffer. *
* - Set return code to 16 at end of file. *
***********************************************************************
SOURCE_READ DS 0H
CLI LASTOP,AXPROPN Was last operation OPEN?
BNE SOURCE_READ2
MVC AXPMEMN,=CL255'Member'
MVC AXPMEMT,=CL255'None'
MVC AXPDSN,=CL255'INPUT.data set.NAME'
MVC AXPVOL,=CL255'VOL001'
MVC AXPREAC,=A(AXPEISA) Indicate source info available
XC AXPRELREC,AXPRELREC Set Relative Record No. to 0
XC AXPABSREC,AXPABSREC Set Absolute Record No. to 0
SOURCE_READ2 DS 0H
L R1,CURR_PTR Get record address
CLI 0(R1),X'FF' Is it EOF?
BE SOURCE_EOF Yes, set return code
MVC 0(80,BUFREG),0(R1)
LA R1,80(,R1)
ST R1,CURR_PTR Point to next source record
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for source record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
SOURCE_EOF DS 0H
MVC AXPRETC,=A(AXPCEOD) End of file on input
B EXIT1
SPACE 1
***********************************************************************
* SOURCE EXIT - Process WRITE request *
* - Not valid for SOURCE exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
SOURCE_WRITE DS 0H
B LOGICERR
SPACE 1
***********************************************************************
* SOURCE EXIT - Process PROCESS request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
SOURCE_PROCESS DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for source record
B EXIT1
EJECT
Figure 6. Example of a user exit (part 6 of 17)***********************************************************************
* LIBRARY EXIT *
* - Process required request type *
***********************************************************************
LIBRARY DS 0H
L R15,AXPRTYP Get the request type value (1-8)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,LIBRARY_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
LIBRARY_ADDR DC Y(LIBRARY_OPEN-MYEXIT)
DC Y(LIBRARY_CLOSE-MYEXIT)
DC Y(LIBRARY_READ-MYEXIT)
DC Y(LIBRARY_WRITE-MYEXIT)
DC Y(LIBRARY_PR_MAC-MYEXIT)
DC Y(LIBRARY_PR_CPY-MYEXIT)
DC Y(LIBRARY_FIND_MAC-MYEXIT)
DC Y(LIBRARY_FIND_CPY-MYEXIT)
DC Y(LIBRARY_EOM-MYEXIT)
DC Y(*-*)
SPACE 1
***********************************************************************
* LIBRARY EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler, user exit or *
* both will process the library. *
* - Open data set if required. *
***********************************************************************
LIBRARY_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ LIBRARY_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
LIBRARY_NOSTR DS 0H
CLC OPENPARM(4),=CL8'EXIT' Will user exit process library
BE LIBRARY_OPEN_EXIT Yes
CLC OPENPARM(4),=CL8'BOTH' Will Both process library
BE LIBRARY_OPEN_BOTH Yes
MVC AXPRETC,=A(0) assembler to process library
B EXIT1 Return
LIBRARY_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to process library
MVC AXPREAC,=A(AXPEEOM) EXIT to get End of member calls
B EXIT1 Return
LIBRARY_OPEN_BOTH DS 0H
OI OPENFLAG,BOTH Set flag
MVC AXPRETC,=A(AXPCOPL) Both to process library
MVC AXPREAC,=A(AXPEEOM) EXIT to get End of member calls
B EXIT1 Return
SPACE 1
Figure 7. Example of a user exit (part 7 of 17)***********************************************************************
* LIBRARY EXIT - Process CLOSE request *
* - Close data set if required. *
* - Free storage and return. *
***********************************************************************
LIBRARY_CLOSE DS 0H
USING LIBSTACK,R2 Map stack entries
ICM R2,B'1111',STACKPTR Check that stack is empty
BZ FREESTOR It should be!
LIBRARY_FREE_LOOP DS 0H
LTR R1,R2 Load address for FREEMAIN
BZ FREESTOR Finished here
L R2,NEXT_MEM Prepare for next loop
LA R0,LIBSTACK_LEN Load length for FREEMAIN
FREEMAIN R,A=(1),LV=(0) Free the storage acquired
B LIBRARY_FREE_LOOP
SPACE 1
***********************************************************************
* LIBRARY EXIT - Process READ request *
* - Read copy/macro source and place in buffer. *
* - Set return code to 16 at end of member. *
***********************************************************************
LIBRARY_READ DS 0H
ICM R2,B'1111',STACKPTR Is the stack empty?
BZ LIBRARY_STACK_ERR It shouldn't be!
L R1,MEM_PTR Get record address
CLI 0(R1),X'FF' Is it EOF?
BE LIBRARY_EOF Yes, set return code
MVC 0(80,BUFREG),0(R1)
LA R1,80(,R1) Point to next record address
ST R1,MEM_PTR and save in stack entry
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for library record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
ST R1,MEM_RELREC and save in stack entry
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
LIBRARY_EOF DS 0H
MVC AXPRETC,=A(AXPCEOD) End of file on input
B EXIT1
SPACE 1
***********************************************************************
* LIBRARY EXIT - Process WRITE request *
* - Not valid for LIBRARY exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
LIBRARY_WRITE DS 0H
B LOGICERR
SPACE 1
***********************************************************************
* LIBRARY EXIT - Process PROCESS MACRO/COPY request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
LIBRARY_PR_MAC DS 0H
LIBRARY_PR_CPY DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for library record
B EXIT1
SPACE 1
Figure 8. Example of a user exit (part 8 of 17)***********************************************************************
* LIBRARY EXIT - Process FIND MACRO/COPY request *
* - Search for the member. Set the return code to indicate *
* whether the member was found. *
* - If the member is found, the source information is returned. *
***********************************************************************
LIBRARY_FIND_MAC DS 0H
LIBRARY_FIND_CPY DS 0H
CLC AXPOPTS,=A(AXPORES) Is it a resume request?
BE LIBRARY_RESUME Yes, resume member
LA R3,MACA1
CLC AXPMEMN(8),=CL8'OUTER'
BE LIBRARY_FOUND
LA R3,MACB1
CLC AXPMEMN(8),=CL8'INNER'
BE LIBRARY_FOUND
LA R3,CPYA1
CLC AXPMEMN(8),=CL8'TINY'
BE LIBRARY_FOUND
LA R3,CPYB1
CLC AXPMEMN(8),=CL8'TINY1'
BE LIBRARY_FOUND
MVC AXPRETC,=A(AXPCMNF) Indicate member not found
B EXIT1
LIBRARY_FOUND DS 0H
ICM R2,B'1111',STACKPTR Is the stack empty?
BZ LIBRARY_GET_STACK
CLC AXPOPTS,=A(AXPONEST) Is it a nested COPY/MACRO?
BNE LIBRARY_STACK_ERR NO - report an error
LIBRARY_GET_STACK DS 0H
LA R0,LIBSTACK_LEN Load reg with length
GETMAIN R,LV=(0) and getmain storage
XC 0(LIBSTACK_LEN,R1),0(R1) Clear the storage
NEW_LIBSTACK USING LIBSTACK,R1 Map the new stack entry
ST R2,NEW_LIBSTACK.NEXT_MEM Add new link to top of stack
DROP NEW_LIBSTACK
ST R1,STACKPTR Re-anchor the stack
LR R2,R1 Make the new entry current
ST R3,MEM_PTR Save current record pointer
MVC MEM_NAME,AXPMEMN Save name in stack entry
MVC AXPREAC,=A(AXPEISA) Indicate source info available
MVC AXPMEMT,=CL255'None'
MVC AXPDSN,=CL255'LIBRARY.data set.NAME'
MVC AXPVOL,=CL255'VOL002'
XC AXPRELREC,AXPRELREC Set relative record No to zero
B EXIT1
***********************************************************************
* LIBRARY EXIT - Process FIND (resume) request *
* - Set the relative record number in the parameter list *
* N.B. if the EXIT read the records from disk, at this point it would *
* use the information saved in the stack to reposition itself *
* ready for the next read. (i.e. a FIND and POINT) *
***********************************************************************
LIBRARY_RESUME DS 0H Stack Management now in EOM call
MVC AXPRETC,=A(AXPCMNF) Assume member not found
ICM R2,B'1111',STACKPTR Is the stack empty?
BZ LIBRARY_CHECK_BOTH Yes - check open option
CLC MEM_NAME,AXPMEMN Compare name with stack entry
BNE LIBRARY_CHECK_BOTH Not equal - check open option
MVC AXPRETC,=A(0) Correct our assumption
L R0,MEM_RELREC Get saved rel rec no from stack
ST R0,AXPRELREC Set relative record No
B EXIT1
SPACE 1
Figure 9. Example of a user exit (part 9 of 17)***********************************************************************
* LIBRARY EXIT - Use End of Member calls to perform stack management *
* - Compare member name, if equal unstack the top entry *
***********************************************************************
LIBRARY_EOM DS 0H
ICM R2,B'1111',STACKPTR Is the stack empty?
BZ LIBRARY_CHECK_BOTH Yes - check open option
CLC MEM_NAME,AXPMEMN Compare name with stack entry
BNE LIBRARY_CHECK_BOTH Not equal - check open option
LR R1,R2 Load address for FREEMAIN
L R2,NEXT_MEM Get address of next entry
ST R2,STACKPTR and save it.
DROP R2
LA R0,LIBSTACK_LEN Load length for FREEMAIN
FREEMAIN R,A=(1),LV=(0) Free the storage acquired
LIBRARY_CHECK_BOTH DS 0H
CLI OPENFLAG,BOTH Did EXIT open with BOTH option
BE EXIT1 Yes - don't issue error msg
***********************************************************************
* LIBRARY EXIT - Stack Error Routine *
* - If an error occurred, set up the error message in the buffer *
* and length in AXPERRL. Set the severity code. *
* - Set the return code to 20. *
* - Return to the caller. *
***********************************************************************
LIBRARY_STACK_ERR DS 0H
MVC AXPRETC,=A(AXPCBAD) Severe error occurred
MVC ERRBUFF(ERRMSGL),STKMSG Set up error message
MVC AXPERRL,=A(STKMSGL) Set up error message length
MVC AXPSEVC,=A(20) Set up error message severity
B EXIT1
EJECT
***********************************************************************
* LISTING EXIT *
* - Process required request type *
***********************************************************************
LISTING DS 0H
L R15,AXPRTYP Get the request type value (1-5)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,LISTING_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
LISTING_ADDR DC Y(LISTING_OPEN-MYEXIT)
DC Y(LISTING_CLOSE-MYEXIT)
DC Y(LISTING_READ-MYEXIT)
DC Y(LISTING_WRITE-MYEXIT)
DC Y(LISTING_PROCESS-MYEXIT)
DC Y(*-*)
SPACE 1
Figure 10. Example of a user exit (part 10 of 17)***********************************************************************
* LISTING EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler or the user exit *
* will write the listing. *
* - Open data set if required. *
***********************************************************************
LISTING_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ LISTING_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
LISTING_NOSTR DS 0H
CLC OPENPARM(4),=CL8'EXIT' Will user exit process listing
BE LISTING_OPEN_EXIT Yes
MVC AXPRETC,=A(0) assembler to write listing
B EXIT1 Return
LISTING_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to write listing
MVC AXPMEMN,=CL255' '
MVC AXPMEMT,=CL255' '
MVC AXPDSN,=CL255'LISTING.data set.NAME'
MVC AXPVOL,=CL255'VOL001'
MVC AXPREAC,=A(AXPEISA) Indicate data set info available
XC AXPRELREC,AXPRELREC Set Relative Record No. to 0
XC AXPABSREC,AXPABSREC Set Absolute Record No. to 0
B EXIT1 Return
SPACE 1
***********************************************************************
* LISTING EXIT - Process CLOSE request *
* - Close data set if required *
* - Free storage and return. *
***********************************************************************
LISTING_CLOSE DS 0H
B FREESTOR
SPACE 1
***********************************************************************
* LISTING EXIT - Process READ request *
* - Not valid for LISTING exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
LISTING_READ DS 0H
B LOGICERR
***********************************************************************
* LISTING EXIT - Process WRITE request *
* - Write the listing record passed. *
***********************************************************************
LISTING_WRITE DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for listing record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
SPACE 1
Figure 11. Example of a user exit (part 11 of 17)***********************************************************************
* LISTING EXIT - Process PROCESS request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
LISTING_PROCESS DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for listing record
B EXIT1
EJECT
***********************************************************************
* OBJECT EXIT *
* - Process required request type *
***********************************************************************
PUNCH DS 0H
OBJECT DS 0H
L R15,AXPRTYP Get the request type value (1-5)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,OBJECT_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
OBJECT_ADDR DC Y(OBJECT_OPEN-MYEXIT)
DC Y(OBJECT_CLOSE-MYEXIT)
DC Y(OBJECT_READ-MYEXIT)
DC Y(OBJECT_WRITE-MYEXIT)
DC Y(OBJECT_PROCESS-MYEXIT)
DC Y(*-*)
SPACE 1
***********************************************************************
* OBJECT EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler or the user exit *
* will write the object/punch records. *
* - Open data set if required *
***********************************************************************
OBJECT_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ OBJECT_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
OBJECT_NOSTR DS 0H
CLC OPENPARM(4),=CL8'EXIT' Will user exit process object
BE OBJECT_OPEN_EXIT Yes
MVC AXPRETC,=A(0) assembler to write object/punch
B EXIT1 Return
OBJECT_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to write object/punch
MVC AXPMEMN,=CL255'Member'
MVC AXPMEMT,=CL255' '
MVC AXPDSN,=CL255'OBJECT.data set.NAME'
MVC AXPVOL,=CL255'VOL001'
MVC AXPREAC,=A(AXPEISA) Indicate data set info available
XC AXPRELREC,AXPRELREC Set Relative Record No. to 0
XC AXPABSREC,AXPABSREC Set Absolute Record No. to 0
B EXIT1 Return
SPACE 1
Figure 12. Example of a user exit (part 12 of 17)***********************************************************************
* OBJECT EXIT - Process CLOSE request *
* - Close data set if required. *
* - Free storage and return. *
***********************************************************************
OBJECT_CLOSE DS 0H
B FREESTOR
SPACE 1
***********************************************************************
* OBJECT EXIT - Process READ request *
* - Not valid for OBJECT exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
OBJECT_READ DS 0H
B LOGICERR
***********************************************************************
* OBJECT EXIT - Process WRITE request *
* - Write the source record passed. *
***********************************************************************
OBJECT_WRITE DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for object record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
SPACE 1
***********************************************************************
* OBJECT EXIT - Process PROCESS request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
OBJECT_PROCESS DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for object record
B EXIT1
EJECT
***********************************************************************
* ADATA EXIT *
* - Process required request type *
***********************************************************************
ADATA DS 0H
L R15,AXPRTYP Get the request type value (1-5)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,ADATA_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
ADATA_ADDR DC Y(ADATA_OPEN-MYEXIT)
DC Y(ADATA_CLOSE-MYEXIT)
DC Y(ADATA_READ-MYEXIT)
DC Y(ADATA_WRITE-MYEXIT)
DC Y(ADATA_PROCESS-MYEXIT)
DC Y(*-*)
SPACE 1
Figure 13. Example of a user exit (part 13 of 17)***********************************************************************
* ADATA EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler or the user exit *
* will write the associated data. *
* - Open data set if required. *
***********************************************************************
ADATA_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ ADATA_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
ADATA_NOSTR DS 0H
CLC OPENPARM(4),=CL8'EXIT' Will user exit process adata
BE ADATA_OPEN_EXIT Yes
MVC AXPRETC,=A(0) assembler to write adata
B EXIT1 Return
ADATA_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to write adata
MVC AXPMEMN,=CL255' '
MVC AXPMEMT,=CL255' '
MVC AXPDSN,=CL255'ADATA.data set.NAME'
MVC AXPVOL,=CL255'VOL001'
MVC AXPREAC,=A(AXPEISA) Indicate data set info available
XC AXPRELREC,AXPRELREC Set Relative Record No. to 0
XC AXPABSREC,AXPABSREC Set Absolute Record No. to 0
B EXIT1 Return
SPACE 1
***********************************************************************
* ADATA EXIT - Process CLOSE request *
* - Close data set if required. *
* - Free storage and return. *
***********************************************************************
ADATA_CLOSE DS 0H
B FREESTOR
SPACE 1
***********************************************************************
* ADATA EXIT - Process READ request *
* - Not valid for ADATA exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
ADATA_READ DS 0H
B LOGICERR
***********************************************************************
* ADATA EXIT - Process WRITE request *
* - Write the adata record passed. *
***********************************************************************
ADATA_WRITE DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for adata record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
SPACE 1
Figure 14. Example of a user exit (part 14 of 17)***********************************************************************
* ADATA EXIT - Process PROCESS request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
ADATA_PROCESS DS 0H
MVC WTOL+4(80),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for ADATA record
B EXIT1
EJECT
***********************************************************************
* TERM EXIT *
* - Process required request type *
***********************************************************************
TERM DS 0H
L R15,AXPRTYP Get the request type value (1-5)
BCTR R15,0 Decrement by 1
SLL R15,1 Multiply by 2
LH R15,TERM_ADDR(R15) Index into Address list
AR R15,R12 Calculate the address
BR R15 Branch to applicable routine
TERM_ADDR DC Y(TERM_OPEN-MYEXIT)
DC Y(TERM_CLOSE-MYEXIT)
DC Y(TERM_READ-MYEXIT)
DC Y(TERM_WRITE-MYEXIT)
DC Y(TERM_PROCESS-MYEXIT)
DC Y(*-*)
SPACE 1
***********************************************************************
* TERM EXIT - Process OPEN request *
* - Pick up character string if it is supplied. *
* - Set return code indicating whether the assembler or the user exit *
* will write the terminal records. *
* - Open data set if required. *
***********************************************************************
TERM_OPEN DS 0H
MVI OPENPARM,C' ' Clear open parm
MVC OPENPARM+1(L'OPENPARM-1),OPENPARM
L R1,AXPBUFL Get the Buffer length
LTR R1,R1 Is string length zero?
BZ TERM_NOSTR Yes, no string passed
BCTR R1,0 Decrement for execute
EX R1,UPPERSTR Move and uppercase string
TERM_NOSTR DS 0H
CLC OPENPARM(4),=CL8'EXIT' Will user exit process records?
BE TERM_OPEN_EXIT Yes
MVC AXPRETC,=A(0) assembler to write records
B EXIT1 Return
TERM_OPEN_EXIT DS 0H
OI OPENFLAG,EXIT Set flag
MVC AXPRETC,=A(AXPCOPN) User exit to write records
MVC AXPMEMN,=CL255' '
MVC AXPMEMT,=CL255' '
MVC AXPDSN,=CL255'TERM.data set.NAME'
MVC AXPVOL,=CL255'VOL001'
MVC AXPREAC,=A(AXPEISA) Indicate data set info available
XC AXPRELREC,AXPRELREC Set Relative Record No. to 0
XC AXPABSREC,AXPABSREC Set Absolute Record No. to 0
B EXIT1 Return
SPACE 1
Figure 15. Example of a user exit (part 15 of 17)***********************************************************************
* TERM EXIT - Process CLOSE request *
* - Close data set if required. *
* - Free storage and return. *
***********************************************************************
TERM_CLOSE DS 0H
B FREESTOR
SPACE 1
***********************************************************************
* TERM EXIT - Process READ request *
* - Not valid for TERM exit. *
* - Set return code to 20 and set up error message. *
***********************************************************************
TERM_READ DS 0H
B LOGICERR
***********************************************************************
* TERM EXIT - Process WRITE request *
* - Write the terminal record passed. *
***********************************************************************
TERM_WRITE DS 0H
MVC WTOL+4(68),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for terminal record
L R1,AXPRELREC Update
LA R1,1(R1) Relative Record
ST R1,AXPRELREC Number
L R1,AXPABSREC Update
LA R1,1(R1) Absolute Record
ST R1,AXPABSREC Number
B EXIT1
SPACE 1
***********************************************************************
* TERM EXIT - Process PROCESS request *
* - Exit may modify the record, have the assembler discard the *
* record or insert additional records by setting the return code *
* and/or reason code. *
***********************************************************************
TERM_PROCESS DS 0H
MVC WTOL+4(68),0(BUFREG)
WTO MF=(E,WTOL) Issue WTO for terminal record
B EXIT1
STKMSG DC C'LIBRARY EXIT encountered a stack error'
STKMSGL EQU *-ERRMSG
ERRMSG DC C'Invalid EXIT type or Request type passed to exit'
ERRMSGL EQU *-ERRMSG
WTOL WTO '1234567890123456789012345678901234567890123456789012345X
6789012345678901234567890',MF=L
UPPERSTR OC OPENPARM(*-*),0(BUFREG) Move and uppercase string
SPACE 1
Figure 16. Example of a user exit (part 16 of 17)SRC1 DC CL80'SMALL TITLE ''Test the assembler exits'''
SRC2 DC CL80' MACRO'
SRC3 DC CL80' LITTLE'
SRC4 DC CL80' BSM 0,14 Return'
SRC5 DC CL80' MEND'
SRC6 DC CL80' START'
SRC7 DC CL80' OUTER'
SRC8 DC CL80' LITTLE'
SRC9 DC CL80' REPRO'
SRC10 DC CL80'This is to be written to the punch data set'
SRC11 DC CL80' COPY TINY'
SRC12 DC CL80' END'
SRCEND DC X'FF' END OF SOURCE STMTS
SPACE 1
MACA1 DC CL80' MACRO'
MACA2 DC CL80' OUTER'
MACA3 DC CL80' XR 15,15'
MACA4 DC CL80' INNER'
MACA5 DC CL80' LTR 15,15'
MACA6 DC CL80' MEND'
MACAEND DC X'FF' END OF MACRO STMTS
SPACE 1
MACB1 DC CL80' MACRO'
MACB2 DC CL80' INNER'
MACB3 DC CL80' LR 12,15'
MACB4 DC CL80' MEND'
MACBEND DC X'FF' END OF MACRO STMTS
SPACE 1
CPYA1 DC CL80'TINY DSECT LINE 1 TINY'
CPYA2 DC CL80' DS C''TINY'' LINE 2 TINY'
CPYA3 DC CL80' COPY TINY1 LINE 3 TINY'
CPYA4 DC CL80' DS CL10''TINY'' LINE 4 TINY'
CPYA5 DC CL80' DS CL80 LINE 5 TINY'
CPYEND DC X'FF' END OF COPY STMTS
CPYB1 DC CL80'TINY1 DSECT LINE 1 TINY1'
CPYB2 DC CL80' DS C''TINY1'' LINE 2 TINY1'
CPYB3 DC CL80' DS CL10''TINY1'' LINE 3 TINY1'
CPYBEND DC X'FF' END OF COPY STMTS
SPACE 1
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
DCBREG EQU 5 Address of DCB
SRCREG EQU 6 Address of Source Information
ERRREG EQU 7 Address of Error Buffer
BUFREG EQU 8 Address of buffer
REQREG EQU 9 Address of request information
PARMREG EQU 10 Address or parameter
Figure 17. Example of a user exit (part 16 of 17) LTORG ,
SPACE 1
DCBD DSORG=PS,DEVD=DA
SPACE 1
ASMAXITP , Mapping for exit parameter list
SPACE 1
BUFF DSECT ,
DS CL255 Record buffer
SPACE 1
ERRBUFF DSECT ,
DS CL255 Error message buffer
SPACE 1
WORKAREA DSECT
SAVEAREA DS 18F Save area
OPENPARM DS CL64 Character string passed at open time
OPENFLAG DS X Type of Operation requested at OPEN
EXIT EQU X'80'
BOTH EQU X'C0'
LASTOP DS X Previous request type
CURR_PTR DS A Current record pointer
STACKPTR DS A Address of top of Lib status stack
WORKLEN EQU *-WORKAREA
LIBSTACK DSECT Library status stack entry
NEXT_MEM DS A Address of entry next in stack
MEM_PTR DS A Current record pointer
MEM_RELREC DS F Current relative record number
MEM_NAME DS CL64 Stack of saved member names
LIBSTACK_LEN EQU *-LIBSTACK
END MYEXIT
|
HLASM Programmer's Guide
Copyright IBM Corporation 1990, 2014