Sample HPNS Client Application

HPNS is the IBM "High Performance Network Sockets" API. This example is the full program from which snippets have been taken as examples in the Sockets Programming Tutorial. The application connects to a web server and uses the HTTP 1.0 protocol to request the root page of the web site.

The program is written as re-entrant with 31 bit addressability (but using 64 bit registers) and where possible relative addressing. To assemble the code the assembler SYSLIB DD will typically need to reference SYS1.MACLIB, SYS1.MODGEN and TCPIP.SEZACMAC in order to access the system and API macros used.

The program is broken into the following steps:

  1. Entry linkage and storage obtain for:
  2. A series of calls to sockets sub-routines. As the EZASMI macro require a base register these are located in the base addressable portion of the program (along with program constants etc.).
  3. A message and trace subroutine for outputing to SYSPRINT.
  4. Termination and cleanup.
Sockets
Contents
Contents
Sockets
Examples
Prev

 

The Code


*              *************************************** 
*              *                                     * 
****************            VOF Synesis              ***************** 
*              *                                     *               * 
*              ***************************************               * 
*                                                                    * 
* A sample HPNS (API type 2) IP V4 client application that uses the  * 
* HTTP 1.0 protocol to GET a pre-defined page from a web server.     * 
*                                                                    * 
* This example program is provided to illustrate use of the IBM HPNS * 
* API (EZASMI) on a best effort basis. There is no warranty to its   * 
* functioning in any environment nor to its suitability for any      * 
* express function. You are free to include the entirety or portions * 
* of this code into your own environment/application as you wish and * 
* under your own responsibility with regard suitability of purpose.  * 
*                                                                    * 
********************************************************************** 
&RMT_ADDR SETC  '127.0.0.1'              Target web server IP address 
&RMT_PORT SETC  '80'                     Port number on server 
&TCP_ASN  SETC  'TCPIP'                  TCP address space name 
********************************************************************** 
* Program Start                                                      * 
********************************************************************** 
CLIENT   CSECT ,                       ******************************* 
CLIENT   AMODE 31                      * Binder/Loader info          * 
         SYSSTATE ASCENV=P,            * System macro info           * X 
               AMODE64=NO,             * Amode not 64                * X 
               ARCHLVL=2               * ArchLevel V1R4 compat       * 
         J     PROLOG                  *                             * 
         DC    AL1(PROLOG-*+1)         *                             * 
         DC    C'CLIENT &SYSDATE'      *                             * 
*                                      ******************************* 
********************************************************************** 
* Program Entry                                                      * 
********************************************************************** 
PROLOG   DS    0H                      ******************************* 
         BAKR  R14,0                   * Save callers regs to stack  * 
         LARL  R12,PGM_CONST           * Base register addressbility * 
         USING PGM_CONST,R12           * inform HLASM                * 
****************************************                             * 
* Get work area 1 storage                                            * 
****************************************                             * 
         LA    R3,WORK_AREA_1_LENGTH   * Length of storage area      * 
         STORAGE OBTAIN,LENGTH=(R3),BNDRY=PAGE get storage           * 
         LR    R13,R1                  * R13 = work area address     * 
         USING WORK_AREA_1,R13         *                             * 
         MVC   4(4,R13),=C'F1SA'       * indicate used stack         * 
****************************************                             * 
* Get work area 2 storage (note not zero'd)                          * 
****************************************                             * 
         LA    R3,WORK_AREA_2_LENGTH   * Length of storage area      * 
         STORAGE OBTAIN,LENGTH=(R3),LOC=BELOW  get storage           * 
         ST    R1,W1_WA2               * save in WA1                 * 
         LA    R2,W2_DCB-WORK_AREA_2(,R1) R2 = A(DCB)                * 
         USING IHADCB,R2               *                             * 
         MVC   0(MODEL_DCB_LENGTH,R2),MODEL_DCB init DCB             * 
         MVC   DCBDDNAM,=CL8'SYSPRINT' * set DD name                 * 
*                                      ******************************* 
         DROP  R2 
********************************************************************** 
* Get our job name                                                   * 
********************************************************************** 
*                                      ******************************* 
         LLGT  R1,PSATOLD-PSA(0)       * Old TCB pointer             * 
         L     R1,TCBTIO-TCB(,R1)      * TIOT                        * 
         MVC   W1_JOBNM,TIOCNJOB-TIOT1(R1) Jobname                   * 
*                                      ******************************* 
********************************************************************** 
* Open the SYSPRINT dataset                                          * 
********************************************************************** 
*                                      ******************************* 
         MVC   W1_PLIST(MODEL_OPEN_LENGTH),MODEL_OPEN init OPEN plist* 
         OPEN  ((R2),OUTPUT),          * do the OPEN                 * X 
               MF=(E,W1_PLIST)         *                             * 
****************************************                             * 
* Write message 1 to log                                             * 
****************************************                             * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_001              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R1,W1_JOBNM             * Addr jobname                * 
         ST    R1,W1_MSG_MPB+MPB_ADDR-MPB save as parm 1 addr        * 
         MVC   W1_MSG_MPB+MPB_LENG-MPB(2),=H'8' parm length          * 
         JAS   R14,DO_MSG              * Go print message            * 
*                                      ******************************* 
********************************************************************** 
* Init the TCP interface                                             * 
********************************************************************** 
*                                      ******************************* 
         JAS   R14,DO_INITAPI          * Call INITAPI                * 
         LTR   R15,R15                 * OK ?                        * 
         JNZ   MN_RETURN               * N - exit                    * 
*                                      ******************************* 
********************************************************************** 
* Get and Init a Connection Work Area block, call socket open        * 
********************************************************************** 
*                                      ******************************* 
         LA    R3,CWA_BLOCK_LENGTH     * Length of storage area      * 
         STORAGE OBTAIN,LENGTH=(R3)    * Get storage                 * 
         LR    R9,R1                   * Address in R9 CWAREG        * 
         USING CWA_BLOCK,R9            * Addressability              * 
         MVC   CWA_ID,=C'CB'           * Block id                    * 
         STH   R3,CWA_LEN              * Save length                 * 
         LGR   R2,R9                   * R2 has addr, R3 length      * 
         XGR   R15,R15                 * Clear R15                   * 
         MVCL  R2,R14                  * Clear the CWA_BLOCK         * 
         MVI   CWA_CONN_NAME,C' '      * Blank connection name       * 
         MVC   CWA_CONN_NAME+1(L'CWA_CONN_NAME-1),CWA_CONN_NAME      * 
****************************************                             * 
* Init the CWA                                                       * 
****************************************                             * 
         MVI   CWA_ROLE,C'C'           * Client                      * 
         MVC   CWA_CONN_NAME(15),=CL15'&RMT_ADDR'                    * 
         MVI   SOCK_LEN-SOCKADDR+CWA_RMT_ADDR,SOCK_SIN#LEN           * 
         MVI   SOCK_FAMILY-SOCKADDR+CWA_RMT_ADDR,AF_INET             * 
         MVC   SOCK_SIN_PORT-SOCKADDR+CWA_RMT_ADDR,=H'&RMT_PORT'     * 
         JAS   R14,GET_ADDR            * Go get IP addr              * 
****************************************                             * 
* Call socket open                                                   * 
****************************************                             * 
         JAS   R14,DO_SOCKET           * Call Socket                 * 
         LTGR  R15,R15                 * OK ?                        * 
         JNZ   MN_TERMINATE            * N - exit                    * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_006              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R14,W1_MSG_MPB          * MPB 1                       * 
         USING MPB,R14                 *                             * 
         LA    R1,CWA_SOCNO            * Addr Socket number          * 
         ST    R1,MPB_ADDR             * save as parm 4 addr         * 
         MVI   MPB_OPT,MPB_OPT_H2D     * halfword to decimal         * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 4                  * 
         LA    R1,CWA_CONN_NAME        * Addr connection name        * 
         ST    R1,MPB_ADDR             * save as parm 3 addr         * 
         MVC   MPB_LENG,=H'32'         * Limited space ....          * 
         JAS   R14,DO_MSG              * Go print message            * 
*                                      ******************************* 
         DROP  R14 
********************************************************************** 
* Build the connection                                               * 
********************************************************************** 
*                                      ******************************* 
         JAS   R14,DO_CONNECT          * Call Connect                * 
         LTGR  R15,R15                 * OK ?                        * 
         JNZ   MN_CLOSE                * N - exit                    * 
*                                      ******************************* 
********************************************************************** 
* Send data                                                          * 
********************************************************************** 
*                                      ******************************* 
         LA    R3,BUF_BLOCK_LENGTH     * Length of buffer header     * 
         A     R3,=F'4096'             * Length for data             * 
         STORAGE OBTAIN,LENGTH=(R3)    * Get storage                 * 
         ST    R1,CWA_SBUF             * Send buffer address         * 
         LR    R8,R1                   * Address in R8 BUFREG        * 
         USING BUF_BLOCK,R8            * Addressability              * 
****************************************                             * 
* Init buffer header                                                 * 
****************************************                             * 
         XC    0(16,R8),0(R8)          * Clear the header            * 
         MVI   BUF_ID,C'B'             * Buffer                      * 
         MVI   BUF_FUNC,C'D'           * Data buffer                 * 
         MVI   BUF_STAT,BUF_STAT_ACTV  * Buffer in use               * 
         STH   R3,BUF_BLEN             * Save buffer length          * 
         MVC   BUF_DOFF,=H'16'         * Data origin                 * 
         LA    R15,DAT1_LENGTH         * Length of data              * 
         ST    R15,BUF_DLEN            * Save in buffer header       * 
****************************************                             * 
* Move in data, trace and translate                                  * 
****************************************                             * 
         LARL  R1,DAT1                 * Location of data FROM ptr   * 
         LA    R2,BUF_DATA             * Location for data TO ptr    * 
         JAS   R14,DO_MVCL             * Move data to buffer         * 
         LA    R1,BUF_DATA             * Data address                * 
         LGF   R15,BUF_DLEN            * Data length                 * 
         JAS   R14,DO_TRACE            * Go trace data               * 
         LA    R1,BUF_DATA             * Addr of data                * 
         LARL  R2,E2ATAB               * 256 bytes +                 * 
         LGF   R15,BUF_DLEN            * Length of data              * 
         JAS   R14,DO_XLAT             * go translate                * 
****************************************                             * 
* Call DO_SEND                                                       * 
****************************************                             * 
         JAS   R14,DO_SEND             *                             * 
         LTGR  R15,R15                 * complete OK ?               * 
         JNZ   MN_SHUTDOWN             * N - shutdown connection     * 
         J     MN_DO_RECEIVE           *                             * 
*                                      ******************************* 
DAT1     DC    C'GET / HTTP/1.0',X'0D25' 
         DC    X'0D25' 
DAT1_LENGTH EQU *-DAT1 
********************************************************************** 
* Receive response (into same buffer used by send)                   * 
********************************************************************** 
MN_DO_RECEIVE DS 0H                    ******************************* 
         OI    CWA_STATE,CWA_STATE_DUMP                              * 
         MVC   CWA_RBUF,CWA_SBUF       * Use same buffer as send     * 
         XC    CWA_SBUF,CWA_SBUF       * Clear send buffer addr      * 
         MVC   BUF_DOFF,=H'16'         * Reset data offset           * 
         XC    BUF_DLEN,BUF_DLEN       * Reset data length           * 
         JAS   R14,DO_RECEIVE          *                             * 
         LTGR  R15,R15                 *                             * 
         JNZ   MN_SHUTDOWN             *                             * 
         LGF   R15,CWA_RETCD           * Length received             * 
         LTGR  R15,R15                 * Any data ?                  * 
         JZ    MN_DISCONN              * N - disconnected            * 
         AGF   R15,BUF_DLEN            * Previous length             * 
         ST    R15,BUF_DLEN            * Save in buffer              * 
****************************************                             * 
* Log receive request                                                * 
****************************************                             * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_008              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R14,W1_MSG_MPB          * MPB 1                       * 
         USING MPB,R14                 *                             * 
         LA    R1,CWA_RETCD            * Addr Socket number          * 
         ST    R1,MPB_ADDR             * save as parm 1 addr         * 
         MVI   MPB_OPT,MPB_OPT_F2D     * fullword to decimal         * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 4                  * 
         LA    R1,CWA_CONN_NAME        * Addr connection name        * 
         ST    R1,MPB_ADDR             * save as parm 2 addr         * 
         MVC   MPB_LENG,=H'32'         * Limited space ....          * 
         JAS   R14,DO_MSG              * Go print message            * 
****************************************                             * 
* Translate and Trace received data                                  * 
****************************************                             * 
         LGR   R1,R8                   * Buffer address              * 
         AH    R1,BUF_DOFF             * Data address                * 
         LARL  R2,A2ETAB               * 256 bytes +                 * 
         LGF   R15,BUF_DLEN            * length data                 * 
         JAS   R14,DO_XLAT             * N skip                      * 
         LGR   R1,R8                   * Buffer address              * 
         AH    R1,BUF_DOFF             * Data address                * 
         LGF   R15,CWA_RETCD           * Data length                 * 
         JAS   R14,DO_TRACE            * Go trace data               * 
         J     MN_SHUTDOWN             *                             * 
MN_DISCONN DS  0H                      *                             * 
*                                      ******************************* 
         DROP  R8,R14 
********************************************************************** 
* Shutdown the connection                                            * 
********************************************************************** 
MN_SHUTDOWN DS 0H                      ******************************* 
         JAS   R14,DO_SHUTDOWN         *                             * 
*                                      ******************************* 
********************************************************************** 
* Close the socket                                                   * 
********************************************************************** 
MN_CLOSE DS    0H                      ******************************* 
         JAS   R14,DO_SOCK_CLOSE       *                             * 
*                                      ******************************* 
********************************************************************** 
* Terminate the HPNS interface                                       * 
********************************************************************** 
MN_TERMINATE DS 0H                     ******************************* 
         JAS   R14,DO_TERMAPI          *                             * 
*                                      ******************************* 
********************************************************************** 
* Close the SYSPRINT dataset, Free Work Area and Exit                * 
********************************************************************** 
MN_RETURN DS   0H                      ******************************* 
         LARL  R1,MSG_002              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         JAS   R14,DO_MSG              * Go print message            * 
         MVC   W1_PLIST(MODEL_CLOSE_LENGTH),MODEL_CLOSE init CLOSE pl* 
         L     R11,W1_WA2              * R11 = A(WA2)                * 
         USING WORK_AREA_2,R11         *                             * 
         CLOSE (W2_DCB),MF=(E,W1_PLIST)  do the CLOSE                * 
         STORAGE RELEASE,              * Free the SPA chain          * X 
               LENGTH=WORK_AREA_2_LENGTH,                            * X 
               ADDR=(R11)              *                             * 
         STORAGE RELEASE,              * Free the SPA chain          * X 
               LENGTH=WORK_AREA_1_LENGTH,                            * X 
               ADDR=(R13)              *                             * 
         PR                            * Rest. callers regs frm stack* 
         BR    R14                     * Exit                        * 
*                                      ******************************* 
         DROP  R11 
********************************************************************** 
* Translate data at R1, length R15 using table R2                    * 
********************************************************************** 
DO_XLAT  DS    0H                      ******************************* 
DO_XLAT_LOOP DS 0H                     *                             * 
         CH    R15,=H'256'             * 256 bytes +                 * 
         JNH   XLAT_LAST               * N skip                      * 
         TR    0(256,R1),0(R2)         * Translate to ASCII          * 
         SH    R15,=H'256'             * Decrement length to move    * 
         LA    R1,256(,R1)             * Increment TO pointer        * 
         J     DO_XLAT_LOOP            * Repeat                      * 
XLAT_LAST DS   0H                      *                             * 
         LTR   R15,R15                 *                             * 
         BZR   R14                     *                             * 
         BCTR  R15,0                   * Machine length              * 
         EX    R15,XLAT_XLAT           *                             * 
         BR    R14                     *                             * 
*                                      ******************************* 
********************************************************************** 
* MVCL as multiple MVCs - R1 = FROM, R2 = TO, R15 = LEN              * 
********************************************************************** 
DO_MVCL  DS    0H                      ******************************* 
         LTR   R2,R2                   * Is there a TO pointer?      * 
         JZ    MVCL_ZERO_LOOP          * N - zero space              * 
MVCL_MOVE_LOOP DS 0H                   *                             * 
         CH    R15,=H'256'             * 256 bytes +                 * 
         JNH   MVCL_MOVE_LAST          * N skip                      * 
         MVC   0(256,R2),0(R1)         * Move 256 bytes              * 
         SH    R15,=H'256'             * Decrement length to move    * 
         LA    R1,256(,R1)             * Increment FROM pointer      * 
         LA    R2,256(,R2)             * Increment TO pointer        * 
         J     MVCL_MOVE_LOOP          * Repeat                      * 
MVCL_MOVE_LAST DS 0H                   *                             * 
         LTR   R15,R15                 * Any data left to move?      * 
         BZR   R14                     * N - return                  * 
         BCTR  R15,0                   * Machine length              * 
         EX    R15,MVCL_MOVE           *                             * 
         XGR   R15,R15                 * Clear return code           * 
         BR    R14                     * Exit                        * 
MVCL_ZERO_LOOP DS 0H                   *                             * 
         CH    R15,=H'256'             * 256 bytes +                 * 
         JNH   MVCL_ZERO_LAST          * N skip                      * 
         XC    0(256,R1),0(R1)         * Clear 256 bytes of data     * 
         SH    R15,=H'256'             * Decrement length to move    * 
         LA    R1,256(,R1)             * Increment FROM pointer      * 
         J     MVCL_ZERO_LOOP          * Repeat                      * 
MVCL_ZERO_LAST DS 0H                   *                             * 
         LTR   R15,R15                 * Any data left to move?      * 
         BZR   R14                     * N - return                  * 
         BCTR  R15,0                   * Machine length              * 
         EX    R15,MVCL_ZERO           *                             * 
         XGR   R15,R15                 * Clear return code           * 
         BR    R14                     * Exit                        * 
*                                      ******************************* 
********************************************************************** 
* Request completed successfully                                     * 
********************************************************************** 
DO_REQU_OK DS  0H                      ******************************* 
         STMG  R0,R15,W1_SAV3          * Save callers regs           * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_007              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R14,W1_MSG_MPB          * MPB 1                       * 
         USING MPB,R14                 *                             * 
         LA    R1,CWA_REQNM            * Addr request name           * 
         ST    R1,MPB_ADDR             * save as parm 1 addr         * 
         MVC   MPB_LENG,=AL2(L'CWA_REQNM) Parm length                * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 4                  * 
         LA    R1,CWA_CONN_NAME        * Addr connection name        * 
         ST    R1,MPB_ADDR             * save as parm 3 addr         * 
         MVC   MPB_LENG,=H'32'         * Limited space ....          * 
         JAS   R14,DO_MSG              * Go print message            * 
         XGR   R15,R15                 * Return code                 * 
         LMG   R0,R14,W1_SAV3          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R14 
********************************************************************** 
* Request failed, error on connection                                * 
********************************************************************** 
DO_REQ_ERR DS 0H                       ******************************* 
         STMG  R0,R15,W1_SAV3          * Save callers regs           * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_004              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R14,W1_MSG_MPB          * MPB 1                       * 
         USING MPB,R14                 *                             * 
         LA    R1,CWA_REQNM            * Addr request name           * 
         ST    R1,MPB_ADDR             * save as parm 1 addr         * 
         MVC   MPB_LENG,=AL2(L'CWA_REQNM) Parm length                * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 2                  * 
         LA    R1,CWA_ERRNO            * Addr Errno                  * 
         ST    R1,MPB_ADDR             * save as parm 2 addr         * 
         MVI   MPB_OPT,MPB_OPT_F2D     * fullword to decimal         * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 3                  * 
         LA    R1,CWA_CONN_NAME        * Addr connection name        * 
         ST    R1,MPB_ADDR             * save as parm 3 addr         * 
         MVC   MPB_LENG,=H'32'         * Length (truncated)          * 
         LA    R14,MPB_LENGTH(,R14)    * Next MPB 4                  * 
         LA    R1,CWA_SOCNO            * Addr Socket number          * 
         ST    R1,MPB_ADDR             * save as parm 4 addr         * 
         MVI   MPB_OPT,MPB_OPT_H2D     * halfword to decimal         * 
         JAS   R14,DO_MSG              * Go print message            * 
         LA    R15,16                  * Return code                 * 
         XGR   R15,R15                 * Set return code             * 
         LMG   R0,R14,W1_SAV3          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R14 
********************************************************************** 
* Trace data at (R1) length (R15)                                    * 
********************************************************************** 
DO_TRACE DS    0H                      ******************************* 
         STMG  R0,R15,W1_SAV4          * Save callers regs           * 
         LGR   R3,R1                   * data address                * 
         LGR   R5,R15                  * data length                 * 
         L     R11,W1_WA2              * R11 = A(WA2)                * 
         USING WORK_AREA_2,R11         *                             * 
         XC    W1_TRTAB,W1_TRTAB       * Clear TRT table             * 
         MVI   W1_TRTAB+X'0D',X'FF'    * Init to find CR             * 
TRAC_LP1 DS    0H                      *                             * 
         LTGR  R5,R5                   * R5 - remaining length > 0   * 
         JNP   TRAC_RETN               * N - finished                * 
         MVC   W1_MSG_BUF,=CL121' '    * clear buffer                * 
         TRT   0(116,R3),W1_TRTAB      *                             * 
         JNZ   TRAC_LP1C               * Found a CR char             * 
         CH    R5,=H'116'              * Check had  >= 116 bytes     * 
         JH    TRAC_MDAT               * Not found - but more data   * 
         LA    R1,0(R5,R3)             * Set R1 to end of string     * 
TRAC_LP1C DS   0H                      *                             * 
         LGR   R4,R1                   * R4 addr end of line         * 
         SGR   R1,R3                   * R1 length of line           * 
         SGR   R5,R1                   * R5 total length remaining   * 
         LTGR  R1,R1                   *                             * 
         JZ    TRAC_PUT                *                             * 
         BCTR  R1,0                    * machine value for MVC       * 
         EX    R1,TRAC_MVC1            * Move data into buffer       * 
TRAC_PUT DS    0H                      *                             * 
         LA    R1,10(,R1)              * 5 blanks + machine adj.+len * 
         STH   R1,W1_MSG_LEN           * Save length                 * 
         PUT   W2_DCB,W1_MSG_LEN       * do PUT (is re-entrant)      * 
         LA    R3,1(,R4)               * R3 points to CR+1           * 
         CLI   0(R3),X'25'             * EBCDIC LF?                  * 
         JNE   TRAC_LP1                * N - do next line            * 
         LA    R3,1(,R3)               * Y - increment past          * 
         BCTR  R5,0                    * decrement length            * 
         J     TRAC_LP1                * Y - do next line            * 
****************************************                             * 
* multiple output lines for single input line                        * 
****************************************                             * 
TRAC_MDAT DS   0H                      *                             * 
         MVC   W1_MSG_BUF+4(116),0(R3) * First line                  * 
         MVC   W1_MSG_LEN,=H'125'      * 5 blanks + len RDW          * 
         PUT   W2_DCB,W1_MSG_LEN       * do PUT (is re-entrant)      * 
         LA    R3,116(,R3)             *                             * 
         SH    R5,=H'116'              *                             * 
         LGF   R6,=F'9999'             * Max loop                    * 
TRAC_LP2 DS    0H                      *                             * 
         LTGR  R5,R5                   * R5 - remaining length > 0   * 
         JNP   TRAC_RETN               * N - finished                * 
         JCT   R6,TRAC_LP2G            *                             * 
         DC    H'0'                    *                             * 
TRAC_LP2G DS   0H                      *                             * 
         MVC   W1_MSG_BUF,=CL121' '    * clear buffer                * 
         TRT   0(112,R3),W1_TRTAB      *                             * 
         JNZ   TRAC_LP2C               * Jump if found               * 
         LA    R1,112(,R3)             * Point to end of line        * 
         CH    R5,=H'112'              * Was there 112 bytes left    * 
         JH    TRAC_LP2C               * Y                           * 
         LA    R1,0(R5,R3)             * R1 = end of data            * 
TRAC_LP2C DS   0H                      *                             * 
         LGR   R4,R1                   * R4 addr end of line         * 
         SGR   R1,R3                   * R1 length of line           * 
         SGR   R5,R1                   * R5 total length remaining   * 
         BCTR  R1,0                    * machine value for MVC       * 
         EX    R1,TRAC_MVC2            * Move data into buffer       * 
         LA    R1,14(,R1)              * 9 blanks + machine adj.+len * 
         STH   R1,W1_MSG_LEN           * Save length                 * 
         PUT   W2_DCB,W1_MSG_LEN       * do PUT (is re-entrant)      * 
         LGR   R3,R4                   * R3 points to last char fnd  * 
         CLI   0(R3),X'0D'             * Had we found CR             * 
         JNE   TRAC_LP2                * N - go repeat               * 
         LA    R3,1(,R3)               * R3 points to CR+1           * 
         BCTR  R5,0                    * decrement length            * 
         CLI   0(R3),X'25'             * EBCDIC LF?                  * 
         JNE   TRAC_LP1                * N - do next line            * 
         LA    R3,1(,R3)               * Y - increment past          * 
         J     TRAC_LP1                * Y - do next line            * 
TRAC_RETN DS   0H                      *                             * 
         LMG   R0,R15,W1_SAV4          * restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R11 
********************************************************************** 
* Write a message to the log. The message skeleton address and all   * 
* substitutable parameters and their options are pre-initialised in  * 
* the W1_MSG section of the W1 block.                                * 
********************************************************************** 
DO_MSG   DS    0H                      ******************************* 
         STMG  R0,R15,W1_SAV4          * Save callers regs           * 
****************************************                             * 
* Init message buffer with local time                                * 
****************************************                             * 
         MVC   W1_MSG_BUF,=CL121' '    * clear buffer                * 
         MVC   W1_MSG_BUF(17),=C'00:00:00.000 CLN1'                  * 
         MVC   W1_PLIST(MODEL_TIME_LENGTH),MODEL_TIME                * 
         TIME  DEC,W1_TTIM,            * HHMMSSTHTTT                 * X 
               LINKAGE=SYSTEM,         *                             * X 
               MF=(E,W1_PLIST)         *                             * 
         OI    W1_TTIM+4,X'0F'         * set sign                    * 
         UNPK  W1_PLIST(9),W1_TTIM(5)  *                             * 
         MVC   W1_MSG_TIME(2),W1_PLIST *                             * 
         MVC   W1_MSG_TIME+3(2),W1_PLIST+2                           * 
         MVC   W1_MSG_TIME+6(2),W1_PLIST+4                           * 
         MVC   W1_MSG_TIME+9(3),W1_PLIST+6                           * 
****************************************                             * 
* Move in the message                                                * 
****************************************                             * 
         XC    W1_TRTAB,W1_TRTAB       * Clear table                 * 
         MVI   W1_TRTAB+C'&&',X'FF'    * Init to find &              * 
         L     R15,W1_MSG_SKL          * Message skeleton blk        * 
         LA    R1,2(,R15)              * Message skeleton            * 
         LGH   R15,0(,R15)             * Message skeleton length     * 
         LA    R6,0(R15,R1)            * End of message text         * 
         LA    R3,W1_MSG_TEXT          * Start of message out        * 
         LA    R14,W1_MSG_TEXT-W1_MSG_BUF Length output message      * 
****************************************                             * 
* Search message skeleton for & variable place holders               * 
****************************************                             * 
MSG_LOOP_ON_VAR DS 0H                  *                             * 
         LR    R5,R1                   * R5 start of search          * 
         LR    R15,R6                  * R15 end of skel msg         * 
         SR    R15,R1                  * R15 length of search        * 
         JNP   END_TXT                 * Finished - skip             * 
         BCTR  R15,R0                  * Machine length              * 
         EX    R15,FIND_VAR            * Scan for & chars            * 
         JZ    LAST_TXT                * none found - skip           * 
****************************************                             * 
* Move data upto place holder into the target buffer                 * 
****************************************                             * 
         LR    R15,R1                  * R15 addres of '%'           * 
         SR    R15,R5                  * Offset from last var        * 
         JNP   MSG_END_PRFX_MOV        *                             * 
         AR    R14,R15                 * Offset from start of buffer * 
         C     R14,=F'121'             * Will it fit ?               * 
         JH    MSG_TOO_LARGE           * Too big for buffer - skip   * 
         BCTR  R15,R0                  * Machine value               * 
         EX    R15,MOVE_TXT            * Move the data               * 
         LA    R3,1(R15,R3)            * Target for next move        * 
MSG_END_PRFX_MOV DS 0H                 *                             * 
****************************************                             * 
* Append the contents of the variable to the target buffer           * 
****************************************                             * 
         IC    R2,1(,R1)               * Pick up variable number     * 
         SLL   R2,28                   * clear reg and zone info     * 
         SRL   R2,28                   * leaving binary number in R2 * 
         BCTR  R2,R0                   * decrement                   * 
         MH    R2,=AL2(MPB_LENGTH)     * * length of MSE             * 
         LA    R2,W1_MSG_MPB(R2)       * index into MSP_MSEs         * 
         CLI   MPB_OPT-MPB(R2),X'00'   * Any conversion options ?    * 
         JE    END_CONV                * N                           * 
         LLGT  R15,MPB_ADDR-MPB(,R2)   * Address parm                * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_FWD fullword input            * 
         JO    MSG_INP_FULL            * Y - go process              * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_HWD halfword input            * 
         JO    INPUT_HALF              * Y - go process              * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_BYT one byte input            * 
         JO    INPUT_BYTE              * Y - go process              * 
MSG_INP_DUBL DS 0H                     * Must be a double word       * 
*        TM    MPB_OPT-MPB(R2),MPB_OPT_DEC decimal conversion ?      * 
*        JO    FULL_2_DEC              * Y treat as fullword         * 
MSG_DUBL_2_HEX DS 0H                   *                             * 
         UNPK  0(9,R3),0(5,R15)        * unpack the binary           * 
         UNPK  8(9,R3),4(5,R15)        * unpack the binary           * 
         TR    0(16,R3),HEXTAB         * convert to hex              * 
         LA    R14,16(,R14)            * increment offset            * 
         LA    R3,16(,R3)              * increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
MSG_INP_FULL DS 0H                     * Must be a fullword          * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_DEC decimal conversion ?      * 
         JO    FULL_2_DEC              * Y                           * 
FULL_2_HEX DS  0H                      *                             * 
         UNPK  0(9,R3),0(5,R15)        * unpack the binary           * 
         TR    0(8,R3),HEXTAB          * convert to hex              * 
         LA    R14,8(,R14)             * increment offset            * 
         LA    R3,8(,R3)               * increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
FULL_2_DEC DS  0H                      *                             * 
         LLGT  R15,0(,R15)             *                             * 
         J     FMT_DEC                 *                             * 
INPUT_HALF DS  0H                      * Process halfword input      * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_DEC decimal conversion ?      * 
         JO    HALF_2_DEC              * Y                           * 
HALF_2_HEX DS  0H                      *                             * 
         UNPK  0(5,R3),0(3,R15)        * unpack the binary           * 
         TR    0(4,R3),HEXTAB          * convert to hex              * 
         LGH   R15,MPB_LENG-MPB(,R2) length of variable              * 
         LTR   R15,R15                 * explicitly specified ?      * 
         JZ    DFLT_HALFWORD           * N                           * 
         ALR   R14,R15                 *                             * 
         ALR   R3,R15                  *                             * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
DFLT_HALFWORD DS 0H                    *                             * 
         LA    R14,4(,R14)             * increment offset            * 
         LA    R3,4(,R3)               * increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
HALF_2_DEC DS  0H                      *                             * 
         LGH   R15,0(,R15)             *                             * 
         J     FMT_DEC                 *                             * 
INPUT_BYTE DS  0H                      * Process byte input          * 
         TM    MPB_OPT-MPB(R2),MPB_OPT_DEC decimal conversion ?      * 
         JO    BYTE_2_DEC              * Y                           * 
BYTE_2_HEX DS  0H                      *                             * 
         UNPK  0(3,R3),0(2,R15)        * unpack the binary           * 
         TR    0(2,R3),HEXTAB          * convert to hex              * 
         LA    R14,2(,R14)             * increment offset            * 
         LA    R3,2(,R3)               * increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
BYTE_2_DEC DS  0H                      *                             * 
         IC    R15,0(,R15)             *                             * 
         SLL   R15,24                  *                             * 
         SRL   R15,24                  *                             * 
         J     FMT_DEC                 *                             * 
****************************************                             * 
* R15 holds number to be converted to decimal                        * 
****************************************                             * 
FMT_DEC  DS    0H                      *                             * 
         CVD   R15,W1_PLIST            *                             * 
         OI    W1_PLIST+7,X'0F'        *                             * 
         UNPK  W1_NUMBER,W1_PLIST      * unpack the binary           * 
         LGH   R15,MPB_LENG-MPB(,R2) length of variable              * 
         LTR   R15,R15                 * is there a length ?         * 
         JZ    FMT_2_FIT               * N                           * 
         TM    MPB_FMT-MPB(R2),MPB_FMT_RGT right alignment ?         * 
         JO    FMT_RIGHT               * Y - go process              * 
         LA    R9,W1_NUMBER+L'W1_NUMBER * point to end of number     * 
         SR    R9,R15                  * go back desired length      * 
         J     MOV_DAT                 *                             * 
****************************************                             * 
* Place number in target buffer, removing leading zeros              * 
****************************************                             * 
FMT_RIGHT DS   0H                      *                             * 
         LA    R2,W1_NUMBER+L'W1_NUMBER * point to end of number     * 
         SR    R2,R15                  * go back desired length      * 
         J     LOOP_ON_ZERO            *                             * 
****************************************                             * 
* Place number in target buffer, removing leading zeros              * 
****************************************                             * 
FMT_2_FIT DS   0H                      *                             * 
         LA    R2,W1_NUMBER            * Address of number with L'00s* 
         LA    R15,L'W1_NUMBER         *                             * 
LOOP_ON_ZERO DS 0H                     *                             * 
         CLI   0(R2),C'0'              * leading 0 ?                 * 
         JNE   MOV_NUM                 *                             * 
         LA    R2,1(,R2)               * next digit                  * 
         JCT   R15,LOOP_ON_ZERO        *                             * 
         MVI   0(R3),C'0'              * value was 0                 * 
         LA    R14,1(,R14)             * increment offset            * 
         LA    R3,1(,R3)               * increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
MOV_NUM  DS    0H                      *                             * 
         MVC   0(1,R3),0(R2)           * Move in first number        * 
         LA    R14,1(,R14)             * increment total offset      * 
         LA    R3,1(,R3)               * increment target buffer ndx * 
         LA    R2,1(,R2)               * next digit                  * 
         JCT   R15,MOV_NUM             *                             * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
END_CONV DS    0H                      *                             * 
****************************************                             * 
* plain text processing                                              * 
****************************************                             * 
         LGH   R15,MPB_LENG-MPB(,R2)   * length of variable          * 
         LTR   R15,R15                 * Variable present ?          * 
         JZ    END_VAR                 * N                           * 
         LLGT  R9,MPB_ADDR-MPB(,R2) * Address of variable content * 
MOV_DAT  DS    0H                      *                             * 
         AR    R14,R15                 * Offset from start of buffer * 
         C     R14,=F'121'             * Will it fit ?               * 
         JH    MSG_TOO_LARGE           * N - too big for buffer      * 
         BCTR  R15,R0                  * machine value               * 
         EX    R15,MOVE_VAR            * Move the data               * 
****************************************                             * 
* Suppress trailing blanks on the variable                           * 
****************************************                             * 
END_VAR  DS    0H                      *                             * 
         LA    R3,1(R15,R3)            * Increment target buffer ndx * 
         LA    R1,2(,R1)               * increment past var placehldr* 
         TM    MPB_FMT-MPB(R2),MPB_FMT_NBS No blank suppression ? * 
         JO    MSG_LOOP_ON_VAR         * That's right                * 
SUP_BLANKS DS  0H                      *                             * 
         BCTR  R14,0                   * decrement R14               * 
         BCTR  R3,0                    * decrement R3                * 
         CLI   0(R3),C' '              * blank present               * 
         JE    SUP_BLANKS              * Yes - look for previous     * 
         LA    R3,1(,R3)               * point to first blank        * 
         LA    R14,1(,R14)             * increase offset             * 
         J     MSG_LOOP_ON_VAR         * Look for next variable      * 
****************************************                             * 
* Append the last constant string to the target buffer               * 
****************************************                             * 
LAST_TXT DS    0H                      *                             * 
         SR    R6,R5                   * Length of text              * 
         JZ    END_TXT                 *                             * 
         LA    R14,0(R6,R3)            * Addr end of text location   * 
         SLR   R14,R4                  * Offset to this location     * 
         C     R14,=F'121'             * Will it fit ?               * 
         JH    MSG_TOO_LARGE           * OK                          * 
         BCTR  R6,R0                   *                             * 
         EX    R6,MOVE_TXT             *                             * 
         LA    R3,1(R6,R3)             *                             * 
*        STH   R14,W1_MSG_LEN          * Save in buffer header       * 
*        J     MSG_PUT                 *                             * 
****************************************                             * 
* No fixed data after last variable                                  * 
****************************************                             * 
END_TXT  DS    0H                      *                             * 
         LA    R15,W1_MSG_LEN          * Start of message            * 
         SLR   R3,R15                  * Offset to end of text       * 
         STH   R3,W1_MSG_LEN           * Save length                 * 
MSG_PUT  DS    0H                      *                             * 
         CLC   =H'121',W1_MSG_LEN      *                             * 
         JH    MSG_NO_ABEND            *                             * 
         DC    H'0'                    *                             * 
MSG_NO_ABEND DS 0H                     *                             * 
         L     R11,W1_WA2              * R11 = A(WA2)                * 
         USING WORK_AREA_2,R11         *                             * 
         PUT   W2_DCB,W1_MSG_LEN       * do PUT (is re-entrant)      * 
         XGR   R15,R15                 * Set return code             * 
         LMG   R0,R14,W1_SAV4          * Restore callers regs        * 
         BR    R14                     * Return                      * 
MSG_TOO_LARGE DS 0H                    *                             * 
         DC    H'0'                    *                             * 
*                                      ******************************* 
         DROP  R11 
********************************************************************** 
* Program Constants not requiring access via a base register         * 
********************************************************************** 
*                                      ******************************* 
****************************************                             * 
* Message table                                                      * 
****************************************                             * 
MESSAGES DS    0F                      *                             * 
MSG_001  DC    AL2(L'MSG_001_TXT)      *                             * 
MSG_001_TXT DC C'Task &&1 started'     *                             * 
MSG_002  DS    0H                      *                             * 
         DC    AL2(L'MSG_002_TXT)      *                             * 
MSG_002_TXT DC C'Task terminated'      *                             * 
MSG_003  DS    0H                      *                             * 
         DC    AL2(L'MSG_003_TXT)      *                             * 
MSG_003_TXT DC C'Request &&1 failed, ERRNO &&2'                      * 
MSG_004  DS    0H                      *                             * 
         DC    AL2(L'MSG_004_TXT)      *                             * 
MSG_004_TXT DC C'Request &&1 failed, ERRNO &&2, addr &&3, socNm &&4' * 
MSG_005  DS    0H                      *                             * 
         DC    AL2(L'MSG_005_TXT)      *                             * 
MSG_005_TXT DC C'Request &&1 was not accepted, R15 &&3, ERRNO &&2'   * 
MSG_006  DS    0H                      *                             * 
         DC    AL2(L'MSG_006_TXT)      *                             * 
MSG_006_TXT DC C'Socket number &&1 allocated for connection &&2'     * 
MSG_007  DS    0H                      *                             * 
         DC    AL2(L'MSG_007_TXT)      *                             * 
MSG_007_TXT DC C'&&1 request successful for connection &&2'          * 
MSG_008  DS    0H                      *                             * 
         DC    AL2(L'MSG_008_TXT)      *                             * 
MSG_008_TXT DC C'Received &&1 bytes on connection &&2'               * 
****************************************                             * 
* Translate tables                                                   * 
****************************************                             * 
A2ETAB   DS    0F                      *                             * 
         DC    X'00010203040506070809250B0C0D0E0F'                   * 
         DC    X'101112131415161718191A1B1C1D1E1F'                   * 
         DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61'                   * 
         DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'                   * 
         DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'                   * 
         DC    X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5E6D'                   * 
         DC    X'79818283848586878889919293949596'                   * 
         DC    X'979899A2A3A4A5A6A7A8A9C06AD0A17F'                   * 
         DC    X'808182838485868788898A8B8C8D8E8F'                   * 
         DC    X'909192939495969798999A9B9C9D9E9F'                   * 
         DC    X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'                   * 
         DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'                   * 
         DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'                   * 
         DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'                   * 
         DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'                   * 
         DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'                   * 
E2ATAB   DS    0F                      *                             * 
         DC    X'000102030405060708090A0B0C0D0E0F'                   * 
         DC    X'101112131415161718191A1B1C1D1E1F'                   * 
         DC    X'20212223240A262728292A2B2C2D2E2F'                   * 
         DC    X'303132333435363738393A3B3C3D3E3F'                   * 
         DC    X'204142434445464748494A2E3C282B4F'                   * 
         DC    X'2651525354555657585921242A293B5F'                   * 
         DC    X'2D2F62636465666768697C2C255F3E3F'                   * 
         DC    X'707172737475767778603A2340273D22'                   * 
         DC    X'806162636465666768698A8B8C8D8E8F'                   * 
         DC    X'906A6B6C6D6E6F7071729A9B9C9D9E9F'                   * 
         DC    X'A07E737475767778797AAAABAC5BAEAF'                   * 
         DC    X'B0B1B2B3B4B5B6B7B8B9BABBBC5DBEBF'                   * 
         DC    X'7B414243444546474849CACBCCCDCECF'                   * 
         DC    X'7D4A4B4C4D4E4F505152DADBDCDDDEDF'                   * 
         DC    X'5CE1535455565758595AEAEBECEDEEEF'                   * 
         DC    X'30313233343536373839FAFBFCFDFEFF'                   * 
*                                      ******************************* 
********************************************************************** 
* Program Constants and subroutines with macros using DCs that are   * 
* addressed via a base register e.g. all EZASMI expansions.          * 
********************************************************************** 
PGM_CONST DS   0D                      ******************************* 
****************************************                             * 
* Executed instructions                                              * 
****************************************                             * 
FIND_VAR TRT   0(0,R1),W1_TRTAB        *                             * 
MOVE_TXT MVC   0(0,R3),0(R5)           *                             * 
MOVE_VAR MVC   0(0,R3),0(R9)           *                             * 
MVCL_MOVE MVC  0(0,R2),0(R1)           *                             * 
MVCL_ZERO XC   0(0,R1),0(R1)           *                             * 
TRAC_MVC1 MVC  W1_MSG_BUF+4(0),0(R3)   *                             * 
TRAC_MVC2 MVC  W1_MSG_BUF+8(0),0(R3)   *                             * 
XLAT_XLAT TR   0(0,R1),0(R2)           *                             * 
*                                      ******************************* 
********************************************************************** 
* Initialise the HPNS API                                            * 
********************************************************************** 
DO_INITAPI DS  0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   W1T_REQNM,=CL12'INITAPI' * Request name               * 
****************************************                             * 
* Use and init IDENT if multiple TCPIP address spaces active         * 
****************************************                             * 
         MVC   W1T_IDENT(8),=CL8'&TCP_ASN' TCPIP Addr Space Name     * 
         LLGT  R1,PSATOLD-PSA(0)       * Old TCB pointer             * 
         L     R1,TCBTIO-TCB(,R1)      * TIOT                        * 
         MVC   W1T_IDENT+8(8),TIOCNJOB-TIOT1(R1) Our Addr Space Name * 
         MVC   W1_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI            * 
         EZASMI TYPE=INITAPI,          * I - InitAPI                 * X 
               APITYPE=2,              * I - API type 3 (async)      * X 
               IDENT=W1T_IDENT,        * I - ID ASN TCP and Us       * X 
               SUBTASK=W1T_IDENT+8,    * I - Subtask name            * X 
               MAXSOC=50,              * I - Max sockets supported   * X 
               TASK=W1T_TASK_WA,       * I - Task work area          * X 
               MAXSNO=W1T_MXSOC,       * O - Max socket number (49)  * X 
               ERRNO=W1T_ERRNO,        * O - Error number            * X 
               RETCODE=W1T_RETCD,      * 0 - Return code             * X 
               MF=(E,W1_PLIST)         * I - Plist work area         * 
         XGR   R15,R15                 *                             * 
         CLC   =F'0',W1T_RETCD         * Complete OK ?               * 
         BNL   INIT_RET                * Y - skip err msg            * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_003              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R1,W1T_REQNM             * Addr request name          * 
         ST    R1,W1_MSG_MPB+MPB_ADDR-MPB save as parm 1 addr        * 
         MVC   W1_MSG_MPB+MPB_LENG-MPB(2),=H'7' parm length          * 
         LA    R1,W1T_ERRNO            * Addr Errno                  * 
         ST    R1,W1_MSG_MPB+MPB_LENGTH+MPB_ADDR-MPB parm 2 addr     * 
         MVI   W1_MSG_MPB+MPB_LENGTH+MPB_OPT-MPB,MPB_OPT_F2D fwd 2dec* 
         JAS   R14,DO_MSG              * Go print message            * 
         LA    R15,16                  * Return code                 * 
INIT_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
********************************************************************** 
* Get the IP address of the server (assumes dotted decimal notation) * 
********************************************************************** 
         USING CWA_BLOCK,R9 
GET_ADDR  DS   0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'PTON'   * Request name                * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=PTON,             * convert char addr to hex    * X 
               AF='INET',              * IPV4 format address         * X 
               SRCADDR=CWA_CONN_NAME,SRCLEN=15,                      * X 
               DSTADDR=SOCK_SIN_ADDR-SOCKADDR+CWA_RMT_ADDR,          * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         LGF   R15,CWA_RETCD           * Pick up return code         * 
         LTGR  R15,R15                 * Check value                 * 
         JNM   GADR_RET                * Abend0C1 if negative        * 
         DC    H'0'                    *                             * 
GADR_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Open a socket for the passed CWA                                   * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_SOCKET DS   0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'SOCKET' * Request name                * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=SOCKET,           *                             * X 
               AF='INET',              *                             * X 
               SOCTYPE='STREAM',       *                             * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         LGF   R15,CWA_RETCD           * Pick up return code         * 
         LTGR  R15,R15                 * Check value                 * 
         JM    SOCK_REQ_ERR            * Negative - record error     * 
         STH   R15,CWA_SOCNO           * Save socket number          * 
         OI    CWA_STATE,CWA_STATE_OPEN  Flag socket open            * 
         J     SOCK_RET                * Y - skip err msg            * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
SOCK_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
SOCK_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Connect to the target system                                       * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_CONNECT DS  0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'CONNECT'  Request name                * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=CONNECT,          *                             * X 
               S=CWA_SOCNO,            *                             * X 
               NAME=CWA_RMT_ADDR,      *                             * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         CLC   =F'0',CWA_RETCD         * Complete OK ?               * 
         JH    CONN_REQ_ERR            * Y - skip err msg            * 
         OI    CWA_STATE,CWA_STATE_CONN  Flag socket connected       * 
         JAS   R14,DO_REQU_OK          *                             * 
         XGR   R15,R15                 *                             * 
         J     CONN_RET                * return                      * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
CONN_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
CONN_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Send data to target system                                         * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_SEND  DS    0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'SEND'   * Request name                * 
         NI    CWA_STATE,255-CWA_STATE_SRTY ensure retry off         * 
         L     R4,CWA_SBUF             * Pick up send buffer         * 
         USING BUF_BLOCK,R4            *                             * 
         LTR   R2,R4                   * Copy to R2                  * 
         JZ    SEND_NO_BUF             * Skip if no buffer           * 
         AH    R2,BUF_DOFF             * R2 addr of data to send     * 
SEND_RETRY DS  0H                      *                             * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=SEND,             *                             * X 
               S=CWA_SOCNO,            *                             * X 
               BUF=(R2),               * address of data to send     * X 
               NBYTE=BUF_DLEN,         * length of data to send      * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         CLC   =F'0',CWA_RETCD         * Complete OK ?               * 
         JH    SEND_REQ_ERR            * Y - skip err msg            * 
         CLC   BUF_DLEN,CWA_RETCD      * All data sent ?             * 
         JNE   SEND_PART               * N - retry ?                 * 
         JAS   R14,DO_REQU_OK          *                             * 
         XGR   R15,R15                 *                             * 
         J     SEND_RET                * return                      * 
SEND_PART DS   0H                      *                             * 
         TM    CWA_STATE,CWA_STATE_SRTY  Already retried ?           * 
         JO    SEND_FAIL               * Y - failure                 * 
         OI    CWA_STATE,CWA_STATE_SRTY  Flag retry                  * 
         L     R2,BUF_DLEN             * Data length                 * 
         S     R2,CWA_RETCD            * Minus bytes sent            * 
         ST    R2,BUF_DLEN             * Save new data length        * 
         L     R2,CWA_RETCD            * Number sent                 * 
         AH    R2,BUF_DOFF             * Next byte to be sent        * 
         STH   R2,BUF_DOFF             * In case code more retries   * 
         J     SEND_RETRY              *                             * 
SEND_FAIL DS   0H                      *                             * 
         DC    H'0'                    * Oh No! Abend0C1             * 
****************************************                             * 
* DO_SEND entered with no buffer in CWA                              * 
****************************************                             * 
SEND_NO_BUF DS 0H                      *                             * 
         LA    R15,4                   * Return code                 * 
         J     SEND_RET                * return                      * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
SEND_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
SEND_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R4,R9 
********************************************************************** 
* Receive data from target system                                    * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_RECEIVE DS  0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'RECEIVE'  Request name                * 
         NI    CWA_STATE,255-CWA_STATE_SRTY ensure retry off         * 
         L     R4,CWA_RBUF             * Pick up send buffer         * 
         USING BUF_BLOCK,R4            *                             * 
         LA    R2,BUF_DATA             * R2 addr for received data   * 
         XC    BUF_DLEN,BUF_DLEN       * No data received so far     * 
         LR    R3,R4                   * R3 buffer address           * 
         AH    R3,BUF_BLEN             * R3 end of buffer            * 
         SLR   R3,R2                   * R3 available space          * 
         ST    R3,W1T_COUNT            * R3 available space          * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=RECV,             *                             * X 
               S=CWA_SOCNO,            *                             * X 
               BUF=(R2),               * address of receive buffer   * X 
               NBYTE=W1T_COUNT,        * length of buffer space      * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         LGF   R15,CWA_RETCD           * Pick up return code         * 
         LTGR  R15,R15                 * Check value                 * 
         JM    RECV_REQ_ERR            * Negative - record error     * 
         XGR   R15,R15                 *                             * 
         J     RECV_RET                * return                      * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
RECV_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
RECV_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Shutdown the connection                                            * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_SHUTDOWN DS 0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         TM    CWA_STATE,CWA_STATE_CONN  Socket connected?           * 
         JNO   SHUT_RET                * N - skip shutdown           * 
         MVC   CWA_REQNM,=CL12'SHUTDOWN' Request name                * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=SHUTDOWN,         * Shutdown                    * X 
               HOW=1,                  * our end                     * X 
               S=CWA_SOCNO,            *                             * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         CLC   =F'0',CWA_RETCD         * Complete OK ?               * 
         JH    SHUT_REQ_ERR            * N - do error message        * 
         NI    CWA_STATE,255-CWA_STATE_CONN Turn off connected       * 
         JAS   R14,DO_REQU_OK          * Log request complete        * 
         XGR   R15,R15                 *                             * 
         J     SHUT_RET                * return                      * 
SHUT_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
SHUT_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Close the socket                                                   * 
********************************************************************** 
         USING CWA_BLOCK,R9 
DO_SOCK_CLOSE DS 0H                    ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   CWA_REQNM,=CL12'CLOSE'  * Request name                * 
         MVC   CWA_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI init plst * 
         EZASMI TYPE=CLOSE,            *                             * X 
               S=CWA_SOCNO,            *                             * X 
               TASK=W1T_TASK_WA,       *                             * X 
               ERRNO=CWA_ERRNO,        *                             * X 
               RETCODE=CWA_RETCD,      *                             * X 
               MF=(E,CWA_PLIST)        *                             * 
         CLC   =F'0',CWA_RETCD         * Complete OK ?               * 
         JH    CLOS_REQ_ERR            * N - do error message        * 
         NI    CWA_STATE,255-CWA_STATE_OPEN Turn off socket open     * 
         JAS   R14,DO_REQU_OK          *                             * 
         XGR   R15,R15                 *                             * 
         J     CLOS_RET                * return                      * 
CLOS_REQ_ERR DS 0H                     *                             * 
         JAS   R14,DO_REQ_ERR          * Go report error             * 
         LA    R15,16                  * Return code                 * 
CLOS_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
         DROP  R9 
********************************************************************** 
* Terminate the HPNS API                                             * 
********************************************************************** 
DO_TERMAPI DS  0H                      ******************************* 
         STMG  R0,R15,W1_SAV2          * Save callers regs           * 
         MVC   W1T_REQNM,=CL12'TERMAPI' * Request name               * 
         MVC   W1_PLIST(MODEL_EZASMI_LENGTH),MODEL_EZASMI            * 
         EZASMI TYPE=TERMAPI,          * I - InitAPI                 * X 
               TASK=W1T_TASK_WA,       *                             * X 
               MF=(E,W1_PLIST)         * I - Plist work area         * 
         CLC   =F'0',W1T_RETCD         * Complete OK ?               * 
         JNH   TERM_RET                * Y - skip err msg            * 
****************************************                             * 
* EZASMI call error processing, issue message set return code        * 
****************************************                             * 
         XC    W1_MSG_MPB(MPB_LENGTH*4),W1_MSG_MPB clear parms       * 
         LARL  R1,MSG_003              * Message skeleton            * 
         ST    R1,W1_MSG_SKL           * Indicate message            * 
         LA    R1,W1T_REQNM            * Addr request name           * 
         ST    R1,W1_MSG_MPB+MPB_ADDR-MPB save as parm 1 addr        * 
         MVC   W1_MSG_MPB+MPB_LENG-MPB(2),=H'7' parm length          * 
         LA    R1,W1T_ERRNO            * Addr Errno                  * 
         ST    R1,W1_MSG_MPB+MPB_LENGTH+MPB_ADDR-MPB parm 2 addr     * 
         MVI   W1_MSG_MPB+MPB_LENGTH+MPB_OPT-MPB,MPB_OPT_F2D fwd 2dec* 
         JAS   R14,DO_MSG              * Go print message            * 
         LA    R15,16                  * Return code                 * 
TERM_RET DS    0H                      *                             * 
         LMG   R0,R14,W1_SAV2          * Restore callers regs        * 
         BR    R14                     * Return                      * 
*                                      ******************************* 
****************************************                             * 
* MF=L form macros                                                   * 
****************************************                             * 
MODEL_CLOSE DS 0D                      *                             * 
         CLOSE (),MODE=31,MF=L         *                             * 
MODEL_CLOSE_LENGTH EQU *-MODEL_CLOSE   *                             * 
MODEL_DCB DS   0D                      *                             * 
         DCB   DDNAME=SYSPRINT,DSORG=PS,LRECL=131,                   * X 
               RECFM=V,MACRF=(PM)      *                             * 
MODEL_DCB_LENGTH EQU *-MODEL_DCB       *                             * 
MODEL_EZASMI EZASMI MF=L               *                             * 
MODEL_EZASMI_LENGTH EQU *-MODEL_EZASMI *                             * 
MODEL_OPEN DS  0D                      *                             * 
         OPEN  (),MODE=31,MF=L         *                             * 
MODEL_OPEN_LENGTH EQU *-MODEL_OPEN     *                             * 
MODEL_SWAREQ DS 0D                     *                             * 
         SWAREQ MF=L                   *                             * 
MODEL_SWAREQ_LENGTH EQU *-MODEL_SWAREQ *                             * 
MODEL_TIME DS  0D                      *                             * 
         TIME  LINKAGE=SYSTEM,MF=L     *                             * 
MODEL_TIME_LENGTH EQU *-MODEL_TIME     *                             * 
         DS    0F                      *                             * 
         DC    C'0123456789ABCDEF'     *                             * 
HEXTAB   EQU   *-256                   *                             * 
         LTORG ,                       *                             * 
*                                      ******************************* 
********************************************************************** 
* Dynamic storage areas                                              * 
********************************************************************** 
PLISTS   DSECT ,                       ******************************* 
         DS    XL16                    * Min length for plist wa     * 
         ORG   PLISTS                  *                             * 
         DS    XL(MODEL_CLOSE_LENGTH)  * find which is the largest   * 
         ORG   PLISTS                  * plist area and set EQU so   * 
         DS    XL(MODEL_EZASMI_LENGTH) * only this much storage is   * 
         ORG   PLISTS                  * reserved for all overlayed  * 
         DS    XL(MODEL_OPEN_LENGTH)   * plists                      * 
         ORG   PLISTS                  *                             * 
         DS    XL(MODEL_TIME_LENGTH)   *                             * 
         ORG   ,                       * Find largest plist and EQU  * 
         DS    0D                      * to plists_max_length        * 
PLISTS_MAX_LENGTH EQU *-PLISTS         *                             * 
****************************************                             * 
* Buffer block                                                       * 
****************************************                             * 
BUF_BLOCK DSECT                        *                             * 
BUF_ID   DS    C                       * B - buffer                  * 
BUF_FUNC DS    C                       * D - data                    * 
BUF_STAT DS    X                       * Status of buffer            * 
BUF_STAT_ACTV EQU B'10000000'          * Buffer active (in use)      * 
BUF_DATA_EBCD EQU B'01000000'          * Buffer data in EBCDIC       * 
         DS    X                       * spare                       * 
BUF_BLEN DS    H                       * Length of this buffer       * 
BUF_DOFF DS    H                       * Offset to data              * 
BUF_DLEN DS    F                       * Length of data              * 
BUF_BUFP DS    A                       * Next buffer in chain        * 
BUF_DATA DS    0D                      * Data                        * 
BUF_BLOCK_LENGTH EQU *-BUF_BLOCK       *                             * 
****************************************                             * 
* Message Parameter Block                                            * 
****************************************                             * 
MPB      DSECT ,                       *                             * 
MPB_ADDR DS    F                   * address of parameter value      * 
MPB_LENG DS    H                   * length of parameter value       * 
MPB_FMT  DS    X                   *                                 * 
MPB_FMT_NBS EQU B'00000001'        * do not remove trailing blanks   * 
MPB_FMT_NZS EQU B'00000010'        * do not remove leading zeros     * 
*                                  *   applies to B2D only           * 
MPB_FMT_RGT EQU B'00000100'        * align parm to right             * 
MPB_OPT  DS    X                   * option flags                    * 
MPB_OPT_F2X EQU B'10000000'        * parm is binary - convert to hex * 
MPB_OPT_F2D EQU B'10000001'        * parm is binary - convert to dec * 
MPB_OPT_H2X EQU B'01000000'        * parm is binary - convert to hex * 
MPB_OPT_H2D EQU B'01000001'        * parm is binary - convert to dec * 
MPB_OPT_X2X EQU B'00100000'        * parm is binary - convert to hex * 
MPB_OPT_X2D EQU B'00100001'        * parm is binary - convert to dec * 
MPB_OPT_D2X EQU B'00010000'        * parm is binary - convert to hex * 
MPB_OPT_D2D EQU B'00010001'        * parm is binary - convert to dec * 
MPB_OPT_FWD EQU B'10000000'        * full word input                 * 
MPB_OPT_HWD EQU B'01000000'        * half word input                 * 
MPB_OPT_BYT EQU B'00100000'        * one byte input                  * 
MPB_OPT_DWD EQU B'00010000'        * double word input               * 
MPB_OPT_DEC EQU B'00000001'        * decimal output                  * 
MPB_LENGTH EQU *-MPB                   ******************************* 
********************************************************************** 
* Connection Work Area Block                                         * 
********************************************************************** 
CWA_BLOCK DSECT ,                      ******************************* 
CWA_ID    DS   CL2                     * CB                          * 
CWA_LEN   DS   H                       * length                      * 
CWA_CONN_NAME DS CL64                  *                             * 
CWA_SBUF  DS   A                       * Send buffer address         * 
CWA_RBUF  DS   A                       * Recv buffer address         * 
CWA_PLIST DS   XL(MODEL_EZASMI_LENGTH) *                             * 
CWA_SOCKET DS  0F                      * Fwd socket number           * 
         DS    H                       *                             * 
CWA_SOCNO DS   H                       * Hwd socket number           * 
CWA_RMT_ADDR DS XL(SOCK#LEN+SOCK_SIN#LEN) IPV4 address structure     * 
CWA_RETCD DS   F                       * Return code                 * 
CWA_ERRNO DS   F                       * Error Number (RetCd = -1)   * 
CWA_ECB  DS    F                       * Request ECB                 * 
         DS    XL100                   * HPNS work area (contig ECB) * 
CWA_REQNM DS   CL12                    * Request name for log/trace  * 
CWA_ROLE DS    C                       * L, S or C                   * 
CWA_STATE DS   X                       * State flags                 * 
CWA_STATE_OPEN   EQU B'10000000'       * Socket is open              * 
CWA_STATE_CONN   EQU B'01000000'       * Socket is connected         * 
CWA_STATE_SRTY   EQU B'00000001'       * Send retry in progress      * 
CWA_STATE_DUMP   EQU B'00100000'       * 0C1 when on                 * 
         DS    0D                      *                             * 
CWA_BLOCK_LENGTH EQU *-CWA_BLOCK       *                             * 
****************************************                             * 
* Work Area 1 LOC=ANY                                                * 
****************************************                             * 
WORK_AREA_1 DSECT ,                    *                             * 
W1_SAVE  DS    18D                     * Standard save area          * 
W1_SAV2  DS    16D                     * Subroutine save area        * 
W1_SAV3  DS    16D                     * Error Sub routines          * 
W1_SAV4  DS    16D                     * Messages                    * 
W1_OPSYS DS    CL8                     * zOS level                   * 
W1_SYSNM DS    CL8                     * zOS system name             * 
W1_JOBNM DS    CL8                     * Task/Jobname                * 
W1_TTIM  DS    4F                      * STCKE area                  * 
W1_PLIST DS    0D                      *                             * 
         DS    XL(PLISTS_MAX_LENGTH)   * Various plists              * 
W1_NUMBER DS   CL8                     * Number conversion wa        * 
W1_WA2   DS    A                       * A(work area 2)              * 
W1_MSG_BLK DS  0D                      *                             * 
W1_MSG_SKL DS  A                       * Address length and skeleton * 
W1_MSG_MPB DS  4XL(MPB_LENGTH)         * Max 4 parameters            * 
W1_MSG_LEN DS  H                       *                             * 
         DS    H                       *                             * 
W1_MSG_BUF DS  CL121                   *                             * 
         ORG   W1_MSG_BUF              *                             * 
W1_MSG_TIME DS CL12                    *                             * 
         DS    6C                      *                             * 
W1_MSG_TEXT DS CL103                   *                             * 
         ORG   ,                       *                             * 
         DS    0D                      *                             * 
W1_TRTAB DS    XL256                   *                             * 
****************************************                             * 
* TCP specific work area                                             * 
****************************************                             * 
W1T_TASK_WA DS XL(TIELENTH)            *                             * 
W1T_IDENT DS   CL16                    * Addr Space Ids TCP and Us   * 
W1T_MXSOC DS   F                       * Return code                 * 
W1T_RETCD DS   F                       * Return code                 * 
W1T_ERRNO DS   F                       * Error Number (RetCd = -1)   * 
W1T_COUNT DS   F                       * Recv buf len                * 
W1T_REQNM DS   CL12                    * Request name for log/trace  * 
         DS    0D                      *                             * 
WORK_AREA_1_LENGTH EQU *-WORK_AREA_1   *                             * 
****************************************                             * 
* Work Area 2 LOC=BELOW                                              * 
****************************************                             * 
WORK_AREA_2 DSECT ,                    *                             * 
W2_DCB   DS    0D                      *                             * 
         DS    XL(MODEL_DCB_LENGTH)    * Sysprint DCB                * 
WORK_AREA_2_LENGTH EQU *-WORK_AREA_2   *                             * 
*                                      ******************************* 
********************************************************************** 
* System and Access Method DSECTs                                    * 
********************************************************************** 
* 
         PRINT NOGEN 
* 
         IEFTIOT1 
         IHAPSA 
         IKJTCB 
         DCBD  DSORG=PS,DEVD=DA 
         EZASMI TYPE=TASK,STORAGE=DSECT 
         BPXYSOCK 
* 
         PRINT GEN 
* 
********************************************************************** 
* Equates                                                            * 
********************************************************************** 
*                                      ******************************* 
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                      *                             * 
*                                      ******************************* 
         END