z/OS Communications Server: IP CICS Sockets Guide
Previous topic | Next topic | Contents | Contact z/OS | Library | PDF


SELECTEX

z/OS Communications Server: IP CICS Sockets Guide
SC27-3649-00

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

Go to the previous page Go to the next page




Copyright IBM Corporation 1990, 2014