Coding a program in assembler language
The following sample assembler language program shows how the different parts of a command-level program fit together, and how the EXEC DLI commands are coded in a CICS® online program.
Except for a few commands, this program applies to batch, BMP, and CICS programs. Any differences are highlighted in the notes for the sample assembler code. The numbering on the right of the sample code references these notes.
*ASM XOPTS(CICS,DLI)
* 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R11 EQU 11
R12 EQU 12
R13 EQU 13
DFHEISTG DSECT
SEGKEYA DS CL4
SEGKEYB DS CL4 2
SEGKEYC DS CL4
SEGKEY1 DS CL4
SEGKEY2 DS CL4
CONKEYB DS CL8
SEGNAME DS CL8
SEGLEN DS H
PCBNUM DS H
AREAA DS CL80
AREAB DS CL80 3
AREAC DS CL80
AREAG DS CL250
AREASTAT DS CL360
* COPY MAPSET
*
*******************************************************************
* INITIALIZATION
* HANDLE ERROR CONDITIONS IN ERROR ROUTINE 4
* HANDLE ABENDS (DLI ERROR STATUS CODES) IN ABEND ROUTINE
* RECEIVE INPUT MESSAGE
*******************************************************************
*
SAMPLE DFHEIENT CODEREG=(R2,R3),DATAREG=(R13,R12),EIBREG=R11 5
*
EXEC CICS HANDLE CONDITION ERROR(ERRORS) 6
*
EXEC CICS HANDLE ABEND LABEL(ABENDS) 6
*
EXEC CICS RECEIVE MAP ('SAMPMAP') MAPSET('MAPSET') 6
* ANALYZE INPUT MESSAGE AND PERFORM NON-DLI PROCESSING
*
*******************************************************************
* SCHEDULE PSB NAMED 'SAMPLE1'
*******************************************************************
*
EXEC DLI SCHD PSB(SAMPLE1) 7
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE ROOT SEGMENT AND ALL ITS DEPENDENTS
*******************************************************************
*
MVC SEGKEYA,=C'A300' 8
EXEC DLI GU USING PCB(1) SEGMENT(SEGA) INTO(AREAA) X
SEGLENGTH(80) WHERE(KEYA=SEGKEYA) FIELDLENGTH(4)
BAL R4,TESTDIB CHECK STATUS
GNPLOOP EQU *
EXEC DLI GNP USING PCB(1) INTO(AREAG) SEGLENGTH(250)
CLC DIBSTAT,=C'GE' LOOK FOR END 9
BE LOOPDONE DONE AT 'GE'
BAL R4,TESTDIB CHECK STATUS
B GNPLOOP
LOOPDONE EQU *
*
*******************************************************************
* INSERT NEW ROOT SEGMENT
*******************************************************************
*
MVC AREAA,=CL80'DATA FOR NEW SEGMENT INCLUDING KEY'
EXEC DLI ISRT USING PCB(1) SEGMENT(SEGA) FROM(AREAA) X
SEGLENGTH(80)
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE 3 SEGMENTS IN PATH AND REPLACE THEM
*******************************************************************
*
MVC SEGKEYA,=C'A200'
MVC SEGKEYB,=C'B240'
MVC SEGKEYC,=C'C241'
EXEC DLI GU USING PCB(1) X
SEGMENT(SEGA) WHERE(KEYA=SEGKEYA) X 10
FIELDLENGTH(4) X
INTO(AREAA) X
SEGLENGTH(80) X
SEGMENT(SEGB) WHERE(KEYB=SEGKEYB) FIELDLENGTH(4) X
INTO(AREAB) X
SEGLENGTH(80) X
SEGMENT(SEGC) WHERE(KEYC=SEGKEYC) FIELDLENGTH(4) X
INTO(AREAC) X
SEGLENGTH(80)
BAL R4,TESTDIB
* UPDATE FIELDS IN THE 3 SEGMENTS
EXEC DLI REPL USING PCB(1) X
SEGMENT(SEGA) FROM(AREAA) SEGLENGTH(80) X
SEGMENT(SEGB) FROM(AREAB) SEGLENGTH(80) X
SEGMENT(SEGC) FROM(AREAC) SEGLENGTH(80)
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* INSERT NEW SEGMENT USING CONCATENATED KEY TO QUALIFY PARENT
*******************************************************************
*
MVC AREAC,=CL80'DATA FOR NEW SEGMENT INCLUDING KEY'
MVC CONKEYB,=C'A200B240'
EXEC DLI ISRT USING PCB(1) X
SEGMENT(SEGB) KEYS(CONKEYB) KEYLENGTH(8) X
SEGMENT(SEGC) FROM(AREAC) SEGLENGTH(80)
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE SEGMENT DIRECTLY USING CONCATENATED KEY
* AND THEN DELETE IT AND ITS DEPENDENTS
*******************************************************************
*
MVC CONKEYB,=C'A200B230'
EXEC DLI GU USING PCB(1) X
SEGMENT(SEGB) X
KEYS(CONKEYB) KEYLENGTH(8) X
INTO(AREAB) SEGLENGTH(80)
BAL R4,TESTDIB CHECK STATUS
EXEC DLI DLET USING PCB(1) X
SEGMENT(SEGB) SEGLENGTH(80) FROM(AREAB)
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE SEGMENT BY QUALIFYING PARENT WITH CONCATENATED KEY,
* OBJECT SEGMENT WITH WHERE OPTION USING A LITERAL,
* AND THEN SET PARENTAGE
*
* USE VARIABLES FOR PCB INDEX, SEGMENT NAME, AND SEGMENT LENGTH
*******************************************************************
*
MVC CONKEYB,=C'A200B230'
MVC SEGNAME,=CL8'SEGA'
MVC SEGLEN,=H'80'
MVC PCBNUM,=H'1'
EXEC DLI GU USING PCB(PCBNUM) X
SEGMENT((SEGNAME)) X
KEYS(CONKEYB) KEYLENGTH(8) SETPARENT X
SEGMENT(SEGC) INTO(AREAC) SEGLENGTH(SEGLEN) X
WHERE(KEYC='C520')
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE DATABASE STATISTICS
*******************************************************************
*
EXEC DLI STAT USING PCB(1) INTO(AREASTAT) X
VSAM FORMATTED LENGTH(360)
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* RETRIEVE ROOT SEGMENT USING BOOLEAN OPERATORS
*******************************************************************
*
MVC SEGKEY1,=C'A050'
MVC SEGKEY2,=C'A150'
EXEC DLI GU USING PCB(1) SEGMENT(SEGA) INTO(AREAA) X
SEGLENGTH(80) FIELDLENGTH(4,4,4,4) X
WHERE(KEYA > SEGKEY1 AND KEYA < SEGKEY2
KEYA > 'A275' AND KEYA < 'A350')
BAL R4,TESTDIB CHECK STATUS
*
*******************************************************************
* TERMINATE PSB WHEN DLI PROCESSING IS COMPLETED
*******************************************************************
*
EXEC DLI TERM 11
*
*******************************************************************
* SEND OUTPUT MESSAGE
*******************************************************************
*
EXEC CICS SEND MAP('SAMPMAP') MAPSET('MAPSET') 6
EXEC CICS WAIT TERMINAL
*
*******************************************************************
* COMPLETE TRANSACTION AND RETURN TO CICS
*******************************************************************
*
EXEC CICS RETURN 12
*
*******************************************************************
* CHECK STATUS IN DIB
*******************************************************************
*
TESTDIB EQU *
CLC DIBSTAT,=C' ' IS STATUS BLANK 13
BER R4 YES - RETURN
* HANDLE DLI STATUS CODES REPRESENTING EXCEPTIONAL CONDITIONS
*
BR R4 RETURN
ERRORS EQU *
* HANDLE ERROR CONDITIONS
*
ABENDS EQU *
* HANDLE ABENDS INCLUDING DLI ERROR STATUS CODES
*
ENDNotes for the sample assembler code:
- 1 For a CICS online program containing EXEC DLI commands, you must specify the DLI and CICS options. For a batch or BMP program containing EXEC DLI, you must specify only the DLI option.
- 2 For reentry, define each of the areas the program uses—I/O areas, key feedback areas, and segment name areas in DFHEISTG.
- 3 Define an I/O area for each segment you retrieve, add, or replace (in a single command).
- 4 For a batch or BMP program containing EXEC DLI, you must save registers on entry and restore registers on exit according to z/OS® register-saving conventions.
- 5 In a batch or BMP program, aDFHEIRET with an optional DFHEIENT saves the registers on entry. Do not specify the EIBREG parameter in a batch program.
- 6 Do not code EXEC CICS commands in a batch or BMP program.
- 7 In a CICS online program,
use the
SCHD PSBcommand to obtain a PSB for the use of your program. Do not schedule a PSB in a batch or BMP program. - 8 This
GUcommand retrieves the first occurrence of SEGA with a key of A300. You do not have to provide the KEYLENGTH or SEGLENGTH options in an assembler language program. - 9 This
GNPcommand retrieves all dependents under segment SEGA. The GE status code indicates that no more dependents exist. - 10 This
GUcommand is an example of a path command. Use a separate I/O area for each segment you retrieve. - 11 In a CICS online program,
the
TERMcommand terminates the PSB scheduled earlier. You do not terminate the PSB in a batch or BMP program. - 12 For a batch or BMP program, code RCREG parameter instead of EXEC CICS RETURN. The RCREG parameter identifies a register containing the return code.
- 13 After issuing each command, you should check the status code in the DIB.