The following sample displays COBOL code issuing the SELECTEX
socket call:
This is sample COBOL code issuing the SELECTEX socket call:
*------------------------------------------------------------------*
* Here is a anotated SAMPLE code from a test tool used to test *
* the SELECTEX: *
*------------------------------------------------------------------*
WORKING-STORAGE SECTION.
01 SELECT-BITMASK PIC 9(16) BINARY VALUE 0.
01 SELECT-BITMASK-LEN PIC 9(8) BINARY VALUE 0.
01 SELECT-CHAR-STRING PIC X(64).
01 SELECT-MAXSOC PIC 9(8) BINARY VALUE 0.
01 SELECT-TIMEOUT.
03 SELECT-TIMEOUT-SECONDS PIC S9(8) BINARY VALUE 0.
03 SELECT-TIMEOUT-MICROSEC PIC S9(8) BINARY VALUE 0.
01 SELECT-RSNDMSK PIC 9(16) BINARY.
01 SELECT-WSNDMSK PIC 9(16) BINARY.
01 SELECT-ESNDMSK PIC 9(16) BINARY.
01 SELECT-RRETMSK PIC 9(16) BINARY.
01 SELECT-WRETMSK PIC 9(16) BINARY.
01 SELECT-ERETMSK PIC 9(16) BINARY.
77 SELECT-ECB-PTR USAGE IS POINTER.
LINKAGE SECTION.
01 SELECT-ECB PIC 9(8) BINARY.
PROCEDURE DIVISION USING L1.
PROCESS-SELECTEX.
*
* GET SHARED STORAGE FOR ECB.
*
EXEC CICS GETMAIN SHARED
SET (SELECT-ECB-PTR)
FLENGTH (4)
INITIMG ('00')
END-EXEC.
SET ADDRESS OF SELECT-ECB TO SELECT-ECB-PTR.
INITIALIZE SELECT-ECB.
*
* WRITE ECB ADDRESS TO TS QUEUE
*
EXEC CICS WRITEQ TS
QUEUE ('POSTECB@')
FROM (SELECT-ECB-PTR)
LENGTH (4)
END-EXEC.
*
* SOCKET CALL SELECTEX
*
MOVE 10 TO SELECT-MAXSOC.
MOVE -1 TO SELECT-TIMEOUT-SECONDS.
MOVE -1 TO SELECT-TIMEOUT-MICROSEC.
MOVE read-send-maskTO SELECT-CHAR-STRING.
MOVE 64 TO SELECT-BITMASK-LEN.
CALL 'EZACIC06' USING CTOB
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-BITMASK TO SELECT-RSNDMSK.
MOVE write-send-maskTO SELECT-CHAR-STRING.
MOVE 64 TO SELECT-BITMASK-LEN.
CALL 'EZACIC06' USING CTOB
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-BITMASK TO SELECT-WSNDMSK.
MOVE exception-send-maskTO SELECT-CHAR-STRING.
MOVE 64 TO SELECT-BITMASK-LEN.
CALL 'EZACIC06' USING CTOB
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-BITMASK TO SELECT-ESNDMSK.
CALL 'EZASOKET' USING SOKET-SELECTEX
SELECT-MAXSOC
SELECT-TIMEOUT
SELECT-RSNDMSK
SELECT-WSNDMSK
SELECT-ESNDMSK
SELECT-RRETMSK
SELECT-WRETMSK
SELECT-ERETMSK
SELECT-ECB
ERRNO
RETCODE.
*
* FREE THE STORAGE FOR THE ECB
*
EXEC CICS FREEMAIN
DATAPOINTER(SELECT-ECB-PTR)
END-EXEC.
*
* DELETE THE TS QUEUE
*
EXEC CICS DELETEQ TS
QUEUE ('POSTECB@')
END-EXEC.
IF RETCODE < 0 THEN
MOVE 'SELECTEX FAILED' TO MSG1
ELSE
MOVE 'SELECTEX PROCESSED' TO MSG1.
MOVE SELECT-RRETMSK TO SELECT-BITMASK.
CALL 'EZACIC06' USING BTOC
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-CHAR-STRING TO read-returned-mask.
MOVE SELECT-WRETMSK TO SELECT-BITMASK.
CALL 'EZACIC06' USING BTOC
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-CHAR-STRING TO write-returned-mask.
MOVE SELECT-ERETMSK TO SELECT-BITMASK.
CALL 'EZACIC06' USING BTOC
SELECT-BITMASK
SELECT-CHAR-STRING
SELECT-BITMASK-LEN
RETCODE.
MOVE SELECT-CHAR-STRING TO exception-returned-mask.
PROCESS-SELECTEX-EXIT.
EXIT.
*------------------------------------------------------------------*
* Here is the anotated SAMPLE code from a test tool used to *
* call the subroutine used to post the ECB: *
*------------------------------------------------------------------*
WORKING-STORAGE SECTION.
01 POST-ECB-ADDRESS PIC 9(8) BINARY.
01 POST-ECB-LEN PIC 9(4) BINARY.
PROCEDURE DIVISION USING L1.
PROCESS-POSTECB.
*
* LOOK FOR THE ADDRESS OF THE ECB IN TEMP STORAGE
*
MOVE 4 TO POST-ECB-LEN.
EXEC CICS READQ TS
ITEM (1)
QUEUE ('POSTECB@')
INTO (POST-ECB-ADDRESS)
LENGTH (POST-ECB-LEN)
END-EXEC.
CALL 'POSTECB' USING POST-ECB-ADDRESS
RETCODE.
IF RETCODE < 0 THEN
MOVE 'POSTECB FAILED'
TO MSG1
ELSE
MOVE 'POSTECB PROCESSED'
TO MSG.
PROCESS-POSTECB-EXIT.
EXIT.
*------------------------------------------------------------------*
* Here is a sample assembler program that can be used to post the *
* SELECTEX ECB: *
*------------------------------------------------------------------*
TITLE 'POSTECB'
POSTECB CSECT , ENTRY POINT OF THIS CONTROL SECTION
POSTECB AMODE ANY ADDRESSING MODE...
POSTECB RMODE ANY RESIDENCY MODE...
USING POSTECB,R15 USE ENTRY REGISTER AS BASE
POSTECB MODID EYECATCHER INFO
SAVE (14,12) SAVE THE CALLERS REGISTERS
LR R9,R15
DROP R15
USING POSTECB,R9 USE R90 AS BASE REGISTER
L R12,0(R1) LOAD ECB ADDRESS
L R10,0(0,R12) LOAD CONTENTS OF ECB
L R12,0(0,R12) LOAD CONTENTS OF ECB
L R11,NEWECB LOAD CONTENTS OF NEW ECB
TM 0(R12),X'80' CHECK IF WAIT ISSUED
BO POST0100 IF YES, ISSUE POST MACRO
CS R10,R11,0(R12) IF NO, TRY QUICK POST
BC 4,POST0100 IF UNSUCCESSFUL, ISSUE POST MACRO
B POST9999 RETURN TO CALLER
POST0100 DS 0H
POST (R12),255
POST9999 DS 0H
RETURN (14,12) RETURN TO CALLER
ECBADDR DS F
NEWECB DC X'400000FF' ECB WITH POST BIT ON AND CC=255
LTORG
YREGS
END