EZAIMSC3 CSECT
EZAIMSC3 AMODE ANY
EZAIMSC3 RMODE ANY
GBLB &TRACE ASSEMBLER VARIABLE TO CONTROL TRACE GENERATION
&TRACE SETB 1 1=TRACE ON 0=TRACE OFF
GBLB &SUBTR ASSEMBLER VARIABLE TO CONTROL SUBTRACE
&SUBTR SETB 0 1=SUBTRACE ON 0=SUBTRACE OFF
*---------------------------------------------------------------------*
* *
* MODULE NAME: EZAIMSC3 *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* Copyright IBM Corp. 2009 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R11 *
* *
* MODULE FUNCTION: Sample program of an IMS MPP TCP client. This *
* module connects with a TCP/IP server and *
* exchanges msgs with it. The number of msgs *
* exchanged is determined by a constant and *
* the length of the messages is also determined *
* by a constant. *
* Note: If an error occurs during processing, this *
* module will send an error message to the system *
* console and then Abends0c1. *
* *
* LANGUAGE: Assembler *
* *
* ATTRIBUTES: Reusable *
* *
* INPUT: None *
* *
* Change History: *
* *
* Flag Reason Release Date Origin Description *
* ---- -------- -------- ------ -------- --------------------------- *
* $Q1= D316.15 CSV1R5 020604 BKELSEY : Support 64K sockets *
* $F1= RBBASE CSV1R11 080612 Herr : Cleaned up >72 lines *
* *
*---------------------------------------------------------------------*
SOC0000 DS 0H
USING *,R15 Tell assembler to use reg 15
B SOC00100 Branch to startup address
DC CL16'IMSTCPCLEYECATCH'
BUFLEN EQU 1000 Set length of I/O buffers
R4BASE DC A(SOC0000+4096)
*---------------------------------------------------------------------*
* Control Variables for this program *
*---------------------------------------------------------------------*
SOCMSGN DC F'005' Number of messages to be exchanged
SOCMSGL DC F'200' Length of messages to be exchanged
SERVPORT DC H'5000' Port Address of Server
SOCTASK DC F'0' Task number for this client
SERVLEN DC H'0' Length of server's name
SERVNAME DC CL24' ' Internet name of server
SENDINT DC CL8'00000010' Delay interval between sends
*---------------------------------------------------------------------*
* Constants used for call functions *
*---------------------------------------------------------------------*
INITAPI DC CL16'INITAPI'
GETHSTID DC CL16'GETHOSTID'
SOCKET DC CL16'SOCKET'
GHBN DC CL16'GETHOSTBYNAME'
CONNECT DC CL16'CONNECT'
READ DC CL16'READ'
WRITE DC CL16'WRITE'
CLOSE DC CL16'CLOSE'
TERMAPI DC CL16'TERMAPI'
*---------------------------------------------------------------------*
* Beginning of program execution statements *
*---------------------------------------------------------------------*
SOC00100 DS 0H Beginning of program
STM R14,R12,12(R13) Save callers registers
LR R3,R15 Move base reg to R3
L R4,R4BASE Add R4 as second base reg
DROP R15 Tell assembler to drop R15 as base
USING SOC0000,R3,R4 Tell assembler to use R3 and R4 as X
base registers
LR R7,R13 Save address of previous save area
LA R12,SOCSTG Move address of program stg to R12
LA R13,SOCSTGL Move length of program stge to R13
SR R14,R14 Clear R14
SR R15,R15 Clear R15
MVCL R12,R14 Clear program storage
LA R13,SOCSTG Move address of program stg to R13
USING SOCSTG,R13 Tell Assembler about storage
ST R7,SOCSAVEL Save address of lower save area
ST R13,8(R7) Complete save area chain
SOC00200 DS 0H
*
* Build message for console
*
MVC MSG1D,MSG1C Initialize first part of message
L R0,SOCTASK Get task number
CVD R0,DWORK Convert task number to decimal
UNPK MSGTD,DWORK+5(3) Convert decimal to character
OI MSGTD+4,X'F0' Clear sign
MVC MSG2D,MSG2CS Move 'Started' to message
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
MVC WTOLIST,WTOPROT Move prototype WTO to list form
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
*
* Issue INITAPI Call to connect to interface
*
MVC SOCTASKC(3),=CL3'SOC' Build Task Identifier
MVC SOCTASKC+3(5),MSGTD
MVC MSG2D,MSG2C1 Move 'INITAPI'to message
MVC MAXSOC,=AL2(50) Initialize MAXSOC field
MVC ASTCPNAM,=CL8'TCPV3 ' Initialize TCP Name
MVC ASCLNAME,=CL8'TCPCLINT' Initialize AS Name
*
CALL EZASOKET, X
(INITAPI,MAXSOC,ASIDENT,SOCTASKC,HISOC,ERRNO, X
RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE01
* TRACE ENTRY FOR INITAPI TRACE TYPE = 1
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE01 ANOP
*
* Issue GETHOSTID Call to obtain internet address of host
*
MVC MSG2D,MSG2C8 Move 'GTHSTID'to message
*
CALL EZASOKET, Issue GETHOSTID Call X
(GETHSTID,SERVIADD), X
VL Specify Variable parameter list
*
AIF (NOT &TRACE).TRACE08
* TRACE ENTRY FOR GETHOSTID TRACE TYPE = 8
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE08 ANOP
*
* Issue SOCKET Call to obtain a socket descriptor
*
MVC MSG2D,MSG2C2 Move 'SOCKET' to message
MVC AF,=F'2' Address Family = Internet
MVC SOCTYPE,=F'1' Type = Stream Sockets
XC PROTO,PROTO Clear protocol field
*
CALL EZASOKET, Issue SOCKET Call X
(SOCKET,AF,SOCTYPE,PROTO,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE02
* TRACE ENTRY FOR SOCKET TRACE TYPE = 2
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE02 ANOP
*
* Get socket descriptor number
*
L R6,RETCODE Descriptor number returned
STH R6,SOCDESC Save it
*
* Issue CONNECT Command to Connect to Server
*
MVC SSOCAF,=H'2' Set AF=INET
MVC SSOCPORT,SERVPORT Move Port Number
MVC SSOCINET,SERVIADD Move Internet Address of Server
MVC MSG2D,MSG2C4 Move 'CONNECT' to message
*
CALL EZASOKET, Issue CONNECT Call X
(CONNECT,SOCDESC,SERVSOC,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE04
* TRACE ENTRY FOR CONNECT TRACE TYPE = 4
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE04 ANOP
*
* Send initial message to server
*
MVC BUFFER(L'MSG1),MSG1 Move Message to Buffer
LA R6,L'MSG1 Get length of message
ST R6,DATALEN Put length in data field
MVC MSG2D,MSG2C5 Move 'WRITE' to message
*
CALL EZASOKET, Issue WRITE Call X
(WRITE,SOCDESC,DATALEN,BUFFER,ERRNO,RETCODE), X
VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE05
* TRACE ENTRY FOR WRITE TRACE TYPE = 5
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE05 ANOP
*
* Read response to initial message
*
MVC MSG2D,MSG2C6 Move 'READ' to message
LA R6,L'BUFFER Get length of buffer
ST R6,DATALEN Put length in data field
*
CALL EZASOKET, Issue READ Call X
(READ,SOCDESC,DATALEN,BUFFER,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE06
* TRACE ENTRY FOR READ TRACE TYPE = 6
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE06 ANOP
*
* Send second message to server
*
MVC BUFFER(L'MSG2),MSG2 Move Message to Buffer
LA R6,L'MSG2 Get length of message
ST R6,DATALEN Put length in data field
MVC MSG2D,MSG2C5 Move 'WRITE' to message
*
CALL EZASOKET, Issue WRITE Call X
(WRITE,SOCDESC,DATALEN,BUFFER,ERRNO,RETCODE), X
VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE15
* TRACE ENTRY FOR WRITE TRACE TYPE = 5
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE15 ANOP
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
* Read response to second message
*
MVC MSG2D,MSG2C6 Move 'READ' to message
*
CALL EZASOKET, Issue READ Call X
(READ,SOCDESC,SOCMSGL,BUFFER,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
AIF (NOT &TRACE).TRACE16
* TRACE ENTRY FOR READ TRACE TYPE = 6
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE16 ANOP
*
* Send End message to server
*
MVC BUFFER(L'ENDMSG),ENDMSG Move end message to buffer
LA R6,L'ENDMSG Get length of message
ST R6,SOCMSGL Put length in length field
MVC MSG2D,MSG2C5 Move 'WRITE' to message
*
CALL EZASOKET, Issue WRITE Call X
(WRITE,SOCDESC,SOCMSGL,BUFFER,ERRNO,RETCODE), X
VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE25
* TRACE ENTRY FOR WRITE TRACE TYPE = 5
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE25 ANOP
*
* Read response to end message
*
MVC MSG2D,MSG2C6 Move 'READ' to message
*
CALL EZASOKET, Issue READ Call X
(READ,SOCDESC,SOCMSGL,BUFFER,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE26
* TRACE ENTRY FOR READ TRACE TYPE = 6
MVC MSGLEN,=AL2(MSGTL+18) Put length of text in msg hdr.
MVC MSG3D,ERR3C ' RETCODE= '
MVI MSG3S,C'+' Move sign
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK MSG4D,DWORK+4(4) Unpack it
OI MSG4D+6,X'F0' Correct the sign
LA R6,MSG Put text address in R6
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE26 ANOP
*
* Close socket
*
MVC MSG2D,MSG2C7 Move 'CLOSE' to message
*
CALL EZASOKET, Issue CLOSE Call X
(CLOSE,SOCDESC,ERRNO,RETCODE), X
VL Specify variable parameter list
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE07
* TRACE ENTRY FOR CLOSE TRACE TYPE = 7
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE07 ANOP
*
* Terminate Connection to API
*
CALL EZASOKET, Issue TERMAPI Call X
(TERMAPI), X
VL Specify variable parameter list
*
* Issue console message for task termination
*
MVC MSG2D,MSG2CE Move 'Ended' to message
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
*
* Return to Caller
*
L R13,SOCSAVEL
LM R14,R12,12(R13)
BR R14
*
* Write error message to operator and ABENDS0C1
*
SOCERR DS 0H Write error message to operator
MVC ERR1D,MSG1D 'IMSTCPCL, TASK #'
MVC ERRTD,MSGTD Move task number to message
MVC ERR2D,MSG2D Call Type
MVC ERR3D,ERR3C ' RETCODE= '
MVI ERR3S,C'-' Move sign which is always minus
MVC ERR5D,ERR5C ' ERRNO= '
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK ERR4D,DWORK+4(4) Unpack it
OI ERR4D+6,X'F0' Correct the sign
L R6,ERRNO Get errno value
CVD R6,DWORK Convert it to decimal
UNPK ERR6D,DWORK+4(4) Unpack it
OI ERR6D+6,X'F0' Correct the sign
LA R6,ERR Put text address in R6
MVC ERRLEN,=AL2(ERRTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
ABEND DS 0H
DC H'0' Force ABEND
WTOPROT WTO TEXT=, List form of WTO Macro X
MF=L
WTOPROTL EQU *-WTOPROT Length of WTO Prototype
MSG1C DC CL17'IMSTCPCL, TASK # '
MSG2CS DC CL8' STARTED'
MSG2CE DC CL8' ENDED '
ERR3C DC CL10' RETCODE= '
ERR5C DC CL8' ERRNO= '
MSG2C1 DC CL8' INITAPI'
MSG2C2 DC CL8' SOCKET '
MSG2C4 DC CL8' CONNECT'
MSG2C5 DC CL8' WRITE '
MSG2C6 DC CL8' READ '
MSG2C7 DC CL8' CLOSE '
MSG2C8 DC CL8' GTHSTID'
MSG2C35 DC CL8' SYNC '
MSG1 DC CL16'CLIENT MESSAGE 1' First msg to server
MSG2 DC CL16'CLIENT MESSAGE 2' 2nd msg to server
ENDMSG DS 0CL48 End Message for Server
DC CL3'END' End indicator for SRV1
DC CL45' ' Pad with blanks
DS 0D
SOCSTG DS 0F PROGRAM STORAGE
SOCSAVE DS 0F Save Area
SOCSAVE1 DS F Word for high-level languages
SOCSAVEL DS F Address of previous save area
SOCSAVEH DS F Address of next save area
SOCSAV14 DS F Reg 14
SOCSAV15 DS F Reg 15
SOCSAV0 DS F Reg 0
SOCSAV1 DS F Reg 1
SOCSAV2 DS F Reg 2
SOCSAV3 DS F Reg 3
SOCSAV4 DS F Reg 4
SOCSAV5 DS F Reg 5
SOCSAV6 DS F Reg 6
SOCSAV7 DS F Reg 7
SOCSAV8 DS F Reg 8
SOCSAV9 DS F Reg 9
SOCSAV10 DS F Reg 10
SOCSAV11 DS F Reg 11
SOCSAV12 DS F Reg 12
SOCSAV13 DS F Reg 13
MAXSOC DS H Maximum number of sockets for this X
application
SOCTASKC DS CL8 Character task identifier
SOCDESC DS H Socket Descriptor Number
HISOC DS F Highest socket descriptor available
AF DS F Address family for socket call
SOCTYPE DS F Type of socket
NS DS F New socket number for socket call
SERVAL DS 12F Alias array for server
SERVSOC DS 0F Socket Address of Server
SSOCAF DS H Address Family of Server = 2
SSOCPORT DS H Port number for Server
SSOCINET DS F Internet address for Server
DC D'0' Reserved
MSG DS 0F Message area
MSGLEN DS H Length of message
MSG1D DS CL17 'IMSTCPCL, TASK #'
MSGTD DS CL5 Task Number
MSG2D DS CL8 Last part of message
MSGE EQU * End of message
MSGTL EQU MSGE-MSG1D Length of message text
MSG3D DS CL10 ' RETCODE = '
MSG3S DS C Sign which is always -
MSG4D DS CL7 Return code
ERR DS 0F Error message area
ERRLEN DS H Length of message
ERR1D DS CL17 'IMSTCPCL, TASK #'
ERRTD DS CL5 Task Number
ERR2D DS CL8 Last part of message
ERR3D DS CL10 ' RETCODE = '
ERR3S DS C Sign which is always -
ERR4D DS CL7 Return code
ERR5D DS CL8 ' ERRNO ='
ERR6D DS CL7 Error number
ERRE EQU * End of message
ERRTL EQU ERRE-ERR1D Length of message text
BUFFER DS CL(BUFLEN) Socket I/O Buffer
DATALEN DS F Length of buffer data
DWORK DS D Double word work area
RECNO DS PL4 Record Number
ERRNO DS F Error number returned from call
RETCODE DS F Return code from call
PROTO DS F Protocol field for socket
ASIDENT DS 0F Address space identifier for initapi
ASTCPNAM DS CL8 Name of TCP/IP Address Space
SERVIADD DS F Internet address for Server
ASCLNAME DS CL8 Our name as known to TCP/IP
WTOLIST DS CL(WTOPROTL) List form of WTO Macro
SOCSTGE EQU * End of Program Storage
SOCSTGL EQU SOCSTGE-SOCSTG Length of Program Storage
LTORG
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
GWABAR EQU 13
END
Figure 1. Sample
of IMS™ program as a client
z/OS Communications Server: IP IMS Sockets Guide
Copyright IBM Corporation 1990, 2014