home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / sdu / samplep.pli < prev    next >
Text File  |  1997-03-14  |  13KB  |  345 lines
  1. *PROCESS langlvl(saa2) source dft(nodescriptor) gn limits(extname(31));
  2.  
  3.  test:proc options(main);
  4.    /***************************************************************************/
  5.    /*                                                                         */
  6.    /* PRODUCT   = Data Description and Conversion for OS/2                    */
  7.    /*                                                                         */
  8.    /* SOURCE FILE NAME = TEST.PLI                                             */
  9.    /*                                                                         */
  10.    /* DESCRIPTIVE NAME = ADL Declaration Translator, CPB, and CPEX sample     */
  11.    /*                                                                         */
  12.    /* FUNCTION =  This TEST.PLI program parses the adl file TEST.ADL using the*/
  13.    /*             FMTPRS function and return the appropriate ADL declare and  */
  14.    /*             plan space.  It then invokes FMTCRCP to create conversion   */
  15.    /*             plan from the encoded ADL declare and plan space.  With the */
  16.    /*             conversion plan, TEST.PLI invokes the FMTCPXI to initialize */
  17.    /*             conversion plan executor, calls FMTCPXC to executes the     */
  18.    /*             conversion plan CNVREC to convert EBCDIC string to ASCII    */
  19.    /*             string, and finally calls FMTCPXT to terminate and release  */
  20.    /*             resources.                                                  */
  21.    /*             In summary, TEST.PLI exercises FMTPRS, FMTCRCP, FMTCPXI,    */
  22.    /*             FMTCPXC, and FMTCPXT functions to accomplish the task of    */
  23.    /*             convert EBCDIC string to ASCII string as specified by the   */
  24.    /*             TEST.ADL.                                                   */
  25.    /*                                                                         */
  26.    /* NOTES =                                                                 */
  27.    /*                                                                         */
  28.    /*   DEPENDENCIES = OS/2 Release 2.0 or later                              */
  29.    /*                                                                         */
  30.    /*   RESTRICTIONS = None                                                   */
  31.    /*                                                                         */
  32.    /* ENTRY POINTS = test()                                                   */
  33.    /*                                                                         */
  34.    /*                                                                         */
  35.    /***************************************************************************/
  36.  
  37.    /***************************************/
  38.    /* Program variables                   */
  39.    /***************************************/
  40.    DCL ADLDECL  CHAR(9) VARZ;
  41.    DCL CCSID1 FIXED BIN(31,0);
  42.    DCL ADLFILELEN FIXED BIN(31,0);
  43.    DCL ADLFILENAM CHAR(9) VARZ;
  44.    DCL CCSID2 FIXED BIN(31,0);
  45.    DCL XLROPTLEN FIXED BIN(31,0);
  46.    DCL XLROPTNAME CHAR(9) VARZ;
  47.    DCL LSTOPTLEN FIXED BIN(31,0);
  48.    DCL LSTOPTNAME CHAR(9) VARZ;
  49.    DCL LSTLEN FIXED BIN(31,0);
  50.    DCL LSTNAME CHAR(9) VARZ;
  51.    DCL ADLDCLLEN FIXED BIN(31,0);
  52.    DCL ADLDCLSPC CHAR(8000) CONTROLLED;
  53.    DCL CCSID3 FIXED BIN(31,0);
  54.  
  55.    /***************************************/
  56.    /* Mapping CNSTKN and FMTCTOK in fmt.h */
  57.    /***************************************/
  58.  
  59.    DCL 1 CNSTKN UNALIGNED,
  60.         2 ULLENGTH FIXED BIN(31,0),
  61.         2 USCLASS  FIXED BIN(15,0),
  62.         2 ABVALUE  CHAR(16) VARZ;
  63.    DCL PCNSTKN POINTER;
  64.    DCL ADLPLNLEN FIXED BIN(31,0);
  65.    DCL ADLPLNSPC CHAR(8000) CONTROLLED;
  66.  
  67.    DCL 1 FMTADLCA UNALIGNED,
  68.         2 LLENGTH FIXED BIN(31,0),
  69.         2 LEXID   FIXED BIN(31,0),
  70.         2 USSEVCOD FIXED BIN(15,0),
  71.         2 PLANID,
  72.           3 USLENGTH FIXED BIN(15,0),
  73.           3 UCHDATA CHAR(255),
  74.         2 LPLANSTMT FIXED BIN(31,0),
  75.         2 INPERRDTA,
  76.           3 USLENGTH FIXED BIN(15,0),
  77.           3 UCHDATA CHAR(255),
  78.         2 SRCFLDID,
  79.           3 USLENGTH FIXED BIN(15,0),
  80.           3 UCHDATA CHAR(255),
  81.         2 TRGFLDID,
  82.           3 USLENGTH FIXED BIN(15,0),
  83.           3 UCHDATA CHAR(255);
  84.  
  85.    DCL 1 FMTCTOK UNALIGNED,
  86.         2 CONDITION_ID,
  87.           3 USMSGSEV FIXED BIN(15,0),
  88.           3 USMSGNO  FIXED BIN(15,0),
  89.         2 FCASE BIT(2),
  90.         2 FSEVERITY BIT(3),
  91.         2 FCONTROL BIT(3),
  92.         2 UCHFACILITY_ID CHAR(3),
  93.         2 PL_S_INFO UNION,
  94.           3 ULADLEXLD FIXED BIN(31,0),
  95.           3 PADLCOMMAREA POINTER,
  96.           3 PUSEREXITCTOK POINTER ;
  97.  
  98.    DCL PFMTCTOK POINTER;
  99.  
  100.    /***************************************/
  101.    /* Program variables                   */
  102.    /***************************************/
  103.  
  104.    DCL 1 X ,
  105.         2 C CHAR(5);
  106.  
  107.    DCL 1 Y ,
  108.         2 C CHAR(10);
  109.  
  110.    DCL 1 PPADLDCLSPCLIST POINTER;
  111.    DCL 1 PPDEFAULTADLPLNSPCLIST POINTER;
  112.    DCL 1 PPUSERADLPLNSPCLIST POINTER;
  113.    DCL 1 CNVPLNSPC CHAR(8000) CONTROLLED;
  114.  
  115.    DCL 1 ULCNVPLNSPCHDL FIXED BIN(31,0);
  116.    DCL 1 PULCNVPLNSPCHDL POINTER;
  117.  
  118.    DCL 1 PINPUTDATA POINTER;
  119.    DCL 1 PPINPUTDATA POINTER;
  120.    DCL 1 POUTPUTDATA POINTER;
  121.    DCL 1 PPOUTPUTDATA POINTER;
  122.  
  123.    /***************************************/
  124.    /* Prototype for DDC API               */
  125.    /***************************************/
  126.  
  127.    DCL FMTPRS entry( char(*) varz byaddr,fixed bin(31) byvalue,
  128.                        fixed bin(31) byvalue,char(*) varz byaddr,
  129.                        fixed bin(31) byvalue,
  130.                        fixed bin(31) byvalue,char(*) varz byaddr,
  131.                        fixed bin(31) byvalue,char(*) varz byaddr,
  132.                        fixed bin(31) byvalue,char(*) varz byaddr,
  133.                        fixed bin(31) byvalue,char(*) byaddr,
  134.                        fixed bin(31) byvalue,
  135.                        pointer byvalue,
  136.                        fixed bin(31) byvalue,char(*) byaddr,
  137.                        pointer byvalue)
  138.                        external('FMTPRS')
  139.                        options(linkage(system));
  140.  
  141.    DCL FMTCRCP entry( fixed bin(31) byvalue,
  142.                       pointer byaddr,
  143.                       fixed bin(31) byvalue,
  144.                       pointer byvalue,
  145.                       fixed bin(31) byvalue,
  146.                       pointer byaddr,
  147.                       fixed bin(31) byvalue,
  148.                       char(*) byaddr,
  149.                       fixed bin(31) byvalue,
  150.                       pointer byvalue)
  151.                       external('FMTCRCP')
  152.                       options(linkage(system));
  153.  
  154.    DCL FMTCPXI entry( char(*) byaddr,
  155.                       pointer byvalue,
  156.                       pointer byvalue)
  157.                       external('FMTCPXI')
  158.                       options(linkage(system));
  159.  
  160.    DCL FMTCPXC entry( fixed bin(31) byvalue,
  161.                       fixed bin(31) byvalue,
  162.                       char(*) byaddr,
  163.                       fixed bin(31) byvalue,
  164.                       pointer byvalue,
  165.                       fixed bin(31) byvalue,
  166.                       pointer byvalue,
  167.                       pointer byvalue)
  168.                       external('FMTCPXC')
  169.                       options(linkage(system));
  170.  
  171.    DCL FMTCPXT entry( fixed bin(31) byvalue,
  172.                       pointer byvalue)
  173.                       external('FMTCPXT')
  174.                       options(linkage(system));
  175.  
  176.    ALLOCATE ADLDCLSPC;
  177.    ALLOCATE ADLPLNSPC;
  178.  
  179.    ADLDECL = '2B12000301886D01'X;
  180.    CCSID1 = 0;
  181.    ADLFILELEN = 8;
  182.    ADLFILENAM = "test.adl";
  183.    CCSID2 = 0;
  184.    XLROPTLEN = 8;
  185.    XLROPTNAME = "AUTOSKIP";
  186.    LSTOPTLEN = 4;
  187.    LSTOPTNAME = "LIST";
  188.    LSTLEN = 8;
  189.    LSTNAME = "test.lsp";
  190.    ADLDCLLEN = 8000;
  191.    ADLDCLSPC = REPEAT('00'X,4000);
  192.    CCSID3 = 0;
  193.    CNSTKN.ULLENGTH = 0;
  194.    CNSTKN.USCLASS  = 0;
  195.    CNSTKN.ABVALUE  = "THIS IS A TEST";
  196.    PCNSTKN = ADDR(CNSTKN);
  197.    ADLPLNLEN = 8000;
  198.    ADLPLNSPC = REPEAT('00'X,4000);
  199.    PFMTCTOK = ADDR(FMTCTOK);
  200.  
  201.    fetch FMTPRS title('FMTB/FMTPRS');
  202.    call FMTPRS(ADLDECL,
  203.                  CCSID1,
  204.                  ADLFILELEN,
  205.                  ADLFILENAM,
  206.                  CCSID2,
  207.                  XLROPTLEN,
  208.                  XLROPTNAME,
  209.                  LSTOPTLEN,
  210.                  LSTOPTNAME,
  211.                  LSTLEN,
  212.                  LSTNAME,
  213.                  ADLDCLLEN,
  214.                  ADLDCLSPC,
  215.                  CCSID3,
  216.                  PCNSTKN,
  217.                  ADLPLNLEN,
  218.                  ADLPLNSPC,
  219.                  PFMTCTOK);
  220.    if FMTCTOK.CONDITION_ID.USMSGNO ^= 0 then
  221.      do;
  222.        display('error in parsing the ADL file.');
  223.        display('The condition token has the following contents:');
  224.        put edit ('Message Severity :',FMTCTOK.CONDITION_ID.USMSGSEV)
  225.                 (skip,a(40),f(7));
  226.        put edit ('Message Number   :',FMTCTOK.CONDITION_ID.USMSGNO)
  227.                 (skip,a(40),f(7));
  228.        goto exit;
  229.      end;
  230.    else
  231.      do;
  232.        display('no error in parsing the ADL file.');
  233.      end;
  234.  
  235.    ALLOCATE CNVPLNSPC;
  236.    CNVPLNSPC = REPEAT('00'X,4000);
  237.    FMTCTOK.PL_S_INFO.PADLCOMMAREA = ADDR(FMTADLCA);
  238.  
  239.    PPADLDCLSPCLIST = ADDR(ADLDCLSPC);
  240.    PPDEFAULTADLPLNSPCLIST = ADDR(ADLPLNSPC);
  241.    PPUSERADLPLNSPCLIST = NULL();
  242.  
  243.    fetch FMTCRCP title('FMTC/FMTCRCP');
  244.    call FMTCRCP(1,
  245.                 PPADLDCLSPCLIST,
  246.                 0,
  247.                 NULL,
  248.                 1,
  249.                 PPDEFAULTADLPLNSPCLIST,
  250.                 8000,
  251.                 CNVPLNSPC,
  252.                 0,
  253.                 PFMTCTOK);
  254.    if FMTCTOK.CONDITION_ID.USMSGNO ^= 0 then
  255.      do;
  256.        display('error in conversion plan builder.');
  257.        display('The condition token has the following contents:');
  258.        put edit ('Message Severity :',FMTCTOK.CONDITION_ID.USMSGSEV)
  259.                 (skip,a(40),f(7));
  260.        put edit ('Message Number   :',FMTCTOK.CONDITION_ID.USMSGNO)
  261.                 (skip,a(40),f(7));
  262.        goto exit;
  263.      end;
  264.    else
  265.      display('no error in conversion plan builder.');
  266.  
  267.    PULCNVPLNSPCHDL = ADDR(ULCNVPLNSPCHDL);
  268.    fetch FMTCPXI title('FMTD/FMTCPXI');
  269.    call FMTCPXI(CNVPLNSPC,
  270.                 PULCNVPLNSPCHDL,
  271.                 PFMTCTOK);
  272.    if FMTCTOK.CONDITION_ID.USMSGNO ^= 0 then
  273.      do;
  274.        display('error in initialize conversion plan executor.');
  275.        display('The condition token has the following contents:');
  276.        put edit ('Message Severity :',FMTCTOK.CONDITION_ID.USMSGSEV)
  277.                 (skip,a(40),f(7));
  278.        put edit ('Message Number   :',FMTCTOK.CONDITION_ID.USMSGNO)
  279.                 (skip,a(40),f(7));
  280.        goto exit;
  281.      end;
  282.    else
  283.      display('no error in initialize conversion plan executor.');
  284.  
  285.    X.C = 'D3D4D5D6D7'X;
  286.  
  287.    PINPUTDATA = ADDR(X);
  288.    PPINPUTDATA = ADDR(PINPUTDATA);
  289.    POUTPUTDATA = ADDR(Y);
  290.    PPOUTPUTDATA = ADDR(POUTPUTDATA);
  291.  
  292.    fetch FMTCPXC title('FMTD/FMTCPXC');
  293.    call FMTCPXC(ULCNVPLNSPCHDL,
  294.                 6,
  295.                 "CNVREC",
  296.                 1,
  297.                 PPINPUTDATA,
  298.                 1,
  299.                 PPOUTPUTDATA,
  300.                 PFMTCTOK);
  301.    if FMTCTOK.CONDITION_ID.USMSGNO ^= 0 then
  302.      do;
  303.        display('error in conversion plan executor convert.');
  304.        display('The condition token has the following contents:');
  305.        put edit ('Message Severity :',FMTCTOK.CONDITION_ID.USMSGSEV)
  306.                 (skip,a(40),f(7));
  307.        put edit ('Message Number   :',FMTCTOK.CONDITION_ID.USMSGNO)
  308.                 (skip,a(40),f(7));
  309.        goto exit;
  310.      end;
  311.    else
  312.      display('no error in conversion plan executor convert.');
  313.  
  314.  
  315.    fetch FMTCPXT title('FMTD/FMTCPXT');
  316.    call FMTCPXT(ULCNVPLNSPCHDL,
  317.                 PFMTCTOK);
  318.    if FMTCTOK.CONDITION_ID.USMSGNO ^= 0 then
  319.      do;
  320.        display('error in terminate conversion plan executor.');
  321.        display('The condition token has the following contents:');
  322.        put edit ('Message Severity :',FMTCTOK.CONDITION_ID.USMSGSEV)
  323.                 (skip,a(40),f(7));
  324.        put edit ('Message Number   :',FMTCTOK.CONDITION_ID.USMSGNO)
  325.                 (skip,a(40),f(7));
  326.        goto exit;
  327.      end;
  328.    else
  329.      do;
  330.        display('no error in terminate conversion plan executor.');
  331.        put edit ('Expected output for Y.C =               LMNOP')
  332.                 (skip,a(45));
  333.        put edit ('Y.C = ',Y.C)
  334.                 (skip,a(40),a);
  335.      end;
  336.  
  337.    exit:
  338.  
  339.    FREE ADLDCLSPC;
  340.    FREE ADLPLNSPC;
  341.    FREE CNVPLNSPC;
  342.  
  343.  end test;
  344.  
  345.