home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / CASE.@BL / CASE.CBL
Encoding:
Text File  |  1991-04-08  |  44.8 KB  |  1,167 lines
  1.       $set ans85 noosvs comp mf
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                      CASE.CBL                            *
  7.       *                                                          *
  8.       * This program converts the case of COBOL source code      *
  9.       * files in several ways, producing, for example, uppercase *
  10.       * reserved words and lower case data names.                *
  11.       *                                                          *
  12.       * Instructions for use are presented when it is first      *
  13.       * executed.                                                *
  14.       *                                                          *
  15.       * This source file actually contains two separate          *
  16.       * programs, one called from the other. This type of source *
  17.       * file is known as a multi-program source. Compiling this  *
  18.       * source file will result in the creation of two separate  *
  19.       * OBJs, as if two separate programs had been compiled, one *
  20.       * after the other. The two OBJs will be called CASE and    *
  21.       * CASECONV, CASECONV taking its name from the PROGRAM-ID   *
  22.       * line in the second program.                              *
  23.       *                                                          *
  24.       * Compile the program and link the two OBJs created in the *
  25.       * usual way.                                               *
  26.       *                                                          *
  27.       ************************************************************
  28.        identification division.
  29.        program-id. case.
  30.        environment division.
  31.        file-control.
  32.            select input-file assign input-file-name
  33.                organization is line sequential
  34.                file status is file-status.
  35.  
  36.            select output-file assign output-file-name
  37.                organization is line sequential
  38.                file status is file-status.
  39.  
  40.        data division.
  41.  
  42.        file section.
  43.  
  44.        fd input-file.
  45.        01 input-record                 pic x(80).
  46.  
  47.        fd output-file.
  48.        01 output-record                pic x(80).
  49.  
  50.        working-storage section.
  51.        01      temp-00   .
  52.            03     temp-00-0101 pic x(0078) value "Instructions for using
  53.       -    " the CASE utility for altering the case of COBOL source:".
  54.            03 filler           pic x(0082).
  55.            03     temp-00-0301 pic x(0077) value "CASE <srce-file-spec>
  56.       -    "<target-file-spec> <resvd-word> <data-name> <procedure>".
  57.            03 filler           pic x(0086).
  58.            03     temp-00-0504 pic x(0062) value "src-file-spec: full pa
  59.       -    "thname and file name for the source file".
  60.            03 filler           pic x(0015).
  61.            03     temp-00-0601 pic x(0065) value "target-file-spec: full
  62.       -    " pathname and file name for the target file".
  63.            03 filler           pic x(0021).
  64.            03     temp-00-0707 pic x(0060) value "resvd-word: U means co
  65.       -    "nvert all reserved words to UPPER case".
  66.            03 filler           pic x(0032).
  67.            03     temp-00-0819 pic x(0029) value "L means convert to LOW
  68.       -    "ER case".
  69.            03 filler           pic x(0051).
  70.            03     temp-00-0919 pic x(0062) value "F means convert first
  71.       -    "character to UPPER, all others to LOWER ".
  72.            03     temp-00-1001 pic x(0062) value "       data-name: U me
  73.       -    "ans convert all data names to UPPER case".
  74.            03 filler           pic x(0036).
  75.            03     temp-00-1119 pic x(0029) value "L means convert to LOW
  76.       -    "ER case".
  77.            03 filler           pic x(0051).
  78.            03     temp-00-1219 pic x(0062) value "F means convert first
  79.       -    "character to UPPER, all others to LOWER ".
  80.            03     temp-00-1301 pic x(0079) value "       procedure: U me
  81.       -    "ans convert all procedure and section names to UPPER case".
  82.            03 filler           pic x(0019).
  83.            03     temp-00-1419 pic x(0029) value "L means convert to LOW
  84.       -    "ER case".
  85.            03 filler           pic x(0051).
  86.            03     temp-00-1519 pic x(0061) value "F means convert first
  87.       -    "character to UPPER, all others to LOWER".
  88.            03 filler           pic x(0081).
  89.            03     temp-00-1701 pic x(0054) value "eg. CASE C:\WORK\MYPRO
  90.       -    "G.CBL D:\MYDIR\NEWPROG.CBL U F L".
  91.            03 filler           pic x(0106).
  92.            03     temp-00-1901 pic x(0080) value "The other use of this
  93.       -    "utility is to convert a COBOL source file to ""SENTENCE"".
  94.       -    "".
  95.            03     temp-00-2001 pic x(0080) value "ie. the first characte
  96.       -    "r found after a period is UPPER case, all others are LOWER".
  97.            03 filler           pic x(0080).
  98.            03     temp-00-2201 pic x(0050) value "eg. CASE C:\WORK\MYPRO
  99.       -    "G.CBL D:\MYDIR\NEWPROG.CBL S".
  100.            03 filler           pic x(0030).
  101.        77  prog-line-no                pic 9(6) comp.
  102.        77  prog-line-no-disp           pic z(6).
  103.        77  start-ind                   pic 99 comp.
  104.        77  char-ind                    pic 99 comp.
  105.        77  buffer-char-ind             pic 99 comp.
  106.  
  107.        77  file-flag                   pic x.
  108.            88  end-of-file                 value "Y".
  109.  
  110.        77  error-flag                  pic x.
  111.            88 error-found                  value "Y".
  112.  
  113.        77  file-status                 pic xx.
  114.  
  115.        77  input-file-name             pic x(80).
  116.  
  117.        77  output-file-name            pic x(80).
  118.  
  119.        77  q-answer                    pic x.
  120.  
  121.        77  no-list                     pic x(6).
  122.            88  no-list-true  value "Nolist" "NOLIST" "nolist" "NoList".
  123.        77  syntax-error                pic x(80)
  124.                 value "Syntax error in parameters - Program Terminated".
  125.        01  out-err.
  126.            03  oe1                     pic x(20)
  127.                                             value "Target file exists:".
  128.            03  oe2                     pic x(15) value "Are you sure?".
  129.        01  in-err.
  130.            03  ie1                     pic x(27)
  131.                                      value "Source file not found for:".
  132.            03  in-err-fname            pic x(53).
  133.        01  dup-err.
  134.            03  de1                     pic x(37)
  135.                            value "Source and target file are the same:".
  136.            03  dup-err-fname           pic x(43).
  137.  
  138.        78  upper-case      value "UPPER-CASE".
  139.        78  lower-case      value "lower-case".
  140.        78  first-char      value "First-Character-Upper".
  141.        78  sentence-case   value "Sentence-type-case".
  142.  
  143.        01  final-message-1.
  144.            03  fm1      pic x(31) value "            About to convert:".
  145.            03  disp-inp pic x(49).
  146.            03  fm2      pic x(31) value "                          to:".
  147.            03  disp-out pic x(49).
  148.        01  final-message-2-1.
  149.            03  fm3     pic x(31) value " Converting Reserved words to:".
  150.            03  res-inp pic x(49).
  151.            03  fm4     pic x(31) value "                Data names to:".
  152.            03  dat-inp pic x(49).
  153.            03  fm5     pic x(31) value "           Procedure names to:".
  154.            03  pro-inp pic x(49).
  155.        01  final-message-2-2.
  156.            03  fm6     pic x(31) value "    Converting entire file to:".
  157.            03  fm7     pic x(49) value "Sentence case".
  158.        01  final-message-3.
  159.            03  fm8     pic x(31) value "--- No screen listing ---".
  160.        01  final-message-4.
  161.            03  fm9     pic x(31) value "    Do you wish to continue ? ".
  162.  
  163.        01  command-tail.
  164.            03  command-tail-char       pic x occurs 81.
  165.  
  166.        01  buffer-string.
  167.            03  buffer-char             pic x occurs 80.
  168.  
  169.        01  case-linkage.
  170.            03  case-flags.
  171.                05  lnk-reserved-case       pic x.
  172.                    88  lnk-reserved-case-ok
  173.                                   value "u" "l" "f" "U" "L" "F" "S" "s".
  174.       * note that the resreved case flag is also used to determine if
  175.       * the conversion is to be a "sentence" type conversion.
  176.                05  lnk-data-name-case      pic x.
  177.                    88  lnk-data-name-case-ok
  178.                                           value "u" "l" "f" "U" "L" "F".
  179.                05  lnk-proc-case           pic x.
  180.                    88  lnk-proc-case-ok
  181.                                           value "u" "l" "f" "U" "L" "F".
  182.            03  record-area             pic x(80).
  183.  
  184.        procedure division.
  185.        runstart section.
  186.            display spaces upon crt
  187.            perform get-command-line
  188.            if not error-found
  189.                perform test-case-flags
  190.                if error-found
  191.                    perform command-line-error
  192.                else
  193.                    perform open-input-file
  194.                    if error-found
  195.                        perform input-file-error
  196.                    else
  197.                        display spaces upon crt
  198.                        perform check-output-file
  199.                        if not error-found
  200.                            open output output-file
  201.                            perform convert-file
  202.                            close input-file
  203.                            close output-file
  204.                        end-if
  205.                    end-if
  206.                end-if
  207.            end-if
  208.            exit program
  209.            stop run.
  210.  
  211.        get-command-line section.
  212.            accept command-tail from command-line
  213.            if command-tail = spaces
  214.                perform command-line-prompt
  215.                display "Enter Parameters"
  216.                accept command-tail
  217.                if command-tail = spaces
  218.                    set error-found to true
  219.                    display syntax-error
  220.                end-if
  221.            end-if
  222.            if not error-found
  223.                perform split-off-names
  224.                if input-file-name  = spaces
  225.                        or output-file-name = spaces
  226.                        or lnk-reserved-case = spaces
  227.                        or lnk-data-name-case = spaces
  228.                        or lnk-proc-case = spaces
  229.                    perform command-line-error
  230.                else
  231.                    if input-file-name = output-file-name
  232.                        perform duplicate-file-name-error
  233.                    end-if
  234.                end-if
  235.            end-if.
  236.  
  237.        open-input-file section.
  238.            open input input-file
  239.            if file-status not = "00"
  240.                set error-found to true
  241.                close input-file
  242.            end-if.
  243.  
  244.        check-output-file section.
  245.            open input output-file
  246.            if file-status = "00"
  247.                close output-file
  248.                perform check-for-overwrite
  249.            end-if.
  250.  
  251.        convert-file section.
  252.            move input-file-name to disp-inp
  253.            move output-file-name to disp-out
  254.            evaluate lnk-reserved-case
  255.                when "U"
  256.                when "u"
  257.                    move upper-case to res-inp
  258.                when "L"
  259.                when "l"
  260.                    move lower-case to res-inp
  261.                when "F"
  262.                when "f"
  263.                    move first-char to res-inp
  264.                when "S"
  265.                when "s"
  266.                    move sentence-case to res-inp
  267.            end-evaluate
  268.            evaluate lnk-data-name-case
  269.                when "U"
  270.                when "u"
  271.                    move upper-case to dat-inp
  272.                when "L"
  273.                when "l"
  274.                    move lower-case to dat-inp
  275.                when "F"
  276.                when "f"
  277.                    move first-char to dat-inp
  278.            end-evaluate
  279.            evaluate lnk-proc-case
  280.                when "U"
  281.                when "u"
  282.                    move upper-case to pro-inp
  283.                when "L"
  284.                when "l"
  285.                    move lower-case to pro-inp
  286.                when "F"
  287.                when "f"
  288.                    move first-char to pro-inp
  289.            end-evaluate
  290.            display final-message-1 at 0301
  291.            if lnk-reserved-case = "S" or "s"
  292.                display final-message-2-2 at 0601
  293.            else
  294.                display final-message-2-1 at 0601
  295.            end-if
  296.            if no-list-true
  297.                display final-message-3 at 1001
  298.            end-if
  299.            display final-message-4 at 1201
  300.            move "Y" to q-answer
  301.            accept q-answer at 1233
  302.  
  303.            if q-answer = "y" or "Y"
  304.                display "Converting - Please Wait" at 1401
  305.                perform read-input-file
  306.                move 1 to prog-line-no
  307.                perform until end-of-file
  308.                    move prog-line-no to prog-line-no-disp
  309.                    move input-record to record-area
  310.                    call "CASECONV" using case-linkage
  311.                    move record-area to output-record
  312.                    write output-record
  313.                    if not no-list-true
  314.                        move prog-line-no-disp to output-record(1:6)
  315.                        display output-record
  316.                    else
  317.                        display prog-line-no-disp at 1425
  318.                    end-if
  319.                    add 1 to prog-line-no
  320.                    perform read-input-file
  321.                end-perform
  322.                display " "
  323.                display " "
  324.                display "Conversion complete"
  325.            else
  326.                set error-found to true
  327.            end-if.
  328.  
  329.        split-off-names section.
  330.            move 1 to start-ind
  331.            perform find-leading-spaces
  332.            perform get-input-file-name
  333.            perform find-leading-spaces
  334.            perform get-output-file-name
  335.            perform find-leading-spaces
  336.            perform get-reserved-flag
  337.            if lnk-reserved-case = "S" or "s"
  338.                move "S" to lnk-data-name-case
  339.                move "S" to lnk-proc-case
  340.            else
  341.                perform find-leading-spaces
  342.                perform get-data-name-flag
  343.                perform find-leading-spaces
  344.                perform get-proc-name-flag
  345.            end-if
  346.            perform find-leading-spaces
  347.            perform get-nolist-flag.
  348.  
  349.        find-leading-spaces section.
  350.            perform varying char-ind from start-ind by 1 until
  351.                    (char-ind > 80)
  352.                  or not (command-tail-char(char-ind) = (spaces or ","))
  353.            end-perform
  354.            move char-ind to start-ind.
  355.  
  356.        get-input-file-name section.
  357.            move spaces to buffer-string
  358.            move 1 to buffer-char-ind
  359.            perform varying char-ind from start-ind by 1 until
  360.                    char-ind > 80 or command-tail-char(char-ind) = spaces
  361.                move command-tail-char(char-ind) to
  362.                                             buffer-char(buffer-char-ind)
  363.                add 1 to buffer-char-ind
  364.            end-perform
  365.            move buffer-string to input-file-name
  366.            move char-ind to start-ind.
  367.  
  368.        get-output-file-name section.
  369.            move spaces to buffer-string
  370.            move 1 to buffer-char-ind
  371.            perform varying char-ind from start-ind by 1 until
  372.                    char-ind > 80 or command-tail-char(char-ind) = spaces
  373.                move command-tail-char(char-ind) to
  374.                                             buffer-char(buffer-char-ind)
  375.                add 1 to buffer-char-ind
  376.            end-perform
  377.            move buffer-string to output-file-name
  378.            move char-ind to start-ind.
  379.  
  380.        get-reserved-flag section.
  381.            if start-ind < 80
  382.                move command-tail-char(start-ind) to lnk-reserved-case
  383.                add 1 to start-ind
  384.            end-if.
  385.  
  386.        get-data-name-flag section.
  387.            if start-ind < 80
  388.                move command-tail-char(start-ind) to lnk-data-name-case
  389.                add 1 to start-ind
  390.            end-if.
  391.  
  392.        get-proc-name-flag section.
  393.            if start-ind < 80
  394.                move command-tail-char(start-ind) to lnk-proc-case
  395.                add 1 to start-ind
  396.            end-if.
  397.  
  398.        get-nolist-flag section.
  399.            move spaces to buffer-string
  400.            move 1 to buffer-char-ind
  401.            perform varying char-ind from start-ind by 1 until
  402.                    char-ind > 80 or command-tail-char(char-ind) = spaces
  403.                move command-tail-char(char-ind) to
  404.                                             buffer-char(buffer-char-ind)
  405.                add 1 to buffer-char-ind
  406.            end-perform
  407.            move buffer-string to no-list.
  408.  
  409.        check-for-overwrite section.
  410.            display out-err at 0101
  411.            move "Y" to q-answer
  412.            accept q-answer at 0137
  413.            if q-answer = "y" or "Y"
  414.                next sentence
  415.            else
  416.                set error-found to true
  417.            end-if.
  418.  
  419.        input-file-error section.
  420.            set error-found to true
  421.            move input-file-name to in-err-fname
  422.            display in-err.
  423.  
  424.        command-line-error section.
  425.            perform command-line-prompt
  426.            display syntax-error
  427.            set error-found to true.
  428.  
  429.        command-line-prompt section.
  430.            display temp-00.
  431.  
  432.        duplicate-file-name-error section.
  433.            move input-file-name to dup-err-fname
  434.            set error-found to true
  435.            display dup-err.
  436.  
  437.        read-input-file section.
  438.            read input-file
  439.                at end
  440.                    set end-of-file to true
  441.            end-read.
  442.  
  443.        test-case-flags section.
  444.            if lnk-reserved-case = "S" or "s"
  445.                next sentence
  446.            else
  447.                if lnk-reserved-case-ok and
  448.                               lnk-data-name-case-ok and lnk-proc-case-ok
  449.                    next sentence
  450.                else
  451.                    set error-found to true
  452.                end-if
  453.            end-if.
  454.  
  455.        end program case.
  456.  
  457.  
  458.        identification division.
  459.        program-id. caseconv.
  460.       ***************************************************************
  461.       * This program accepts one 80 character line of COBOL code in its
  462.       * linkage section. This line of code is returned to the calling
  463.       * program with the line of code changed according to the
  464.       * following rules:
  465.       *
  466.       * There are 3 parameters passed in linkage section:
  467.       *
  468.       *   lnk-reserved-case        can have values U, L and F
  469.       *   lnk-data-name-case       can have values U, L and F
  470.       *   lnk-proc-case            can have values U, L and F
  471.       *
  472.       *   the first parameter controls the case of reserved words
  473.       *   the second parameter controls the case of data names
  474.       *   the third parameter controls the procedure and section names
  475.       *
  476.       *   All the above can be independantly changed so that they are
  477.       *   in:
  478.       *
  479.       *        UPPER-CASE
  480.       *        lower-case or
  481.       *        First-Character-Upper-Case
  482.       *
  483.       *   according to the respective value of the parameter
  484.       *
  485.       *   One additional function of this program is controlled by
  486.       *   passing the value "S" in lnk-reserved-case. In this case, the
  487.       *   other parameters are ignored and the entire line is converted
  488.       *   so that the case is made "Sentence like". ie. the first
  489.       *   alphabetic character found after a period is capitalised.
  490.       ***************************************************************
  491.        working-storage section.
  492.        01  temp-char                   pic x.
  493.        01  temp-char-9 redefines temp-char pic 99 comp.
  494.       *   This next variable, and its associated 88 is used to determine
  495.       *   whether to capitalize the next character in the case of "F"
  496.       *   type conversion. The setting in the 88 is to capitalize after
  497.       *   a space, a hyphen etc. This can be changed to suit your
  498.       *   requirements.
  499.  
  500.        01  prev-char                   pic x.
  501.            88  prev-char-separator
  502.                            value "(" ":" "-" space "0" thru "9".
  503.        77  ind-1                       pic 9(4) comp.
  504.        77  ind-2                       pic 9(4) comp.
  505.        78  editfun                     value x"bb".
  506.        78  spacebreak                  value x"c5".
  507.        78  yes                         value 1.
  508.        78  nay                         value 0.
  509.        01  literal                     pic 99 comp value zero.
  510.        01  reserved                    pic 99 comp value zero.
  511.        01  new-sentence-expected       pic 99 comp value 1.
  512.        01  start-of-sentence           pic 99 comp value 1.
  513.        01  perf-name-expected          pic 99 comp value zero.
  514.        01  alt1-name-expected          pic 99 comp value zero.
  515.        01  alt2-name-expected          pic 99 comp value zero.
  516.        01  go-name-expected            pic 99 comp value zero.
  517.        01  pic-name-expected           pic 99 comp value zero.
  518.        01  sub                         pic 99 comp value zero.
  519.        01  start-sub                   pic 99 comp value zero.
  520.        01  end-sub                     pic 99 comp value zero.
  521.        01  res-sub                     pic 99 comp value zero.
  522.        01  res-len                     pic 99 comp value zero.
  523.        01  res-word-buffer.
  524.          02  res-word-buffer-char      pic x occurs 65.
  525.        01  filler redefines res-word-buffer.
  526.         02 res19.
  527.          03 res18.
  528.           04 res17.
  529.            05 res16.
  530.             06 res15.
  531.              07 res14.
  532.               08 res13.
  533.                09 res12.
  534.                 10 res11.
  535.                  11 res10.
  536.                   12 res09.
  537.                    13 res08.
  538.                     14 res07.
  539.                      15 res06.
  540.                       16 res05.
  541.                        17 res04.
  542.                         18 res03.
  543.                          19 res02        pic xx.
  544.                          19 filler       pic x.
  545.                         18 filler        pic x.
  546.                        17 filler         pic x.
  547.                       16 filler          pic x.
  548.                      15 filler           pic x.
  549.                     14 filler            pic x.
  550.                    13 filler             pic x.
  551.                   12 filler              pic x.
  552.                  11 filler               pic x.
  553.                 10 filler                pic x.
  554.                09 filler                 pic x.
  555.               08 filler                  pic x.
  556.              07 filler                   pic x.
  557.             06 filler                    pic x.
  558.            05 filler                     pic x.
  559.           04 filler                      pic x.
  560.          03 filler                       pic x.
  561.         02 filler                        pic x(46).
  562.        01  char-to-bin.
  563.          02 char                       pic x.
  564.        01  char9 redefines char-to-bin pic 99 comp.
  565.        01  ulcase                      pic 99 comp value 0.
  566.        01  locase                      pic 99 comp value 1.
  567.        01  editstart                   pic 9(4) comp value zero.
  568.        01  templen                     pic 9(4) comp value zero.
  569.        01  editlen                     pic 9(4) comp value zero.
  570.        01  editfunction                pic 9(4) comp value 0.
  571.  
  572.       *list of no of reserved words for ANS85
  573.        78  res-word-count-2   value 24.
  574.        78  res-word-count-3   value 24.
  575.        78  res-word-count-4   value 51.
  576.        78  res-word-count-5   value 43.
  577.        78  res-word-count-6   value 48.
  578.        78  res-word-count-7   value 41.
  579.        78  res-word-count-8   value 40.
  580.        78  res-word-count-9   value 23.
  581.        78  res-word-count-10  value 23.
  582.        78  res-word-count-11  value 17.
  583.        78  res-word-count-12  value 15.
  584.        78  res-word-count-13  value 9.
  585.        78  res-word-count-14  value 6.
  586.        78  res-word-count-15  value 4.
  587.        78  res-word-count-16  value 2.
  588.        78  res-word-count-19  value 1.
  589.  
  590.        01 r2tab    pic x(48) value "ATBYCDFDGOIDIFINISNOOFONORRDSDTOUPCF
  591.       -"CHDEPFPHRFRH".
  592.        01 filler redefines r2tab.
  593.          02  r2entry pic xx occurs res-word-count-2.
  594.        01 r3tab    pic x(72) value "ADDALLANDARECRTDAYEGIEMIENDEOPESIFOR
  595.       -"KEYNOTOFFPICRUNSETTABTOPUSEI-OSUMANY".
  596.        01 filler redefines r3tab.
  597.          02  r3entry pic xxx occurs res-word-count-3.
  598.        01 r4tab.
  599.         02 filler pic x(128) value "ALSOAREACALLCOMPCOPYCORRDATADATEDOWN
  600.       -"ELSEEXITFILEFROMINTOJUSTKEPTLEFTLESSLINEMODEMOVENEXTOPENPAGEREAD
  601.       -"REELSAMESENDSIGNSIZESORTSTOP".
  602.         02 filler pic x(76) value
  603.       -"TAPETEXTTHANTHENTHRUTIMETYPEUNITUPONWHENWITHZEROSYNCCODELASTPLUS
  604.       -"TESTTHENTRUE".
  605.        01 filler redefines r4tab.
  606.          02  r4entry pic x(4) occurs res-word-count-4.
  607.        01 r5tab.
  608.         02 filler pic x(128) value "AFTERALTERAREASBLANKBLOCKCLOSECOBOLC
  609.       -"OMMACOUNTEQUALERROREVERYFIRSTINDEXINPUTLABELLIMITLINESMERGEQUEUE
  610.       -"QUOTERERUNSPACESTARTSYSINTAB".
  611.         02 filler pic x(87) value
  612.       -"LETIMESUNTILUSAGEUSINGVALUEWORDSWRITEZEROSENTERRIGHTFINALGROUPRE
  613.       -"SETCLASSORDEROTHERPURGE".
  614.        01 filler redefines r5tab.
  615.          02  r5entry pic x(5) occurs res-word-count-5.
  616.        01 r6tab.
  617.         02 filler pic x(128) value "ACCEPTACCESSASSIGNAUTHORBEFOREBOTTOM
  618.       -"CANCELCOMMITCOMP-3CURSORDELETEDIVIDEENABLEEXTENDFILLERGIVINGLENG
  619.       -"THLIMITSLINAGEMANUALMEMORYNA".
  620.         02 filler pic x(124) value
  621.       -"TIVEOCCURSOUTPUTQUOTESRANDOMRECORDRETURNREWINDSEARCHSELECTSOURCE
  622.       -"SPACESSTATUSSTRINGSWITCHSYSOUTUNLOCKVALUESZEROESCOMP-3COLUMN".
  623.         02 filler pic x(42) value
  624.       -"DETAILREPORTNUMBERBINARYCOMMONEND-IFGLOBAL".
  625.        01 filler redefines r6tab.
  626.          02  r6entry pic x(6) occurs res-word-count-6.
  627.        01 r7tab.
  628.         02 filler pic x(128) value "COMPUTECONSOLEDISABLEDISPLAYDYNAMICF
  629.       -"OOTINGGREATERINDEXEDINSPECTINVALIDLEADINGLINKAGEMESSAGEMODULESNU
  630.       -"MERICOMITTEDPERFORMPICTUREPO".
  631.         02 filler pic x(124) value
  632.       -"INTERPROCEEDPROGRAMRECEIVERECORDSRELEASEREMOVALRENAMESRESERVEREW
  633.       -"RITEROUNDEDSECTIONSEGMENTTHROUGHVARYINGINITIALCONTROLHEADING".
  634.         02 filler pic x(35) value
  635.       -"REPORTSCONTENTEND-ADDPADDINGREPLACE".
  636.        01 filler redefines r7tab.
  637.          02  r7entry pic x(7) occurs res-word-count-7.
  638.        01 r8tab.
  639.         02 filler pic x(128) value "CODE-SETCONTAINSCURRENCYDIVISIONEXCE
  640.       -"SS-3FORMFEEDJAPANESEMULTIPLEMULTIPLYNEGATIVEOPTIONALOVERFLOWPOSI
  641.       -"TIONPOSITIVEREVERSEDROLLBACK".
  642.         02 filler pic x(128) value
  643.       -"SENTENCESEPARATESEQUENCESTANDARDSUBTRACTSYMBOLICTALLYINGTERMINAL
  644.       -"TRAILINGUNSTRINGCONTROLSGENERATEINDICATEINITIATEPRINTINGSUPPRESS
  645.       -"".
  646.         02 filler pic x(64) value
  647.       -"RELATIVESECURITYALPHABETCONTINUEEND-READEVALUATEEXTERNALEND-CALL
  648.       -"".
  649.        01 filler redefines r8tab.
  650.          02  r8entry pic x(8) occurs res-word-count-8.
  651.        01 r9tab.
  652.         02 filler pic x(126) value "ADVANCINGAUTOMATICCHARACTERCRT-UNDER
  653.       -"DEBUGGINGDELIMITEDDELIMITERDEPENDINGEXCEPTIONEXCLUSIVEJUSTIFIEDP
  654.       -"ROCEDUREREDEFINESREMAINDER".
  655.         02 filler pic x(81) value
  656.       -"REPLACINGREPORTINGTERMINATEASCENDINGALTERNATECOLLATINGEND-STARTE
  657.       -"ND-WRITEREFERENCE".
  658.        01 filler redefines r9tab.
  659.          02  r9entry pic x(9) occurs res-word-count-9.
  660.        01 r10tab.
  661.         02 filler pic x(090) value "ALPHABETICAREA-VALUECHARACTERSDUPLIC
  662.       -"ATESPROCEDURESREFERENCESSEQUENTIALSORT-MERGESTANDARD-1".
  663.         02 filler pic x(060) value "DEBUG-ITEMDEBUG-LINEDEBUG-NAMEHIGH-V
  664.       -"ALUEPROGRAM-IDDESCENDING".
  665.         02 filler pic x(080) value "CONVERTINGEND-DELETEEND-RETURNEND-SE
  666.       -"ARCHEND-STRINGINITIALIZESTANDARD-2END-DIVIDE".
  667.        01 filler redefines r10tab.
  668.          02  r10entry pic x(10) occurs res-word-count-10.
  669.        01 r11tab.
  670.         02 filler pic x(088) value "CLOCK-UNITSDEBUG-SUB-1DEBUG-SUB-2DEB
  671.       -"UG-SUB-3DESTINATIONEND-OF-PAGEENVIRONMENTHIGH-VALUES".
  672.         02 filler pic x(033) value "SUB-QUEUE-1SUB-QUEUE-2SUB-QUEUE-3".
  673.         02 filler pic x(011) value "I-O-CONTROL".
  674.         02 filler pic x(055) value
  675.            "DAY-OF-WEEKEND-COMPUTEEND-PERFORMEND-RECEIVEEND-REWRITE".
  676.        01 filler redefines r11tab.
  677.          02  r11entry pic x(11) occurs res-word-count-11.
  678.        01 r12tab.
  679.         02 filler pic x(084) value "COMMAND-LINEDATE-WRITTENDECLARATIVES
  680.       -"FILE-CONTROLINPUT-OUTPUTINSTALLATIONORGANIZATION".
  681.         02 filler pic x(096) value "SYNCHRONIZEDLINE-COUNTERPAGE-COUNTER
  682.       -"ALPHANUMERICEND-EVALUATEEND-MULTIPLYEND-SUBTRACTEND-UNSTRING".
  683.        01 filler redefines r12tab.
  684.          02  r12entry pic x(12) occurs res-word-count-12.
  685.        01 r13tab.
  686.         02 filler pic x(078) value "COMMUNICATIONCOMPUTATIONALCONFIGURAT
  687.       -"IONCORRESPONDINGDATE-COMPILEDDECIMAL-POINT".
  688.         02 filler pic x(039) value "LOCKLOW-VALUESEGMENT-LIMITSPECIAL-NA
  689.       -"MES".
  690.        01 filler redefines r13tab.
  691.          02  r13entry pic x(13) occurs res-word-count-13.
  692.        01 r14tab.
  693.         02 filler pic x(084) value "DEBUG-CONTENTSIDENTIFICATIONLINAGE-C
  694.       -"OUNTERLOCKLOW-VALUESNUMERIC-EDITEDPACKED-DECIMAL".
  695.        01 filler redefines r14tab.
  696.          02  r14entry pic x(14) occurs res-word-count-14.
  697.        01 r15tab.
  698.         02 filler pic x(060) value "COMPUTATIONAL-3OBJECT-COMPUTERSOURCE
  699.       -"-COMPUTERWORKING-STORAGE".
  700.        01 filler redefines r15tab.
  701.          02  r15entry pic x(15) occurs res-word-count-15.
  702.        01 r16tab.
  703.         02 filler pic x(032) value "ALPHABETIC-LOWERALPHABETIC-UPPER".
  704.        01 filler redefines r16tab.
  705.          02  r16entry pic x(16) occurs res-word-count-16.
  706.        01 r19tab.
  707.         02 filler pic x(019) value "ALPHANUMERIC-EDITED".
  708.        01 filler redefines r19tab.
  709.          02  r19entry pic x(19) occurs res-word-count-19.
  710.  
  711.        01  ws-case-linkage.
  712.            03  ws-case-flags.
  713.                05  def-reserved-case       pic x.
  714.                05  def-sentence-case redefines def-reserved-case pic x.
  715.                05  def-data-name-case      pic x.
  716.                05  def-proc-case           pic x.
  717.            03  so-rec.
  718.                05  so-rec-chr             pic x occurs 80.
  719.  
  720.        linkage section.
  721.        01  case-linkage.
  722.            03  case-flags.
  723.                05  lnk-reserved-case       pic x.
  724.                05  lnk-data-name-case      pic x.
  725.                05  lnk-proc-case           pic x.
  726.            03  record-area             pic x(80).
  727.  
  728.        procedure division using case-linkage.
  729.        main-prog section.
  730.            move case-linkage to ws-case-linkage.
  731.            if ws-case-flags = spaces or so-rec = spaces
  732.                next sentence
  733.            else
  734.                perform case
  735.                move ws-case-linkage to case-linkage.
  736.            exit program.
  737.            stop run.
  738.  
  739.        case section.
  740.            move nay to perf-name-expected.
  741.            move nay to alt1-name-expected.
  742.            move nay to alt2-name-expected.
  743.            move nay to go-name-expected.
  744.            move nay to pic-name-expected.
  745.            move nay to literal.
  746.        case1.
  747.            move 8 to start-sub.
  748.            if so-rec-chr(7) = "*"
  749.               go to case-end.
  750.        case2.
  751.            if new-sentence-expected = 1
  752.                move 1 to start-of-sentence
  753.            else
  754.                move 0 to start-of-sentence.
  755.            perform next-word.
  756.            if start-sub > 72
  757.               go to case-end.
  758.            if literal = yes
  759.               move end-sub to start-sub
  760.               go to case2.
  761.            move start-sub to sub.
  762.            if reserved = yes
  763.               if def-reserved-case = "N"
  764.                  move end-sub to start-sub
  765.                  go to case2.
  766.            if pic-name-expected = yes
  767.               go to case3.
  768.            if reserved = nay
  769.               go to case4.
  770.        case3.
  771.            move res-len to editlen.
  772.            move sub to editstart.
  773.            if def-sentence-case = "S" or "s"
  774.                perform convert-to-sentence
  775.            else
  776.            if def-reserved-case = "F" or "f"
  777.                perform convert-to-first
  778.            else
  779.            if def-reserved-case = "U" or "u"
  780.                perform convert-to-upper
  781.            else
  782.            if def-reserved-case = "L" or "l"
  783.                perform convert-to-lower.
  784.            move end-sub to start-sub.
  785.            go to case2.
  786.        case4.
  787.            if start-sub = 8
  788.               go to case6.
  789.            if perf-name-expected = yes
  790.               go to case6.
  791.            if alt1-name-expected = yes
  792.               go to case6.
  793.            if alt2-name-expected = yes
  794.               go to case6.
  795.            if go-name-expected = yes
  796.               go to case6.
  797.            if def-data-name-case= "N"
  798.               move end-sub to start-sub
  799.               go to case2.
  800.        case5.
  801.            move res-len to editlen.
  802.            move sub to editstart.
  803.            if def-sentence-case = "S" or "s"
  804.                perform convert-to-sentence
  805.            else
  806.            if def-data-name-case = "F" or "f"
  807.                perform convert-to-first
  808.            else
  809.            if def-data-name-case= "U" or "u"
  810.                perform convert-to-upper
  811.            else
  812.            if def-data-name-case = "L" or "l"
  813.                perform convert-to-lower.
  814.            move end-sub to start-sub.
  815.            go to case2.
  816.        case6.
  817.            move nay to perf-name-expected.
  818.            move alt1-name-expected to alt2-name-expected.
  819.            move nay to alt1-name-expected.
  820.            if def-proc-case = "N"
  821.               move end-sub to start-sub
  822.               go to case2.
  823.        case7.
  824.            move res-len to editlen.
  825.            move sub to editstart.
  826.            if def-sentence-case = "S" or "s"
  827.                perform convert-to-sentence
  828.            else
  829.            if def-proc-case = "F" or "f"
  830.                perform convert-to-first
  831.            else
  832.            if def-proc-case = "U" or "u"
  833.                perform convert-to-upper
  834.            else
  835.            if def-proc-case = "L" or "l"
  836.                perform convert-to-lower.
  837.            move end-sub to start-sub.
  838.            go to case2.
  839.        case-end.
  840.            exit.
  841.        next-word section.
  842.        next-w1.
  843.            perform find-char.
  844.            if start-sub > 72
  845.               go to next-wend.
  846.            if char = quote
  847.               if literal = yes
  848.                  move nay to literal
  849.                  add 1 to start-sub
  850.                  go to next-w1
  851.               else
  852.                  move yes to literal
  853.                  add 1 to start-sub
  854.                  go to next-w1.
  855.            if char = "."
  856.               move 1 to new-sentence-expected
  857.               if literal = nay
  858.                  move nay to  perf-name-expected
  859.                                alt1-name-expected
  860.                                alt2-name-expected
  861.                                go-name-expected
  862.                                pic-name-expected
  863.                  add 1 to start-sub
  864.                  go to next-w1
  865.               else
  866.                  add 1 to start-sub
  867.                  go to next-w1.
  868.            if literal = yes
  869.                add 1 to start-sub
  870.                go to next-w1.
  871.            move start-sub to end-sub.
  872.            move 1 to res-sub.
  873.            move spaces to res-word-buffer.
  874.        next-w2.
  875.            move char to res-word-buffer-char(res-sub).
  876.            add 1 to end-sub.
  877.            add 1 to res-sub.
  878.            if end-sub > 72
  879.               go to next-w3.
  880.            move so-rec-chr(end-sub) to char.
  881.            if char = space
  882.               go to next-w3
  883.            else if char = "."
  884.               move 1 to new-sentence-expected
  885.               go to next-w3.
  886.            go to next-w2.
  887.        next-w3.
  888.            perform reserved-or-not.
  889.        next-wend.
  890.            exit.
  891.        reserved-or-not section.
  892.        reserv1.
  893.            move 65 to editlen.
  894.            move 1 to editstart.
  895.            perform convert-resv-to-upper.
  896.            move nay to reserved.
  897.            move res-sub to res-len.
  898.            subtract 1 from res-len.
  899.            if res-sub < 3 or res-sub > 20
  900.               go to r20.
  901.            subtract 2 from res-sub.
  902.            go to r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15
  903.                    r16 r20 r20 r19
  904.               depending on res-sub.
  905.        r2.
  906.            move 0 to res-sub.
  907.        r2a.
  908.            add 1 to res-sub.
  909.            if res-sub > res-word-count-2 go to r20.
  910.            if res02 = r2entry(res-sub)
  911.               move yes to reserved
  912.               go to r20.
  913.            go to r2a.
  914.        r3.
  915.            move 0 to res-sub.
  916.        r3a.
  917.            add 1 to res-sub.
  918.            if res-sub > res-word-count-3 go to r20.
  919.            if res03 = r3entry(res-sub)
  920.               move yes to reserved
  921.               go to r20.
  922.            go to r3a.
  923.        r4.
  924.            move 0 to res-sub.
  925.        r4a.
  926.            add 1 to res-sub.
  927.            if res-sub > res-word-count-4 go to r20.
  928.            if res04 = r4entry(res-sub)
  929.               move yes to reserved
  930.               go to r20.
  931.            go to r4a.
  932.        r5.
  933.            move 0 to res-sub.
  934.        r5a.
  935.            add 1 to res-sub.
  936.            if res-sub > res-word-count-5 go to r20.
  937.            if res05 = r5entry(res-sub)
  938.               move yes to reserved
  939.               go to r20.
  940.            go to r5a.
  941.        r6.
  942.            move 0 to res-sub.
  943.        r6a.
  944.            add 1 to res-sub.
  945.            if res-sub > res-word-count-6 go to r20.
  946.            if res06 = r6entry(res-sub)
  947.               move yes to reserved
  948.               go to r20.
  949.            go to r6a.
  950.        r7.
  951.            move 0 to res-sub.
  952.        r7a.
  953.            add 1 to res-sub.
  954.            if res-sub > res-word-count-7 go to r20.
  955.            if res07 = r7entry(res-sub)
  956.               move yes to reserved
  957.               go to r20.
  958.            go to r7a.
  959.        r8.
  960.            move 0 to res-sub.
  961.        r8a.
  962.            add 1 to res-sub.
  963.            if res-sub > res-word-count-8 go to r20.
  964.            if res08 = r8entry(res-sub)
  965.               move yes to reserved
  966.               go to r20.
  967.            go to r8a.
  968.        r9.
  969.            move 0 to res-sub.
  970.        r9a.
  971.            add 1 to res-sub.
  972.            if res-sub > res-word-count-9 go to r20.
  973.            if res09 = r9entry(res-sub)
  974.               move yes to reserved
  975.               go to r20.
  976.            go to r9a.
  977.        r10.
  978.            move 0 to res-sub.
  979.        r10a.
  980.            add 1 to res-sub.
  981.            if res-sub > res-word-count-10 go to r20.
  982.            if res10 = r10entry(res-sub)
  983.               move yes to reserved
  984.               go to r20.
  985.            go to r10a.
  986.        r11.
  987.            move 0 to res-sub.
  988.        r11a.
  989.            add 1 to res-sub.
  990.            if res-sub > res-word-count-11 go to r20.
  991.            if res11 = r11entry(res-sub)
  992.               move yes to reserved
  993.               go to r20.
  994.            go to r11a.
  995.        r12.
  996.            move 0 to res-sub.
  997.        r12a.
  998.            add 1 to res-sub.
  999.            if res-sub > res-word-count-12 go to r20.
  1000.            if res12 = r12entry(res-sub)
  1001.               move yes to reserved
  1002.               go to r20.
  1003.            go to r12a.
  1004.        r13.
  1005.            move 0 to res-sub.
  1006.        r13a.
  1007.            add 1 to res-sub.
  1008.            if res-sub > res-word-count-13 go to r20.
  1009.            if res13 = r13entry(res-sub)
  1010.               move yes to reserved
  1011.               go to r20.
  1012.            go to r13a.
  1013.        r14.
  1014.            move 0 to res-sub.
  1015.        r14a.
  1016.            add 1 to res-sub.
  1017.            if res-sub > res-word-count-14 go to r20.
  1018.            if res14 = r14entry(res-sub)
  1019.               move yes to reserved
  1020.               go to r20.
  1021.            go to r14a.
  1022.        r15.
  1023.            move 0 to res-sub.
  1024.        r15a.
  1025.            add 1 to res-sub.
  1026.            if res-sub > res-word-count-15 go to r20.
  1027.            if res15 = r15entry(res-sub)
  1028.               move yes to reserved
  1029.               go to r20.
  1030.            go to r15a.
  1031.        r16.
  1032.            move 0 to res-sub.
  1033.        r16a.
  1034.            add 1 to res-sub.
  1035.            if res-sub > res-word-count-16 go to r20.
  1036.            if res16 = r16entry(res-sub)
  1037.               move yes to reserved
  1038.               go to r20.
  1039.            go to r16a.
  1040.        r19.
  1041.            move 0 to res-sub.
  1042.        r19a.
  1043.            add 1 to res-sub.
  1044.            if res-sub > res-word-count-19 go to r20.
  1045.            if res19 = r19entry(res-sub)
  1046.               move yes to reserved
  1047.               go to r20.
  1048.            go to r19a.
  1049.        r20.
  1050.            if reserved = nay go to reserv-end.
  1051.            if res-word-buffer not = "TO"
  1052.               move nay to go-name-expected.
  1053.            if res-word-buffer = "PIC" or "PICTURE" or "VALUE"
  1054.               move yes to pic-name-expected
  1055.               go to reserv-end
  1056.            else
  1057.               move nay to pic-name-expected.
  1058.            if res-word-buffer = "PERFORM" or "THRU" or "THROUGH"
  1059.               move yes to perf-name-expected
  1060.               go to reserv-end.
  1061.            if res-word-buffer = "ALTER"
  1062.               move yes to alt1-name-expected
  1063.               go to reserv-end.
  1064.            if res-word-buffer = "GO"
  1065.               move yes to go-name-expected
  1066.               go to reserv-end.
  1067.        reserv-end.
  1068.            exit.
  1069.        convert-to-upper section.
  1070.            move editstart to ind-1.
  1071.            move 1 to ind-2.
  1072.        convert-to-upper-loop.
  1073.            move so-rec-chr(ind-1) to temp-char
  1074.            if temp-char-9 < 123 and temp-char-9 > 96
  1075.                subtract 32 from temp-char-9
  1076.                move temp-char to so-rec-chr(ind-1).
  1077.            add 1 to ind-1
  1078.            add 1 to ind-2.
  1079.            if ind-2 not > editlen
  1080.                go to convert-to-upper-loop.
  1081.  
  1082.        convert-to-sentence section.
  1083.            move editstart to ind-1.
  1084.            move 1 to ind-2.
  1085.        convert-to-sentence-loop.
  1086.            move so-rec-chr(ind-1) to temp-char.
  1087.            if start-of-sentence = 1
  1088.                if temp-char-9 < 123 and temp-char-9 > 96
  1089.                    subtract 32 from temp-char-9
  1090.                    move temp-char to so-rec-chr(ind-1)
  1091.                    move 0 to new-sentence-expected
  1092.                    move 0 to start-of-sentence
  1093.                else
  1094.                    if temp-char-9 < 91 and temp-char-9 > 64
  1095.                        move 0 to new-sentence-expected
  1096.                        move 0 to start-of-sentence
  1097.                    else
  1098.                        next sentence
  1099.            else
  1100.                if temp-char-9 < 91 and temp-char-9 > 64
  1101.                    add 32 to temp-char-9
  1102.                    move temp-char to so-rec-chr(ind-1).
  1103.            add 1 to ind-1
  1104.            add 1 to ind-2.
  1105.            if ind-2 not > editlen
  1106.                go to convert-to-sentence-loop.
  1107.  
  1108.  
  1109.        convert-to-first section.
  1110.            move editstart to ind-1.
  1111.            move 1 to ind-2.
  1112.        convert-to-first-loop.
  1113.            move so-rec-chr(ind-1) to temp-char.
  1114.            move so-rec-chr(ind-1 - 1) to prev-char
  1115.            if prev-char-separator
  1116.                if temp-char-9 < 123 and temp-char-9 > 96
  1117.                    subtract 32 from temp-char-9
  1118.                    move temp-char to so-rec-chr(ind-1)
  1119.                else
  1120.                    next sentence
  1121.            else
  1122.                if temp-char-9 < 91 and temp-char-9 > 64
  1123.                    add 32 to temp-char-9
  1124.                    move temp-char to so-rec-chr(ind-1).
  1125.            add 1 to ind-1
  1126.            add 1 to ind-2.
  1127.            if ind-2 not > editlen
  1128.                go to convert-to-first-loop.
  1129.  
  1130.        convert-to-lower section.
  1131.            move editstart to ind-1.
  1132.            move 1 to ind-2.
  1133.        convert-to-lower-loop.
  1134.            move so-rec-chr(ind-1) to temp-char
  1135.            if temp-char-9 < 91 and temp-char-9 > 64
  1136.                add 32 to temp-char-9
  1137.                move temp-char to so-rec-chr(ind-1).
  1138.            add 1 to ind-1
  1139.            add 1 to ind-2.
  1140.            if ind-2 not > editlen
  1141.                go to convert-to-lower-loop.
  1142.  
  1143.        convert-resv-to-upper section.
  1144.            move editstart to ind-1.
  1145.            move 1 to ind-2.
  1146.        convert-resv-to-upper-loop.
  1147.            move res-word-buffer-char(ind-1) to temp-char
  1148.            if temp-char-9 < 123 and temp-char-9 > 96
  1149.                subtract 32 from temp-char-9
  1150.                move temp-char to res-word-buffer-char(ind-1).
  1151.            add 1 to ind-1
  1152.            add 1 to ind-2.
  1153.            if ind-2 not > editlen
  1154.                go to convert-resv-to-upper-loop.
  1155.  
  1156.        find-char section.
  1157.            if start-sub < 73
  1158.                if so-rec-chr(start-sub) = space
  1159.                    add 1 to start-sub
  1160.                    go to find-char
  1161.                else
  1162.                    move so-rec-chr(start-sub) to char
  1163.            else
  1164.                move space to char.
  1165.  
  1166.        end program caseconv.
  1167.