TCP/IP Programming Examples › Assembler Examples › Assembler TCP/IP Generic Listener Server Program
Assembler TCP/IP Generic Listener Server Program
TITLE 'Sample ASSEMBLER listener TCP/IP'
* ASMLIS RENT EP=ASMLISEP
******************************************************************
* The following program is an example of a TCP/IP generic *
* listener server program written in Assembler. *
* The processing is the following: *
* - read a message from the client (first 4 bytes = data length)*
* - send the message back to the client program *
* - if the message text is equal to "STOP" or if the connection *
* is closed, then it closes its socket and return to the *
* generic listener service. *
* - if the message text is not equal to "STOP", then it returns *
* to the generic listener service without closing its socket. *
******************************************************************
*---------------------------------------------------------------------*
MACRO
&LABEL. #SAVEREG
&LABEL. ST R12,0(,R13) Save R12
ST R14,4(,R13) Save R14
STM R2,R8,8(R13) Save R2-R8
LA R13,9*4(,R13)
MEND
*---------------------------------------------------------------------*
MACRO
&LABEL. #RESTREG
&LABEL. LA R12,9*4 Get register stack entry length
SR R13,R12 Get A(previous register stack entry)
L R12,0(,R13) Restore R12
L R14,4(,R13) Restore R14
LM R2,R8,8(R13) Restore R2-R8
MEND
*---------------------------------------------------------------------*
MACRO
&LABEL. MSGTXT &TXT.
LCLC &TMP.
&TMP. SETC '&SYSNDX'.
&LABEL. DC AL1(L2&TMP).
L1&TMP. DC C&TXT.
L2&TMP. EQU *-L1&TMP.
MEND
*---------------------------------------------------------------------*
ASMLIS CSECT
@MODE MODE=IDMSDC
#MOPT CSECT=ASMLIS,ENV=USER,RMODE=ANY,AMODE=ANY
ENTRY ASMLISEP
ASMLISEP DS 0H
BALR R12,0
BCTR R12,0
BCTR R12,0
USING ASMLISEP,R12
GETWORK #GETSTG TYPE=(USER,SHORT),ADDR=(R1),PLIST=*,INIT=X'0', X
LEN=WORKAREL
LR R11,R1
USING WORKAREA,R11
LA R13,REGSTACK
MVI OUTAREA,L'OUTAREAT
MVC OVRLOG,=X'8000000000'
MVC OVRLOGCO,=X'C000000000'
MVC WKCLEAR,=XL8'0F0F0F0F0F0F0F0F'
MVC TRTAB,=CL16'0123456789ABCDEF'
MVC TRTABX,=XL6'FAFBFCFDFEFF'
*
TCPSTART DS 0H
******************************************************************
* Read the first 4 bytes: will contain the remaining length *
******************************************************************
*
LA R5,4
ST R5,WK_LEN Set read length to 4.
XR R5,R5
ST R5,BUFLEN Set buffer length to 0.
LA R7,BUFFER_A R7 -> Buffer array.
BAL R4,TCPREAD Perform the read.
*
CLC BUFLEN(4),=F'80' Incoming buffer less than 80?
BL READCLI Y. Read client message.
LA R1,MSG04 N. Message too long,issue
L R15,=A(DISLINE) error message
BALR R14,R15 and
B TCPCLOSE close socket.
READCLI DS 0H
MVC WK_LEN,BUFLEN client msg length=read length.
LA R7,BUFFER_A+4 R7 -> client message to read.
BAL R4,TCPREAD Read client message.
*
XC OUTAREAT(L'OUTAREAT),OUTAREAT Clear out message area
MVC OUTAREAT(15),=C'Buffer Length: ' Build
L R1,BUFLEN buffer length
CVD R1,WORK1 display
OI WORK1+7,X'0F'
UNPK WORK2(9),WORK1+3(5)
MVC WORK2(8),WORK2+1 Shift value 1 byte to the left.
MVI WORK2+8,C' '
MVI WORK2+9,C' ' Clear last 2 bytes from WORK2 field.
MVC OUTAREAT+15(2),WORK2+6
LA R1,OUTAREA Display read buffer length.
L R15,=A(DISLINE)
BALR R14,R15
XC OUTAREAT(L'OUTAREAT),OUTAREAT Build
MVC OUTAREAT(8),=C'Buffer: ' buffer
MVC OUTAREAT+8,BUFTXT80 display.
LA R1,OUTAREA Display read buffer text.
L R15,=A(DISLINE)
BALR R14,R15
******************************************************************
* Send the message back to the client *
******************************************************************
MVC WK_LEN,BUFLEN
L R5,WK_LEN
LA R5,4(R5) Include 1st 4 bytes
ST R5,WK_LEN in message length.
LA R7,BUFFER_A R7 -> Buffer array.
BAL R4,TCPWRITE Perform the write.
CLC BUFLEN,=F'4' Incoming buffer length = 4?
BNE LISEXIT N. Return.
CLC BUFTXT04,=C'STOP' Y. Stop listener?
BNE LISEXIT N. Return.
B TCPCLOSE Y. Close socket.
******************************************************************
* Routine to read a message from the client *
******************************************************************
TCPREAD DS 0H
LA R1,MSG01 Display socket read function.
L R15,=A(DISLINE)
BALR R14,R15
#SOCKET READ,SOCK=S_NEWSOC,BUFFER=(R7), X
RETLEN=RETLEN,BUFFERL=WK_LEN, X
RETCODE=RETCODE,ERRNO=ERRNO,RSNCODE=RSNCODE
*
LA R1,MSG06 Display results of read.
L R15,=A(DISRC)
BALR R14,R15 Display the 3 return codes.
CLC RETCODE,=F'0' Successful read?
BNE TCPCLOSE N. Error close socket.
CLC RETLEN,=F'0' Anything left to read?
BE TCPCLOSE N.Close socket.
A R7,RETLEN Adjust buffer array pointer
L R5,WK_LEN and
S R5,RETLEN read length
ST R5,WK_LEN with message length.
CLI WK_LEN,0
BNE TCPREAD
BR R4
******************************************************************
* Routine to send a message to the client *
******************************************************************
TCPWRITE DS 0H
LA R1,MSG02 Display socket write function.
L R15,=A(DISLINE)
BALR R14,R15
#SOCKET WRITE,SOCK=S_NEWSOC,BUFFER=(R7), X
RETLEN=RETLEN,BUFFERL=WK_LEN, X
RETCODE=RETCODE,ERRNO=ERRNO,RSNCODE=RSNCODE
*
LA R1,MSG05 Display results of socket write.
L R15,=A(DISRC)
BALR R14,R15 Display the 3 return codes.
*
CLC RETCODE,=F'0' Write successful?
BNE TCPCLOSE N. Close socket.
A R7,RETLEN Adjust buffer array
L R5,WK_LEN and
S R5,RETLEN write length
ST R5,WK_LEN with message length.
CLI WK_LEN,0 Anything left to write?
BNE TCPWRITE Y. Loop back.
BR R4 N. Return.
******************************************************************
* Close the socket and exit *
******************************************************************
TCPCLOSE DS 0H
#SOCKET CLOSE,SOCK=S_NEWSOC, X
RETCODE=RETCODE,ERRNO=ERRNO,RSNCODE=RSNCODE
*
LA R1,MSG07 Display socket close function.
L R15,=A(DISRC)
BALR R14,R15 Display the 3 return codes.
*
LISEXIT DS 0H
*
#RETURN Return to caller
#BALI
*
DROP R12
LTORG
TITLE 'ASMLIS01 - DISRC : DISPLAY THE RETURN CODES'
*---------------------------------------------------------------------*
*- Rotuine to display the 3 return values from any TCP/IP calls. -*
*- Input : RETCODE, ERRNO and RSNCODE from the workarea -*
*- R1 -> String to start with (e.g.MSGTXT FORMAT) -*
*---------------------------------------------------------------------*
DISRC DS 0H
*
#SAVEREG
*
LR R12,R15
USING DISRC,R12
*
MVI OUTAREAT,C' '
MVC OUTAREAT+1(L'OUTAREAT-1),OUTAREAT
*
XR R2,R2
IC R2,0(,R1) Get message length.
BCTR R2,0 -1 FOR EX.
EX R2,DISRCEX Copy text.
LA R2,1+1+OUTAREAT(R2) Point to next free space.
*
MVC WORK1(4),RETCODE
UNPK WORK2(9),WORK1(5)
NC WORK2(8),WKCLEAR
TR WORK2(8),TRTAB
MVC 0(8,R2),=CL8'RETCODE='
MVC 8(8,R2),WORK2
*
L R15,ERRNO
CVD R15,WORK1
OI WORK1+7,X'0F'
UNPK WORK2(10),WORK1+2(6)
LA R14,WORK2
LA R15,9
DISRC01 DS 0H
CLI 0(R14),C'0'
BNE DISRC02
MVI 0(R14),C' '
LA R14,1(,R14)
BCT R15,DISRC01
DISRC02 DS 0H
MVC 17(8,R2),=CL6'ERRNO='
MVC 23(8,R2),WORK2+2
*
MVC WORK1(4),RSNCODE
UNPK WORK2(9),WORK1(5)
NC WORK2(8),WKCLEAR
TR WORK2(8),TRTAB
MVC 32(8,R2),=CL8'RSNCODE='
MVC 40(8,R2),WORK2
*
LA R1,OUTAREA
L R15,=A(DISLINE)
BALR R14,R15
*
#RESTREG
*
BR R14
*
DROP R12
*
DISRCEX MVC OUTAREAT(0),1(R1) Copy text
LTORG
TITLE 'ASMLIS - DISLINE : WRITE MESSAGE LINE TO LOG'
*---------------------------------------------------------------------*
*- Subroutine to write a message line to the log. -*
*- Input : R1 = A(output message) (first byte = message length) -*
*-----------------------------------------------------------------
DISLINE DS 0H
#SAVEREG
*
LR R12,R15
USING DISLINE,R12
LR R3,R1 Get parm in R3.
*
#WTL MSGID=M#999043,MSGDICT=NO,OVRIDES=OVRLOG, X
PARMS=((R3)),RGSV=(R2-R8)
*
#RESTREG
*
BR R14
*
DROP R12
M#999043 DC PL4'9990430'
LTORG
*
*
MSG01 MSGTXT 'Starting read.'
MSG02 MSGTXT 'Starting write.'
MSG03 MSGTXT 'Closing Socket.'
MSG04 MSGTXT 'Data length too long.'
MSG05 MSGTXT 'WRITE call:'
MSG06 MSGTXT 'READ call:'
MSG07 MSGTXT 'CLOSE call:'
DS 0F
TITLE 'ASMLIS - WORK AREA'
WORKAREA DSECT
*----------------------------------*
*- DYNAMIC DATA -*
*----------------------------------*
SYSPLIST DS 16F
REGSTACK DS 32F
*
DS 0D
WORK1 DC XL10'00'
DS 0D
WORK2 DC XL10'00' AT LEAST 10 BYTES DOUBLEWORD ALIGNED
*
*
WK_LEN DS F
*
*
SOCKADDC DS (SIN#LEN)X SOCKADDR for the LISTENER
S_NEWSOC DS F
RETLEN DS F
RETCODE DS F
ERRNO DS F
RSNCODE DS F
*
*
DS 0F
BUFFER DS CL84
ORG BUFFER
BUFLEN DS F
BUFTXT80 DS CL80
ORG BUFTXT80
BUFTXT04 DS CL4
BUFTXT76 DS CL76
ORG BUFFER
BUFFER_A DS CL84
*
*
OUTAREA DS X
OUTAREAT DC CL80' ' OUTPUT AREA
DS 0D
*
*
*----------------------------------*
*- STATIC DATA -*
*----------------------------------*
*
OVRLOG DS X'8000000000' #WTL TO LOG ONLY
OVRLOGCO DS X'C000000000' #WTL TO LOG + CONSOLE
*
WKCLEAR DS XL8'0F0F0F0F0F0F0F0F'
TRTAB DS CL16'0123456789ABCDEF'
TRTABX DS XL6'FAFBFCFDFEFF'
*
WORKAREL EQU *-WORKAREA
*
*---------------------------------------------------------------------*
*- TCP/IP TABLES -*
*---------------------------------------------------------------------*
*
#SOCKET TCPIPDEF
#SOCKET ERRNOS
*
END ASMLISEP
Copyright © 2014 CA.
All rights reserved.
|
|