Programming example for fast data access API:
***********************************************************************
* *
* LICENSED MATERIALS - PROPERTY OF IBM *
* *
* 5650-ZOS *
* *
* COPYRIGHT IBM CORP. 1977, 2013 *
* *
* STATUS = HPM7770 *
* *
***********************************************************************
* *
* z/OS BINDER FAST DATA ACCESS DEMO *
* *
* This program shows how to use fast data access calls *
* *
* It expects three DD names: *
* SYSIN - contains commands that guide processing *
* SYSLIB - PDSE or z/OS UNIX path that contains inspected program *
* objects *
* SYSPRINT - application puts all output there *
* *
* All SYSIN commands except XX represent a single fast data access *
* call. *
* *
* SB [MEMBER] - Starts a new session using given member name *
* SJ [MEMBER] - Starts a new session using given member name *
* Unlike SB, if SYSLIB specifies z/OS UNIX path, member *
* name is appended to it *
* SQ [ENTRY] - Starts a new session using given entry point name of *
* an already loaded program object. *
* GC - Prints all compile units *
* GD - Prints size of B_TEXT data in the entire module *
* GE - Prints all ESD entries of currently opened PO *
* GN SECTIONS - Prints names of all sections *
* CLASSES or classes of currently opened PO *
* RC - Prints last return and reason codes *
* EN - Ends current session *
* XX - Stops processing. Mandatory at the very end of SYSIN *
* *
***********************************************************************
***********************************************************************
* Pretty names for registers *
***********************************************************************
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
***********************************************************************
* Macro that fills the first string with blanks and then copies the *
* second string into it *
***********************************************************************
MACRO
&NAME STRCPY &DST,&SRC
DS 0H
MVI &DST,C' '
MVC &DST+1(L'&DST-1),&DST
MVC &DST+0(L'&SRC),&SRC
MEND
***********************************************************************
* Entry poing linkage *
***********************************************************************
FDEMO CSECT
FDEMO AMODE 31 Required to use fast data access
FDEMO RMODE ANY
SAVE (14,12) Save registers.
*
BALR R12,0 Establish addressability to
USING *,R12 code through register 12.
*
LHI R0,DATASIZE Get above-the-line data area
GETMAIN RU,LV=(R0),LOC=31 and establish addressability
LR R11,R1 to it through
USING DATA,R11 general purpose register 11.
*
LHI R0,DCBSSIZE Get below-the-line data area
GETMAIN RU,LV=(R0),LOC=24 and establish addressability
LR R10,R1 to it through
USING DCBS,R10 general purpose register 10.
*
LM R15,R1,16(R13) Restore registers 0, 1 and 15.
ST R13,4(R11) Link our save area with
ST R11,8(R13) caller's save area.
LR R13,R11 Put address of our save area *
into register 13.
***********************************************************************
* Clean resource acquisition status. It is represented as array of *
* bytes each of which shows whether resource is currently obtained. *
***********************************************************************
XC STATUS_START(STATUS_LEN),STATUS_START
***********************************************************************
* Open SYSPRINT *
***********************************************************************
MVC SYSPRINT(SYSPRINT_TEMPLATE_LEN),SYSPRINT_TEMPLATE *
Copy DCB below the line.
MVC PARMLIST(OPEN_OUTPUT_LIST_LEN),OPEN_OUTPUT_LIST *
Copy parameter list.
OPEN (SYSPRINT),MF=(E,PARMLIST), *
MODE=31 Issue open.
TM SYSPRINT+(DCBOFLGS-IHADCB),DCBOFOPN Check whether DCB was *
opened successfully.
BNZ SYSPRINT_OK
SYSPRINT_XX DS 0H If open fails
LHI R9,12 set return code to 12,
B CLEANUP free resources and exit.
SYSPRINT_OK DS 0H
MVC STATUS_SYSPRINT,=XL1'1' Mark SYSPRINT as opened.
***********************************************************************
* Print startup message *
***********************************************************************
STRCPY PRINTBUF,MSG_STARTUP Copy message to 125-byte buffer.
PUT SYSPRINT,PRINTBUF Issue PUT.
***********************************************************************
* Open SYSIN *
***********************************************************************
MVC SYSIN(SYSIN_TEMPLATE_LEN),SYSIN_TEMPLATE *
Copy DCB below the line.
MVC PARMLIST(OPEN_INPUT_LIST_LEN),OPEN_INPUT_LIST *
Copy parameter list.
OPEN (SYSIN),MF=(E,PARMLIST), *
MODE=31 Issue open.
TM SYSIN+(DCBOFLGS-IHADCB),DCBOFOPN Check whether DCB was *
opened successfully.
BNZ SYSIN_OK
SYSIN_XX DS 0H If open fails
STRCPY PRINTBUF,MSG_SYSIN_FAILED print error message,
PUT SYSPRINT,PRINTBUF
LHI R9,12 set return code to 12,
B CLEANUP free resources and exit.
SYSIN_OK DS 0H
MVC STATUS_SYSIN,=XL1'1' Mark SYSIN as opened.
***********************************************************************
* Open SYSLIB *
***********************************************************************
MVC SYSLIB(SYSLIB_TEMPLATE_LEN),SYSLIB_TEMPLATE *
Copy DCB below the line.
MVC PARMLIST(OPEN_INPUT_LIST_LEN),OPEN_INPUT_LIST *
Copy parameter list.
OPEN (SYSLIB),MF=(E,PARMLIST), *
MODE=31 Issue open.
TM SYSLIB+(DCBOFLGS-IHADCB),DCBOFOPN Check whether DCB was *
opened successfully.
BNZ SYSLIB_OK
SYSLIB_XX DS 0H If open fails
STRCPY PRINTBUF,MSG_SYSLIB_FAILED print error message,
PUT SYSPRINT,PRINTBUF
LHI R9,12 set return code to 12,
B CLEANUP free resources and exit.
SYSLIB_OK DS 0H
MVC STATUS_SYSLIB,=XL1'1' Mark SYSLIB as opened.
***********************************************************************
* Load IEWBFDAT *
***********************************************************************
LOAD EP=IEWBFDAT Issue LOAD.
ST R0,IEWBFDAT Save entry point address.
MVC STATUS_IEWBFDAT,=XL1'1' Mark IEWBFDAT as loaded.
***********************************************************************
* Read from SYSLIN until XX command is encountered *
***********************************************************************
READLOOP DS 0H
GET SYSIN,INPUTBUF Read next command.
*
STRCPY PRINTBUF,MSG_ECHO_PREFIX Append prefix to it
MVC PRINTBUF+L'MSG_ECHO_PREFIX(80),INPUTBUF
PUT SYSPRINT,PRINTBUF and echo it to SYSPRINT.
***********************************************************************
* Dispatch command procesing to an appropriate routine *
***********************************************************************
CLC INPUTBUF(3),=C'SB '
BE DO_SB
CLC INPUTBUF(3),=C'SJ '
BE DO_SJ
CLC INPUTBUF(3),=C'SQ '
BE DO_SQ
CLC INPUTBUF(3),=C'GC '
BE DO_GC
CLC INPUTBUF(3),=C'GD '
BE DO_GD
CLC INPUTBUF(3),=C'GE '
BE DO_GE
CLC INPUTBUF(3),=C'GN '
BE DO_GN
CLC INPUTBUF(3),=C'RC '
BE DO_RC
CLC INPUTBUF(3),=C'EN '
BE DO_EN
CLC INPUTBUF(3),=C'XX '
BE READLOOP_END
DO_INVLD DS 0H If it's an invalid command
STRCPY PRINTBUF,MSG_INVALID_COMMAND
PUT SYSPRINT,PRINTBUF put error message
B READLOOP and read the next one.
***********************************************************************
* Process SB - Start session with a BLDL identifier *
***********************************************************************
DO_SB DS 0H
MVC PGMNAME(8),INPUTBUF+3 Get member name
XC MTOKEN,MTOKEN Zero out MTOKEN
L R15,IEWBFDAT
CALL (15),(SB,MTOKEN,SYSLIB,PGMNAME),VL, *
MF=(E,PARMLIST) Call fast data
B READLOOP Process the next command.
***********************************************************************
* Process SJ - Start session with a DDNAME or PATH *
***********************************************************************
DO_SJ DS 0H
XR R0,R0 Find length of a member:
IC R0,=C' ' we are searching for space
LA R1,INPUTBUF+80 until the end of string
LA R2,INPUTBUF+3 starting from the 4th character.
SRST R1,R2 Go.
SR R1,R2 Put length into register 1.
*
STH 1,PGMNAME Build vstring corresponding to a
BCTR 1,0 member name by copying its length
EX 1,SJ_MVC and characters into PGMNAME.
*
XC MTOKEN,MTOKEN Zero out MTOKEN
L R15,IEWBFDAT
CALL (15),(SJ,MTOKEN,SYSLIB_DD_VSTRING,PGMNAME),VL, *
MF=(E,PARMLIST) Call fast data
B READLOOP Process the next command.
SJ_MVC DS 0H Out-of-control-flow
MVC PGMNAME+2(0),INPUTBUF+3 MVC template.
***********************************************************************
* Process SQ - Start session with a CSVQUERY token *
***********************************************************************
DO_SQ DS 0H
MVC PGMNAME(8),INPUTBUF+3 Get entry point name.
*
CSVQUERY INEPNAME=PGMNAME, *
OUTEPTKN=EPTOKEN Issue CSVQUERY.
LTR R15,R15 Check whether
BZ CSVQUERY_OK CSVQUERY succeeded.
CSVQUERY_XX DS 0H If CSVQURY fails
STRCPY PRINTBUF,MSG_CSVQUERY_FAILED
PUT SYSPRINT,PRINTBUF print error message and
B READLOOP process the next command.
CSVQUERY_OK DS 0H
L R15,IEWBFDAT
CALL (15),(SQ,MTOKEN,EPTOKEN),VL, *
MF=(E,PARMLIST) Call fast data.
B READLOOP Process the next command.
***********************************************************************
* Process GC - Get compile unit data *
***********************************************************************
DO_GC DS 0H
IEWBCUI_BASE EQU R2 Base register for CUI buffer.
CUI_BASE EQU R3 Base register for CUI entry.
IEWBUFF FUNC=GETBUF,TYPE=CUI Get memory for CUI buffer.
IEWBUFF FUNC=INITBUF,TYPE=CUI Init CUI buffer.
***********************************************************************
* Keep calling fast data while there are more CUI entries *
***********************************************************************
XC CURSOR,CURSOR Zero out cursor.
GC_LOOP DS 0H
L R15,IEWBFDAT
CALL (15),(GC,MTOKEN,0,(IEWBCUI_BASE),CURSOR,COUNT),VL, *
MF=(E,PARMLIST) Call fast data.
ST R15,RETCODE Save return
ST R0,RSNCODE and reason codes.
*
CLC RETCODE,=F'4'
BNE GC_BADRC We want only RETCODE=4
CLC RSNCODE,=XL4'10800001' and RSNCODE='10800001'X
BE GC_OK (more data)
CLC RSNCODE,=XL4'10800002' or RSNCODE='10800002'X
BE GC_OK (no more data).
GC_BADRC DS 0H Other codes are invalid.
STRCPY PRINTBUF,MSG_RC Build error message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+4,RETCODE), *
MF=(E,PARMLIST) format return
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,RSNCODE), *
MF=(E,PARMLIST) and reason codes.
PUT SYSPRINT,PRINTBUF Print error message.
B FREE_CUI Free buffer and *
read the next command.
GC_OK DS 0H
***********************************************************************
* Format and print entries obtained *
***********************************************************************
L R4,COUNT Load register 4 with size of entries.
LR R5,CUI_BASE Save address of the first entry.
LTR R4,R4
BZ GC_LOOP2_END If there are no entries, skip the loop.
GC_LOOP2 DS 0H
STRCPY PRINTBUF,MSG_GC Build CUI message.
L R6,CUI_MEMBER_PTR
LLH R7,CUI_MEMBER_LEN
CL R7,=F'0'
BE GC_NO_MEMBER
BCTR R7,0
GC_LEN_OK DS 0H
EX R7,GC_MVC Copy name.
PUT SYSPRINT,PRINTBUF Print CUI message.
GC_NO_MEMBER DS 0H
A CUI_BASE,CUIH_ENTRY_LENG Move on to the next entry.
BCT R4,GC_LOOP2 Repeat.
GC_LOOP2_END DS 0H
LR CUI_BASE,R5 Restore address of the first entry.
CLC RSNCODE,=XL4'10800001'
BE GC_LOOP If there are more entries, call *
fast data again.
FREE_CUI DS 0H
IEWBUFF FUNC=FREEBUF,TYPE=CUI Free CUI buffer.
B READLOOP Read the next command.
GC_MVC DS 0H Out-of-control-flow
MVC PRINTBUF+7(0),0(R6) MVC template.
***********************************************************************
* Process GD - Get data from any class *
***********************************************************************
DO_GD DS 0H
IEWBTXT_BASE EQU R2 Base register for TEXT buffer.
TXT_BASE EQU R3 Base register for TEXT entry.
IEWBUFF FUNC=GETBUF,TYPE=TEXT Get memory for TEXT buffer.
IEWBUFF FUNC=INITBUF,TYPE=TEXT Init TXT buffer.
***********************************************************************
* Keep calling fast data while there are more data *
***********************************************************************
XC CURSOR,CURSOR Zero out cursor.
XR R5,R5 Accumulate full size in R5.
GD_LOOP DS 0H
L R15,IEWBFDAT
CALL (15),(GD,MTOKEN,B_TEXT_VSTRING,0,(IEWBTXT_BASE),CURSOR, *
COUNT,0),VL,MF=(E,PARMLIST) Call fast data.
ST R15,RETCODE Save return
ST R0,RSNCODE and reason codes.
*
CLC RETCODE,=F'4'
BNE GD_BADRC We want only RETCODE=4
CLC RSNCODE,=XL4'10800001' and RSNCODE='10800001'X
BE GD_OK (more data)
CLC RSNCODE,=XL4'10800002' or RSNCODE='10800002'X
BE GD_OK (no more data).
GD_BADRC DS 0H Other codes are invalid.
STRCPY PRINTBUF,MSG_RC Build error message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+4,RETCODE), *
MF=(E,PARMLIST) format return
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,RSNCODE), *
MF=(E,PARMLIST) and reason codes.
PUT SYSPRINT,PRINTBUF Print error message.
B FREE_TEXT Free buffer and *
read the next command.
GD_OK DS 0H
A R5,COUNT Add size of data obtained.
CLC RSNCODE,=XL4'10800001'
BE GD_LOOP If there are more entries, call *
fast data again.
ST R5,COUNT Store full size.
STRCPY PRINTBUF,MSG_GD Build GD message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,COUNT), *
MF=(E,PARMLIST) format full size.
PUT SYSPRINT,PRINTBUF Print GD message.
FREE_TEXT DS 0H
IEWBUFF FUNC=FREEBUF,TYPE=TEXT Free TXT buffer.
B READLOOP Read the next command.
***********************************************************************
* Process GE - Get ESD data *
***********************************************************************
DO_GE DS 0H
IEWBESD_BASE EQU R2 Base register for ESD buffer.
ESD_BASE EQU R3 Base register for ESD entry.
IEWBUFF FUNC=GETBUF,TYPE=ESD Get memory for ESD buffer.
IEWBUFF FUNC=INITBUF,TYPE=ESD Init ESD buffer.
***********************************************************************
* Keep calling fast data while there are more ESD entries *
***********************************************************************
XC CURSOR,CURSOR Zero out cursor.
GE_LOOP DS 0H
L R15,IEWBFDAT
CALL (15),(GE,MTOKEN,0,0,(IEWBESD_BASE),CURSOR,COUNT),VL, *
MF=(E,PARMLIST) Call fast data.
ST R15,RETCODE Save return
ST R0,RSNCODE and reason codes.
*
CLC RETCODE,=F'4'
BNE GE_BADRC We want only RETCODE=4
CLC RSNCODE,=XL4'10800001' and RSNCODE='10800001'X
BE GE_OK (more data)
CLC RSNCODE,=XL4'10800002' or RSNCODE='10800002'X
BE GE_OK (no more data).
GE_BADRC DS 0H Other codes are invalid.
STRCPY PRINTBUF,MSG_RC Build error message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+4,RETCODE), *
MF=(E,PARMLIST) format return
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,RSNCODE), *
MF=(E,PARMLIST) and reason codes.
PUT SYSPRINT,PRINTBUF Print error message.
B FREE_ESD Free buffer and *
read the next command.
GE_OK DS 0H
***********************************************************************
* Format and print entries obtained *
***********************************************************************
L R4,COUNT Load register 4 with number of entries.
LR R5,ESD_BASE Save address of the first entry.
LTR R4,R4
BZ GE_LOOP2_END If there are no entries, skip the loop.
GE_LOOP2 DS 0H
STRCPY PRINTBUF,MSG_GE Build ESD message,
MVC PRINTBUF+9(2),ESD_TYPE insert entry type
L R6,ESD_NAME_PTR
LH R7,ESD_NAME_CHARS
BCTR R7,0
EX R7,GE_MVC and name.
PUT SYSPRINT,PRINTBUF Print ESD message.
A ESD_BASE,ESDH_ENTRY_LENG Move on to the next entry.
BCT R4,GE_LOOP2 Repeat.
GE_LOOP2_END DS 0H
LR ESD_BASE,R5 Restore address of the first entry.
CLC RSNCODE,=XL4'10800001'
BE GE_LOOP If there are more entries, call *
fast data again.
FREE_ESD DS 0H
IEWBUFF FUNC=FREEBUF,TYPE=ESD Free ESD buffer.
B READLOOP Read the next command.
GE_MVC DS 0H Out-of-control-flow
MVC PRINTBUF+17(0),0(R6) MVC template.
***********************************************************************
* Process GN - Get names of sections or classes *
***********************************************************************
DO_GN DS 0H
CLC INPUTBUF+3(9),=C'SECTIONS ' Determine whether we want
BE DO_GN_S sections
CLC INPUTBUF+3(8),=C'CLASSES ' or
BE DO_GN_C classes.
B READLOOP Otherwise read the next one.
DO_GN_S DS 0H
LA R8,NTYPE_SECTIONS Request type is 'S'.
B RESUME_GN
DO_GN_C DS 0H
LA R8,NTYPE_CLASSES Request type is 'N'.
RESUME_GN DS 0H
IEWBBNL_BASE EQU R2 Base register for BNL buffer.
BNL_BASE EQU R3 Base register for BNL entry.
IEWBUFF FUNC=GETBUF,TYPE=NAME Get memory for buffer.
IEWBUFF FUNC=INITBUF,TYPE=NAME Initialize buffer.
***********************************************************************
* Keep calling fast data while there are more ESD entries *
***********************************************************************
XC CURSOR,CURSOR Zero out cursor.
GN_LOOP DS 0H
L R15,IEWBFDAT
CALL (15),(GN,MTOKEN,(R8),(IEWBBNL_BASE),CURSOR,COUNT),VL, *
MF=(E,PARMLIST) Call fast data.
ST R15,RETCODE Save return
ST R0,RSNCODE and reason codes.
CLC RETCODE,=F'4'
BNE GN_BADRC We want only RETCODE=4
CLC RSNCODE,=XL4'10800001' and RSNCODE='10800001'X
BE GN_OK (more data)
CLC RSNCODE,=XL4'10800002' or RSNCODE='10800002'X
BE GN_OK (no data)
GN_BADRC DS 0H Other codes are invalid.
STRCPY PRINTBUF,MSG_RC Build error message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+4,RETCODE), *
MF=(E,PARMLIST) format return and
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,RSNCODE), *
MF=(E,PARMLIST) reason codes.
PUT SYSPRINT,PRINTBUF Print error message.
B FREE_NAME Free buffer and process the *
next command.
GN_OK DS 0H
***********************************************************************
* Format and print entries obtained *
***********************************************************************
L R4,COUNT Get number of entries.
LR R5,BNL_BASE Save address of the first entry.
LTR R4,R4 If there are no entries,
BZ GN_LOOP2_END skip the loop body.
GN_LOOP2 DS 0H
STRCPY PRINTBUF,MSG_GN Build the message
L R6,BNL_NAME_PTR
LH R7,BNL_NAME_CHARS
BCTR R7,0
EX R7,GN_MVC and insert the name into it.
PUT SYSPRINT,PRINTBUF Print the message.
A BNL_BASE,BNLH_ENTRY_LENG Move on to the next entry.
BCT R4,GN_LOOP2 Repeat.
GN_LOOP2_END DS 0H
LR BNL_BASE,R5 Restore address of the first entry.
CLC RSNCODE,=XL4'10800001' If there are more entries
BE GN_LOOP then call fast data again.
FREE_NAME DS 0H
IEWBUFF FUNC=FREEBUF,TYPE=NAME Free buffer.
B READLOOP Read the next command.
GN_MVC DS 0H Out-of-control-flow
MVC PRINTBUF+5(0),0(R6) template MVC.
***********************************************************************
* Process RC - Get return code information *
***********************************************************************
DO_RC DS 0H
L R15,IEWBFDAT
CALL (15),(RC,MTOKEN,RETCODE,RSNCODE),VL, *
MF=(E,PARMLIST) Call fast data.
STRCPY PRINTBUF,MSG_RC Build RC message,
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+4,RETCODE), *
MF=(E,PARMLIST) format return
LA R15,FORMAT_HEX
CALL (15),(PRINTBUF+17,RSNCODE), *
MF=(E,PARMLIST) and reason codes.
PUT SYSPRINT,PRINTBUF Print the message.
B READLOOP Read the next command.
***********************************************************************
* Process EN - End session *
***********************************************************************
DO_EN DS 0H
L R15,IEWBFDAT
CALL (15),(EN,MTOKEN),VL, *
MF=(E,PARMLIST) Call fast data.
B READLOOP Read the next command.
***********************************************************************
* Successful end of processing *
***********************************************************************
READLOOP_END DS 0H
STRCPY PRINTBUF,MSG_ALL_OK
PUT SYSPRINT,PRINTBUF Print the final message.
XR R9,R9 Zero out return code.
***********************************************************************
* Inspect resource acquisition status and free resources *
***********************************************************************
CLEANUP DS 0H
CLC STATUS_IEWBFDAT,=XL1'0' If IEWBFDAT is loaded
BE SKIP_IEWBFDAT
DELETE EP=IEWBFDAT then unload it.
SKIP_IEWBFDAT DS 0H
CLC STATUS_SYSLIB,=XL1'0' If SYSLIB is opened
BE SKIP_SYSLIB
MVC PARMLIST(CLOSE_LIST_LEN),CLOSE_LIST
CLOSE (SYSLIB),MF=(E,PARMLIST),MODE=31 then close it.
SKIP_SYSLIB DS 0H
CLC STATUS_SYSIN,=XL1'0' If SYSIN is opened
BE SKIP_SYSIN
MVC PARMLIST(CLOSE_LIST_LEN),CLOSE_LIST
CLOSE (SYSIN),MF=(E,PARMLIST),MODE=31 then close it.
SKIP_SYSIN DS 0H
CLC STATUS_SYSPRINT,=XL1'0' If SYSPRINT is opened
BE SKIP_SYSPRINT
MVC PARMLIST(CLOSE_LIST_LEN),CLOSE_LIST
CLOSE (SYSPRINT),MF=(E,PARMLIST), *
MODE=31 then close it.
SKIP_SYSPRINT DS 0H
***********************************************************************
* Exit linkage *
***********************************************************************
L R13,SAVEAREA+4 Restore caller's save area.
*
LHI R0,DCBSSIZE
LR R1,R10
FREEMAIN RU,LV=(R0),A=(R1) Free below-the-line data area.
DROP R10
*
LHI R0,DATASIZE
LR R1,R11
FREEMAIN RU,LV=(R0),A=(R1) Free above-the-line data area.
DROP R11
*
LR R15,R9 Put return code into register 15
RETURN (14,12),RC=(15) and return to caller.
***********************************************************************
* FORMAT_HEX: Format hexadecimal number *
* Parameter 1: pointer to 8-byte area to be filled with EBCDIC *
* hexadecimal representation of a number *
* Parameter 2: pointer to a fullword number to convert *
***********************************************************************
FORMAT_HEX DS 0H
SAVE (14,12) Save registers.
L R2,0(R1) Put buffer address into register 2.
L R3,4(R1)
L R3,0(R3) Put a number into register 3.
A R2,=F'7' Start filling buffer from the end.
LHI R4,8 Repeat 8 times (for each digit).
HEXLOOP DS 0H
LR R5,R3 Copy number info register 5.
N R5,=XL4'0000000F' Get the last digit.
IC R5,HEXCHARS(R5) Get its EBCDIC counterpart.
STC R5,0(R2) Put it into buffer.
SRL R3,4 Remove the last digit.
S R2,=F'1' Move text buffer pointer.
BCT R4,HEXLOOP Repeat.
XR R15,R15 Zero out return code.
RETURN (14,12),RC=(15) Restore registers and return to caller.
***********************************************************************
* End of code *
***********************************************************************
DROP 12
***********************************************************************
* Read-only initialized data *
***********************************************************************
***********************************************************************
* Parameter list templates *
***********************************************************************
OPEN_OUTPUT_LIST OPEN (,(OUTPUT)),MF=L
OPEN_OUTPUT_LIST_LEN EQU *-OPEN_OUTPUT_LIST
OPEN_INPUT_LIST OPEN (,(INPUT)),MF=L
OPEN_INPUT_LIST_LEN EQU *-OPEN_INPUT_LIST
CLOSE_LIST CLOSE (),MF=L
CLOSE_LIST_LEN EQU *-CLOSE_LIST
***********************************************************************
* DCB templates *
***********************************************************************
SYSPRINT_TEMPLATE DCB DSORG=PS,MACRF=PM,RECFM=FB,LRECL=125, *
DDNAME=SYSPRINT
SYSPRINT_TEMPLATE_LEN EQU *-SYSPRINT_TEMPLATE
SYSIN_TEMPLATE DCB DSORG=PS,MACRF=GM,RECFM=FB,LRECL=80, *
DDNAME=SYSIN
SYSIN_TEMPLATE_LEN EQU *-SYSIN_TEMPLATE
SYSLIB_TEMPLATE DCB DSORG=PO,RECFM=U,MACRF=R, *
DDNAME=SYSLIB
SYSLIB_TEMPLATE_LEN EQU *-SYSLIB_TEMPLATE
***********************************************************************
* Messages *
***********************************************************************
MSG_STARTUP DC C'Z/OS BINDER FAST DATA API DEMO'
MSG_SYSIN_FAILED DC C'COULD NOT OPEN SYSIN'
MSG_SYSLIB_FAILED DC C'COULD NOT OPEN SYSLIB'
MSG_INVALID_COMMAND DC C'INVALID COMMAND'
MSG_RC DC C'RET=12345678 RSN=12345678'
MSG_ALL_OK DC C'ALL OK'
MSG_MTOKEN DC C'MTOKEN=12345678'
MSG_GE DC C'ESD TYPE=12 NAME='
MSG_ECHO_PREFIX DC C'* '
MSG_CSVQUERY_FAILED DC C'CSVQUERY FAILED'
MSG_GN DC C'NAME='
MSG_GC DC C'MEMBER='
MSG_GD DC C'B_TEXT DATA SIZE='
***********************************************************************
* Fast data access request codes *
***********************************************************************
SB DC C'SB',X'0001'
SJ DC C'SJ',X'0001'
SQ DC C'SQ',X'0001'
GC DC C'GC',X'0001'
GD DC C'GD',X'0001'
GE DC C'GE',X'0001'
GN DC C'GN',X'0001'
RC DC C'RC',X'0001'
EN DC C'EN',X'0001'
***********************************************************************
* GN call types *
***********************************************************************
NTYPE_SECTIONS DC C'S'
NTYPE_CLASSES DC C'C'
***********************************************************************
* Fast data mappings and buffer templates *
***********************************************************************
ESDBUF IEWBUFF FUNC=MAPBUF,TYPE=ESD,VERSION=6,SIZE=8
CUIBUF IEWBUFF FUNC=MAPBUF,TYPE=CUI,VERSION=6,BYTES=40960
NAMBUF IEWBUFF FUNC=MAPBUF,TYPE=NAME,VERSION=6,SIZE=8
TXTBUF IEWBUFF FUNC=MAPBUF,TYPE=TEXT,VERSION=6,BYTES=2048
***********************************************************************
* SYSLIB DDNAME represented as vstring *
***********************************************************************
SYSLIB_DD_VSTRING DC H'6',C'SYSLIB'
***********************************************************************
* B_TEXT class name represented as vstring *
***********************************************************************
B_TEXT_VSTRING DC H'6',C'B_TEXT'
***********************************************************************
* Hexadecimal characters *
***********************************************************************
HEXCHARS DC C'0123456789ABCDEF'
***********************************************************************
* Literals *
***********************************************************************
LTORG
***********************************************************************
* Read-write uninitialized above-the-line data *
***********************************************************************
DATA DSECT
***********************************************************************
* Save area *
***********************************************************************
SAVEAREA DS 18F
***********************************************************************
* Resource acquisition status *
***********************************************************************
STATUS_START EQU *
STATUS_SYSPRINT DS XL1
STATUS_SYSIN DS XL1
STATUS_SYSLIB DS XL1
STATUS_IEWBFDAT DS XL1
STATUS_LEN EQU *-STATUS_START
***********************************************************************
* Other variables *
***********************************************************************
PARMLIST DS 32F Common area for passing parameters.
PRINTBUF DS CL125 Output buffer.
INPUTBUF DS CL80 Input buffer.
IEWBFDAT DS F Fast data entry point.
MTOKEN DS F Current session identifier.
CURSOR DS F Fast data cursor position.
COUNT DS F Number of entries obtained.
PGMNAME DS CL100 Member, path or entry point name.
EPTOKEN DS CL8 CSVQUERY token.
RETCODE DS F Return code.
RSNCODE DS F Reason code.
DATASIZE EQU *-DATA
***********************************************************************
* Read-write uninitialized data segment (located below the line) *
***********************************************************************
DCBS DSECT
SYSPRINT DS 0D
ORG SYSPRINT+SYSPRINT_TEMPLATE_LEN
SYSIN DS 0D
ORG SYSIN+SYSIN_TEMPLATE_LEN
SYSLIB DS 0D
ORG SYSLIB+SYSLIB_TEMPLATE_LEN
DCBSSIZE EQU *-DCBS
***********************************************************************
* DCB mapping *
***********************************************************************
DCBD
END FDEMO
z/OS MVS Program Management: Advanced Facilities
Copyright IBM Corporation 1990, 2014