home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / LUA.ZIP / LUA / LUA_CBL / LUASAMPO.CBL next >
Text File  |  1991-09-10  |  18KB  |  375 lines
  1.       *****************************************************************
  2.       *                                                               *
  3.       *  MODULE NAME  : LUASAMP.COB                                   *
  4.       *                                                               *
  5.       *  DESCRIPTIVE  : LUA COBOL SAMPLE PROGRAM FOR IBM EXTENDED     *
  6.       *  NAME           SERVICES FOR OS/2                             *
  7.       *                                                               *
  8.       *  COPYRIGHT    : (C) COPYRIGHT IBM CORP. 1989, 1990, 1991      *
  9.       *                 LICENSED MATERIAL - PROGRAM PROPERTY OF IBM   *
  10.       *                 ALL RIGHTS RESERVED                           *
  11.       *                                                               *
  12.       *  FUNCTION     : This program issues                           *
  13.       *                 - an SLI_OPEN to establish an LU_LU session.  *
  14.       *                 - an SLI_SEND to transmit data to the host.   *
  15.       *                 - an SLI_RECEIVE to get data from the host.   *
  16.       *                 - an SLI_SEND to transmit a response.         *
  17.       *                 - an SLI_CLOSE to end the LU_LU session.      *
  18.       *                                                               *
  19.       *  GENERAL SERVICE                                              *
  20.       *    VERBS USED : CONVERT - Translates data between ASCII       *
  21.       *                           and EBCDIC.                         *
  22.       *  MODULE TYPE  : COBOL                                         *
  23.       *                 (Compiles with large memory model)            *
  24.       *                                                               *
  25.       *****************************************************************
  26.  
  27.        IDENTIFICATION DIVISION.
  28.        PROGRAM-ID. LUASAMP.
  29.  
  30.        ENVIRONMENT DIVISION.
  31.  
  32.        DATA DIVISION.
  33.        WORKING-STORAGE SECTION.
  34.        77  OPEN-DISPLAY           PIC X(46)    VALUE
  35.                 " Opening communication with SLI interface.... ".
  36.        77  SEND-DATA-DISPLAY      PIC X(53)    VALUE
  37.                 " SLI interface opened and Init_self sent to the host ".
  38.        77  RECEIVE-DISPLAY        PIC X(53)    VALUE
  39.                 " Test data sent to host. Waiting for host data ".
  40.        77  SEND-RESPONSE-DISPLAY  PIC X(41)    VALUE
  41.                 " Host data received. Responding to host ".
  42.        77  CLOSE-DISPLAY          PIC X(43)    VALUE
  43.                 " Response sent. Preparing to close session ".
  44.        77  CLOSE0-DISPLAY         PIC X(37)    VALUE
  45.                 " SLI interface closed with no errors ".
  46.        77  CLOSE1-DISPLAY         PIC X(53)    VALUE
  47.                 " Quit from LUA conversation due to an error. Ab-ended".
  48.        77  SESSION-FAIL-DISPLAY   PIC X(38)    VALUE
  49.                 " LU-LU session failed due to an error ".
  50.  
  51.        77  SEM-TIMEOUT            PIC X(4)     VALUE  X'FFFFFFFF'.
  52.  
  53.        78  LUA-SIZE               VALUE    64.
  54.        78  LUA-AND-EXT-SIZE       VALUE    98.
  55.        78  SEND-SIZE              VALUE    66.
  56.        78  SEND-AND-EXT-SIZE      VALUE    100.
  57.        78  OPEN-SIZE              VALUE    68.
  58.        78  OPEN-AND-EXT-SIZE      VALUE    102.
  59.        78  CONVERT-LEN            VALUE    8.
  60.        78  INITSELF-RU-LEN        VALUE    25.
  61.        78  TEST-DATA-LEN          VALUE    25.
  62.        78  DATA-BUFFER-LEN        VALUE    256.
  63.        78  BIN-ZERO               VALUE    X'00'.
  64.        78  BIN-ONE                VALUE    X'01'.
  65.  
  66.        01  INITSELF-RU.
  67.            05  ISELF-RQ-01-HDR.
  68.                10  HDR-1        PIC  X     VALUE   X'01'.
  69.                10  HDR-2        PIC  X     VALUE   X'06'.
  70.                10  HDR-3        PIC  X     VALUE   X'81'.
  71.            05  ISELF-RQ-01-F0   PIC  X     VALUE   X'00'.
  72.            05  ISELF-RQ-01-MODE PIC  X(8)  VALUE   "LUA768RU".
  73.            05  ISELF-RQ-01-TY   PIC  X     VALUE   X'F3'.
  74.            05  ISELF-RQ-01-N-1  PIC  X     VALUE   X'08'.
  75.            05  ISELF-RQ-01-PLU  PIC  X(8)  VALUE   "VTAMPGM ".
  76.            05  ISELF-RQ-01-RID  PIC  X     VALUE   X'00'.
  77.            05  ISELF-RQ-01-PW   PIC  X     VALUE   X'00'.
  78.            05  ISELF-RQ-01-UD   PIC  X     VALUE   X'00'.
  79.  
  80.  
  81.        01  TEST-DATA     PIC  X(25)  VALUE "TEST#SENDING#DATA#TO#HOST".
  82.        01  DATA-BUFFER          PIC  X(256).
  83.  
  84.        01  USER-RAM-SEM-ADDR    POINTER.
  85.        01  USER-RAM-SEM         PIC  X(4).
  86.        01  LU-SESSION-ID        PIC  X(4).
  87.        01  SAVED-SEQ-NUM        PIC  X(2).
  88.  
  89.       *******************************************************
  90.       *    Include files from OS/2 Comms Mgr                *
  91.       *******************************************************
  92.            COPY ACSSVCB.CBL.
  93.       *  LUA Constants
  94.            COPY LUA_C_C.CBL.
  95.       *  LUA verb record
  96.        01  LUA-VERB-RECORD.
  97.            COPY LUA_C.CBL.
  98.       *  OPEN specific area
  99.            03 LUA-OPEN.
  100.            COPY LUA_C_O.CBL.
  101.            COPY LUA_C_E.CBL.
  102.       *  SEND specific area
  103.            03 LUA-SEND   REDEFINES  LUA-OPEN.
  104.            COPY LUA_C_S.CBL.
  105.            COPY LUA_C_E.CBL.
  106.       *  RECEIVE, CLOSE specific area
  107.            03 LUA-COB-EXT  REDEFINES  LUA-SEND.
  108.            COPY LUA_C_E.CBL.
  109.  
  110.  
  111.        PROCEDURE DIVISION.
  112.        MAIN-PARAGRAPH.
  113.       ************************************************************
  114.       *    Main function      LUA Sample conversation code       *
  115.       ************************************************************
  116.       *
  117.            SET USER-RAM-SEM-ADDR TO ADDRESS OF USER-RAM-SEM.
  118.            DISPLAY OPEN-DISPLAY.
  119.            PERFORM SLI-OPEN.
  120.            IF LUA-PRIM-RC NOT EQUAL LUA-OK OR
  121.               PRIMARY-RC IN CONVERT NOT EQUAL SV-OK THEN
  122.               DISPLAY SESSION-FAIL-DISPLAY
  123.               STOP RUN.
  124.  
  125.  
  126.            DISPLAY SEND-DATA-DISPLAY
  127.            PERFORM SLI-SEND-DATA
  128.       *
  129.            IF LUA-PRIM-RC EQUAL LUA-OK AND
  130.               PRIMARY-RC IN CONVERT EQUAL SV-OK THEN
  131.               DISPLAY RECEIVE-DISPLAY
  132.               PERFORM SLI-RECEIVE
  133.       *
  134.               IF LUA-PRIM-RC EQUAL LUA-OK AND
  135.                  PRIMARY-RC IN CONVERT EQUAL SV-OK THEN
  136.                  DISPLAY SEND-RESPONSE-DISPLAY
  137.                  PERFORM SLI-SEND-RESPONSE
  138.       *
  139.                  IF LUA-PRIM-RC EQUAL LUA-OK THEN
  140.                     DISPLAY CLOSE-DISPLAY
  141.                     MOVE LOW-VALUES TO LUA-VERB-RECORD
  142.                     MOVE BIN-ZERO TO LUA-FLAG1-CLOSE-ABEND
  143.                                      IN LUA-COB-EXT
  144.                     PERFORM SLI-CLOSE.
  145.  
  146.  
  147.            IF LUA-PRIM-RC EQUAL LUA-OK THEN
  148.               DISPLAY CLOSE0-DISPLAY
  149.            ELSE
  150.               IF LUA-PRIM-RC NOT EQUAL LUA-SESSION-FAILURE THEN
  151.                  MOVE LOW-VALUES TO LUA-VERB-RECORD
  152.                  MOVE BIN-ONE TO LUA-FLAG1-CLOSE-ABEND IN LUA-COB-EXT
  153.                  PERFORM SLI-CLOSE
  154.                  DISPLAY CLOSE1-DISPLAY
  155.               ELSE
  156.                  DISPLAY SESSION-FAIL-DISPLAY.
  157.  
  158.            STOP RUN.
  159.  
  160.       ****************************************************************
  161.       * Function : SLI-OPEN                                          *
  162.       * Purpose  : Open a Session with the host using the SLI_OPEN   *
  163.       *            verb and an INITSELF command.                     *
  164.       * Actions  : Set the required fields for SLI_OPEN and convert  *
  165.       *            the ACSII fields in the INITSELF to EBCDIC.       *
  166.       *            If there are no conversion errors, call the       *
  167.       *            SLI_API and wait for the SLI_OPEN to complete.    *
  168.       *            Save the session ID for use in issuing other      *
  169.       *            verbs for this session.                           *
  170.       ****************************************************************
  171.        SLI-OPEN.
  172.            MOVE LOW-VALUES           TO CONVERT.
  173.            MOVE LOW-VALUES           TO LUA-VERB-RECORD.
  174.            MOVE LUA-OPCODE-SLI-OPEN  TO LUA-OPCODE.
  175.            MOVE LUA-VERB-SLI         TO LUA-VERB.
  176.            MOVE OPEN-AND-EXT-SIZE    TO LUA-VERB-LENGTH.
  177.            MOVE OPEN-SIZE            TO LUA-COBOL-OFFSET.
  178.            MOVE "LUA1    "           TO LUA-LUNAME.
  179.            MOVE LUA-INIT-TYPE-SEC-IS TO LUA-INIT-TYPE IN LUA-OPEN.
  180.            MOVE INITSELF-RU-LEN      TO LUA-DATA-LENGTH.
  181.            SET LUA-DATA-PTR          TO ADDRESS OF INITSELF-RU.
  182.            SET LUA-POST-HANDLE       TO ADDRESS OF USER-RAM-SEM.
  183.  
  184.            MOVE SV-ASCII-TO-EBCDIC  TO DIRECTION.
  185.            MOVE CONVERT-LEN         TO LENGTH-TO-BE-CONVERTED.
  186.            SET  SOURCE-ADDR         TO ADDRESS OF ISELF-RQ-01-PLU.
  187.            SET  TARGET-ADDR         TO ADDRESS OF ISELF-RQ-01-PLU.
  188.  
  189.            PERFORM CONVERT-ROUTINE.
  190.            IF PRIMARY-RC IN CONVERT EQUAL SV-OK THEN
  191.               MOVE SV-ASCII-TO-EBCDIC  TO DIRECTION
  192.               MOVE CONVERT-LEN         TO LENGTH-TO-BE-CONVERTED
  193.               SET  SOURCE-ADDR         TO ADDRESS OF ISELF-RQ-01-MODE
  194.               SET  TARGET-ADDR         TO ADDRESS OF ISELF-RQ-01-MODE
  195.  
  196.               PERFORM CONVERT-ROUTINE
  197.               IF PRIMARY-RC IN CONVERT EQUAL SV-OK THEN
  198.  
  199.                  CALL '__SLI' USING LUA-VERB-RECORD
  200.                  IF LUA-PRIM-RC EQUAL LUA-IN-PROGRESS THEN
  201.                     CALL '__DOSSEMWAIT' USING
  202.                                         BY VALUE SEM-TIMEOUT
  203.                                         USER-RAM-SEM-ADDR
  204.                  IF LUA-PRIM-RC NOT EQUAL LUA-OK THEN
  205.                     PERFORM ERROR2
  206.                  ELSE
  207.                     MOVE LUA-SID TO LU-SESSION-ID.
  208.  
  209.  
  210.       ****************************************************************
  211.       * Function : SLI-SEND-DATA                                     *
  212.       * Purpose  : Send data to the host on LU Normal Flow.          *
  213.       * Actions  : Set the required fields for SLI_SEND and convert  *
  214.       *            the ACSII test data to EBCDIC.                    *
  215.       *            If there are no conversion errors, call the       *
  216.       *            SLI_API and wait for the SLI_SEND to complete.    *
  217.       ****************************************************************
  218.        SLI-SEND-DATA.
  219.            MOVE LOW-VALUES          TO LUA-VERB-RECORD.
  220.            MOVE LUA-OPCODE-SLI-SEND TO LUA-OPCODE.
  221.            MOVE LUA-VERB-SLI        TO LUA-VERB.
  222.            MOVE SEND-AND-EXT-SIZE   TO LUA-VERB-LENGTH.
  223.            MOVE SEND-SIZE           TO LUA-COBOL-OFFSET.
  224.            MOVE LU-SESSION-ID       TO LUA-SID.
  225.            MOVE TEST-DATA-LEN       TO LUA-DATA-LENGTH.
  226.            SET LUA-DATA-PTR         TO ADDRESS OF TEST-DATA.
  227.            SET LUA-POST-HANDLE      TO ADDRESS OF USER-RAM-SEM.
  228.            MOVE  BIN-ONE            TO LUA-RH-RI IN LUA-SEND.
  229.            MOVE  BIN-ONE            TO LUA-RH-DR1I IN LUA-SEND.
  230.            MOVE  BIN-ONE            TO LUA-RH-BBI IN LUA-SEND.
  231.            MOVE  BIN-ONE            TO LUA-RH-CDI IN LUA-SEND.
  232.            MOVE LUA-MESSAGE-TYPE-LU-DATA TO LUA-MESSAGE-TYPE.
  233.  
  234.            MOVE SV-ASCII-TO-EBCDIC  TO DIRECTION.
  235.            MOVE LUA-DATA-LENGTH     TO LENGTH-TO-BE-CONVERTED.
  236.            SET  SOURCE-ADDR         TO LUA-DATA-PTR.
  237.            SET  TARGET-ADDR         TO LUA-DATA-PTR.
  238.  
  239.            PERFORM CONVERT-ROUTINE.
  240.            IF PRIMARY-RC IN CONVERT EQUAL SV-OK THEN
  241.  
  242.               CALL '__SLI' USING LUA-VERB-RECORD
  243.               IF LUA-PRIM-RC EQUAL LUA-IN-PROGRESS THEN
  244.                  CALL '__DOSSEMWAIT' USING
  245.                                      BY VALUE SEM-TIMEOUT
  246.                                      USER-RAM-SEM-ADDR
  247.               IF LUA-PRIM-RC NOT EQUAL LUA-OK THEN
  248.                  PERFORM ERROR2.
  249.  
  250.  
  251.       ****************************************************************
  252.       * Function : SLI-RECEIVE                                       *
  253.       * Purpose  : Receive a message from the host on LU normal flow.*
  254.       * Actions  : Set the required fields for SLI_RECEIVE, call the *
  255.       *            SLI_API and wait for the SLI_RECEIVE to complete. *
  256.       *            If there is no error from the SLI, convert the    *
  257.       *            data from EBCDIC to ASCII.                        *
  258.       ****************************************************************
  259.        SLI-RECEIVE.
  260.            MOVE LOW-VALUES             TO LUA-VERB-RECORD.
  261.            MOVE LUA-OPCODE-SLI-RECEIVE TO LUA-OPCODE.
  262.            MOVE LUA-VERB-SLI           TO LUA-VERB.
  263.            MOVE LUA-AND-EXT-SIZE       TO LUA-VERB-LENGTH.
  264.            MOVE LUA-SIZE               TO LUA-COBOL-OFFSET.
  265.            MOVE LU-SESSION-ID          TO LUA-SID.
  266.            MOVE DATA-BUFFER-LEN        TO LUA-MAX-LENGTH.
  267.            SET LUA-DATA-PTR            TO ADDRESS OF DATA-BUFFER.
  268.            SET LUA-POST-HANDLE         TO ADDRESS OF USER-RAM-SEM.
  269.            MOVE BIN-ONE            TO LUA-FLAG1-LU-NORM IN LUA-COB-EXT.
  270.  
  271.            CALL '__SLI' USING LUA-VERB-RECORD.
  272.            IF LUA-PRIM-RC EQUAL LUA-IN-PROGRESS THEN
  273.               CALL '__DOSSEMWAIT' USING
  274.                                   BY VALUE SEM-TIMEOUT
  275.                                   USER-RAM-SEM-ADDR.
  276.            IF LUA-PRIM-RC NOT EQUAL LUA-OK THEN
  277.               PERFORM ERROR2
  278.            ELSE
  279.               MOVE LUA-TH-SNF          TO   SAVED-SEQ-NUM
  280.               MOVE SV-EBCDIC-TO-ASCII  TO   DIRECTION
  281.               MOVE LUA-DATA-LENGTH     TO   LENGTH-TO-BE-CONVERTED
  282.               SET  SOURCE-ADDR         TO   LUA-DATA-PTR
  283.               SET  TARGET-ADDR         TO   LUA-DATA-PTR
  284.  
  285.               PERFORM CONVERT-ROUTINE.
  286.  
  287.  
  288.       ****************************************************************
  289.       * Function : SLI-SEND-RESPONSE                                 *
  290.       * Purpose  : Send a response to LU Normal data to the host.    *
  291.       * Actions  : Set the required fields for SLI_SEND to send a    *
  292.       *            positive response.  Call the SLI_API and wait for *
  293.       *            the SLI_SEND to complete.                         *
  294.       ****************************************************************
  295.        SLI-SEND-RESPONSE.
  296.            MOVE LOW-VALUES            TO LUA-VERB-RECORD.
  297.            MOVE LUA-OPCODE-SLI-SEND   TO LUA-OPCODE.
  298.            MOVE LUA-VERB-SLI          TO LUA-VERB.
  299.            MOVE SEND-AND-EXT-SIZE     TO LUA-VERB-LENGTH.
  300.            MOVE SEND-SIZE             TO LUA-COBOL-OFFSET.
  301.            MOVE LU-SESSION-ID         TO LUA-SID.
  302.            SET LUA-POST-HANDLE        TO ADDRESS OF USER-RAM-SEM.
  303.            MOVE SAVED-SEQ-NUM         TO LUA-TH-SNF.
  304.            MOVE BIN-ONE               TO LUA-RH-DR1I IN LUA-SEND.
  305.            MOVE BIN-ONE               TO LUA-FLAG1-LU-NORM IN LUA-SEND.
  306.            MOVE LUA-MESSAGE-TYPE-RSP  TO LUA-MESSAGE-TYPE.
  307.  
  308.            CALL '__SLI' USING LUA-VERB-RECORD.
  309.            IF LUA-PRIM-RC EQUAL LUA-IN-PROGRESS THEN
  310.               CALL '__DOSSEMWAIT' USING
  311.                                   BY VALUE SEM-TIMEOUT
  312.                                   USER-RAM-SEM-ADDR.
  313.            IF LUA-PRIM-RC NOT EQUAL LUA-OK THEN
  314.               PERFORM ERROR2.
  315.  
  316.  
  317.       ****************************************************************
  318.       * Function : SLI-CLOSE                                         *
  319.       * Purpose  : Issue an SLI-CLOSE to end the session.            *
  320.       * Actions  : Set the required fields for SLI_CLOSE.  Call the  *
  321.       *            SLI_API and wait for the SLI_CLOSE to complete.   *
  322.       ****************************************************************
  323.        SLI-CLOSE.
  324.            MOVE LOW-VALUES           TO LUA-VERB-RECORD.
  325.            MOVE LUA-OPCODE-SLI-CLOSE TO LUA-OPCODE.
  326.            MOVE LUA-VERB-SLI         TO LUA-VERB.
  327.            MOVE LUA-AND-EXT-SIZE     TO LUA-VERB-LENGTH.
  328.            MOVE LUA-SIZE             TO LUA-COBOL-OFFSET.
  329.            MOVE LU-SESSION-ID        TO LUA-SID.
  330.            SET LUA-POST-HANDLE       TO ADDRESS OF USER-RAM-SEM.
  331.  
  332.            CALL '__SLI' USING LUA-VERB-RECORD.
  333.            IF LUA-PRIM-RC EQUAL LUA-IN-PROGRESS THEN
  334.               CALL '__DOSSEMWAIT' USING
  335.                                   BY VALUE SEM-TIMEOUT
  336.                                   USER-RAM-SEM-ADDR.
  337.            IF LUA-PRIM-RC NOT EQUAL LUA-OK THEN
  338.               PERFORM ERROR2.
  339.  
  340.  
  341.       *****************************************************************
  342.       * Function : CONVERT-ROUTINE.                                   *
  343.       * Purpose  : Convert selected data from ASCII to EBCDIC         *
  344.       *            or from EBCDIC to ASCII.                           *
  345.       *****************************************************************
  346.        CONVERT-ROUTINE.
  347.            MOVE SV-CONVERT          TO OPCODE IN CONVERT.
  348.            MOVE SV-AE               TO CHARACTER-SET.
  349.            CALL "__ACSSVC" USING CONVERT.
  350.            IF PRIMARY-RC IN CONVERT NOT EQUAL SV-OK THEN
  351.               PERFORM ERROR1.
  352.  
  353.  
  354.       *****************************************************************
  355.       * Procedure : ERROR1                                            *
  356.       * Purpose   : Display return codes for conversion errors.       *
  357.       *****************************************************************
  358.        ERROR1.
  359.            DISPLAY " An error has occurred during conversion process".
  360.            DISPLAY " The primary return code is: ",
  361.                      PRIMARY-RC IN CONVERT.
  362.            DISPLAY " The secondary return code is: ",
  363.                      SECONDARY-RC IN CONVERT.
  364.  
  365.  
  366.       ****************************************************************
  367.       * Procedure : ERROR2                                           *
  368.       * Purpose   : Display return codes for unsuccessful SLI verbs. *
  369.       ****************************************************************
  370.        ERROR2.
  371.            DISPLAY " An error occurred with SLI interface. Verb op: ",
  372.                      LUA-OPCODE.
  373.            DISPLAY " The primary return code is: ", LUA-PRIM-RC.
  374.            DISPLAY " The secondary return code is: ", LUA-SEC-RC.
  375.