       IDENTIFICATION DIVISION.
       PROGRAM-ID.   RMPTCH.
      *                  Ver. 2.0B2
      *              Date Revised   10 July 1984
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  RMCOBOL.
       OBJECT-COMPUTER.  RMCOBOL.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT COMMAND-FILE ASSIGN TO RANDOM DATA-FILE-NAME
           ORGANIZATION IS SEQUENTIAL
           FILE STATUS IS FILE-STATUS. 
       DATA DIVISION.
       FILE SECTION.
       FD  COMMAND-FILE.
       01  COMMAND-REC.
           03  CHAR                    PIC X       OCCURS 78 TIMES.
       WORKING-STORAGE SECTION.
       01  FILE-NAME                   PIC X(74)   VALUE SPACES.
       01  TEMP-DATA REDEFINES FILE-NAME.
           03  TEMP-CHAR               PIC X       OCCURS 74 TIMES.
       01  FILE-NAME-SAVE              PIC X(74).
       01  PATCH-DATA.
           03  PATCH-WORD    COMP-1    PIC 9(5)    OCCURS 64 TIMES.
       77  ADDR                        PIC 9(10).
       77  LNGTH                       PIC 999.
       77  RTN                         PIC 9.
       77  ADDR-L                      PIC 9(10).
       77  COMP-WORD         COMP-1    PIC 9(5).
       01  COMP-BYTES REDEFINES COMP-WORD.
           03  COMP1                   PIC X.
           03  COMP2                   PIC X.
       01  CNT.
           03  CNT-DIGIT               PIC 9       OCCURS 10 TIMES.
       77  WORK-WORD                   PIC S9(5).
       77  R-WORD                      PIC S9(5).
       77  C                           PIC 99.
       77  D                           PIC 9(9).
       77  I                           PIC 999.
       77  H                           PIC 9.
       77  J                           PIC 999.
       77  K                           PIC S9(4).
       77  L                           PIC 9(8).
       77  N                           PIC 99.
       77  P                           PIC 99.
       77  R                           PIC S9(10).
       77  R-SAVE                      PIC 9(10).
       77  U                           PIC X.
       77  UC-IND                      PIC 9.
       77  S                           PIC 9.
       77  FILE-STATUS                 PIC XX.
       77  STATUS-IND                  PIC 9.
       77  DATA-FILE-NAME              PIC X(74).
       77  DSKINPUT-FLG                PIC 9.
       77  END-FLG                     PIC 9.
      /
       01  POS-VALUES.
           03  FILLER              PIC 9(16)
                   VALUE 4096025600160001.
       01  POS-VALUE-TABLE REDEFINES POS-VALUES.
           03  POS-VALUE           PIC 9(4)      OCCURS 4 TIMES.
       01  HEX-VALUES.
           03  FILLER              PIC X(16)
                   VALUE "0123456789ABCDEF".
       01  HEX-VALUE-TABLE REDEFINES HEX-VALUES.
           03  HEX-VALUE           PIC X         OCCURS 16 TIMES.
       01  LINE-FOR-DISP.
           02  LINE-ADDR.
               03  LINE-ADDR-HEX1  PIC X(2).
               03  LINE-ADDR-HEX2  PIC X(2).
               03  LINE-ADDR-HEX3  PIC X(2).
               03  FILLER          PIC X.
           02  LINE-DISP.
               03  LINE-DIGIT      PIC X         OCCURS 72 TIMES.
           02  LINE-DISP-R  REDEFINES LINE-DISP.
               03  FILLER          PIC X.
               03  FILLER          PIC XXX.
               03  LINE-ADDR-HEX1  PIC X(2).
               03  FILLER          PIC X.
               03  LINE-ADDR-HEX2  PIC X(2).
               03  FILLER          PIC X.
               03  LINE-ADDR-HEX3  PIC X(2).
               03  FILLER          PIC X(60).
       01  ASCII-VALUES.
           03  FILLER              PIC X(48)     VALUE
           "................................ !""#$%&'()*+,-./".
           03  FILLER              PIC X(49)     VALUE
           "0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)^_`".
           03  FILLER              PIC X(49)     VALUE
           "abcdefghijklmnopqrstuvwxyz{|}~...................".
           03  FILLER              PIC X(49)     VALUE 
           ".................................................".
           03  FILLER              PIC X(49)     VALUE
           ".................................................".
           03  FILLER              PIC X(12)     VALUE
           "............".
       01  ASCII-VALUE-TABLE REDEFINES ASCII-VALUES.
           03  ASCII-VALUE         PIC X         OCCURS 256 TIMES.
      *
       PROCEDURE DIVISION.
       MAIN-LINE.
           PERFORM TITLE.
           PERFORM INIT-PARA.
           PERFORM INPUT-COMMAND THRU INPUT-COMMAND-EXIT 
                   UNTIL END-FLG = 1.
           STOP RUN.
      /
       INPUT-COMMAND.
           IF DSKINPUT-FLG = 0
               MOVE SPACES TO COMMAND-REC
               DISPLAY "\" POSITION 1 
               ACCEPT COMMAND-REC POSITION 0 TAB
               GO TO COMMAND-PARA.
      *
      *   Disk input file (activated by "I" command)
      *
           MOVE SPACES TO COMMAND-REC   MOVE 0 TO STATUS-IND.
           READ COMMAND-FILE 
                AT END MOVE 0 TO DSKINPUT-FLG
                       CLOSE COMMAND-FILE
                       GO TO INPUT-COMMAND.
           DISPLAY "\" POSITION 1 COMMAND-REC.
       COMMAND-PARA.
           PERFORM CNV-TO-UC THRU CNV-EXIT.
           IF CHAR (1) = "F" PERFORM FILE-NAME-PARA
             ELSE IF CHAR (1) = "D" PERFORM DUMP-PARA
               ELSE IF CHAR (1) = "V" PERFORM VERIFY-PARA
                 ELSE IF CHAR (1) = "R" PERFORM REPLACE-PARA
                   ELSE IF CHAR (1) = "E" PERFORM END-PARA
                     ELSE IF CHAR (1) = "H" PERFORM HELP-PARA
                       ELSE IF CHAR (1) = "*" NEXT SENTENCE
                         ELSE IF CHAR (1) = "I" PERFORM DISK-IN-PARA
                           ELSE PERFORM COMMAND-ERROR.
       INPUT-COMMAND-EXIT.
           EXIT.
       FILE-NAME-PARA.
           PERFORM FILE-NAME-MOVE.
           IF RTN = 0 
                MOVE SPACES TO FILE-NAME   PERFORM FILE-ERROR.
       DISK-IN-PARA.
           IF DSKINPUT-FLG = 1 PERFORM ABORT-COMMAND.
           MOVE FILE-NAME TO FILE-NAME-SAVE.
           PERFORM FILE-NAME-MOVE   .
           MOVE FILE-NAME TO DATA-FILE-NAME.
           MOVE FILE-NAME-SAVE TO FILE-NAME  
           IF RTN = 0 PERFORM FILE-ERROR.
           OPEN INPUT COMMAND-FILE   MOVE 1 TO DSKINPUT-FLG.
       FILE-NAME-MOVE.
           MOVE 1 TO I   PERFORM SCAN-SPACES.
           MOVE 0 TO J   PERFORM TEMP-MOVE 74 TIMES.
           IF FILE-NAME = DATA-FILE-NAME AND DSKINPUT-FLG = 1
               MOVE SPACES TO FILE-NAME   PERFORM BAD-FILENAME.
           MOVE 0 TO LNGTH   MOVE 0 TO ADDR.
           PERFORM CALL-PARA.
       TEMP-MOVE.
           ADD 1 TO I   ADD 1 TO J   MOVE CHAR (I) TO TEMP-CHAR (J).
      *
       END-PARA.
           IF DSKINPUT-FLG = 1 
               CLOSE COMMAND-FILE.
           MOVE 1 TO END-FLG.
      /
       DUMP-PARA.
           PERFORM NAME-CHECK
           PERFORM GET-ADDR.
           IF CHAR (I) NOT = " " 
               PERFORM GET-CNT 
             ELSE MOVE 0 TO D
               DIVIDE ADDR BY 16 GIVING R-SAVE REMAINDER P.
           PERFORM GET-J   DIVIDE J BY 16 GIVING I REMAINDER C.
           MULTIPLY 8 BY I.
           MOVE 0 TO LNGTH.
           PERFORM CALL-PARA THRU CALL-CHECK.
           PERFORM FIRST-DISP
           PERFORM DISP-PARA D TIMES.
           IF P NOT = 0
               SUBTRACT P FROM 16 GIVING C 
               PERFORM LAST-DISP.
       VERIFY-PARA.
           PERFORM NAME-CHECK
           PERFORM GET-ADDR
           PERFORM CHAR-CHECK.
           MOVE 0 TO LNGTH.
           PERFORM CALL-PARA THRU CALL-CHECK.
           SUBTRACT 1 FROM I GIVING P
           PERFORM GET-J.
           DIVIDE J BY 2 GIVING I REMAINDER S   MOVE 1 TO L.
           IF S = 1 
               PERFORM HEX-WORD 
               MOVE 4 TO C
               PERFORM WORD-COMPARE
             ELSE MOVE 1 TO C.
           PERFORM STRING-COMPARE UNTIL P > 75.
       REPLACE-PARA.
           PERFORM NAME-CHECK
           PERFORM GET-ADDR
           PERFORM CHAR-CHECK.
           MOVE 0 TO  N  MOVE 0 TO K   SUBTRACT 1 FROM I.
           PERFORM REPLACE-MAIN-LOOP UNTIL I > 75.
           PERFORM PATCH-PARA.
       PATCH-PARA.
           COMPUTE LNGTH = N / 2.
           PERFORM CALL-PARA THRU CALL-CHECK.
      *
       CALL-PARA.
           MOVE 0 TO RTN   CALL "RMPSUB.COB"
               USING FILE-NAME PATCH-DATA LNGTH ADDR RTN.
       CALL-CHECK.
           IF RTN = 0 PERFORM PATCH-ERROR.
      /
       FIRST-DISP.
           MOVE ADDR TO ADDR-L.
           PERFORM LINE-PARA   MOVE 1 TO J.
           PERFORM DOT-HEX C TIMES   MOVE 55 TO J.
           PERFORM DOT-ASCII C TIMES
           DISPLAY LINE-FOR-DISP POSITION 1.
       LAST-DISP.
           PERFORM LINE-PARA   MULTIPLY P BY 3 GIVING J.
           ADD 1 TO J   PERFORM DOT-HEX C TIMES   ADD 55 P GIVING J.
           PERFORM DOT-ASCII C TIMES
           DISPLAY LINE-FOR-DISP POSITION 1.
       DISP-PARA.
           PERFORM LINE-PARA
           DISPLAY LINE-FOR-DISP POSITION 1.
       LINE-PARA.
           PERFORM GET-LINE-ADDR.
           MOVE SPACES TO LINE-DISP
           MOVE QUOTE TO LINE-DIGIT (55).
           MOVE QUOTE TO LINE-DIGIT (72).
           MOVE 1 TO L.
           PERFORM HEX-WORD 8 TIMES   SUBTRACT 8 FROM I.
           MOVE 55 TO L
           PERFORM ASCII-DISPLAY 8 TIMES.
       HEX-WORD.
           PERFORM GET-WORK-WORD   MOVE 0 TO J.
           PERFORM HEX-BYTE 2 TIMES.
       HEX-BYTE.
           PERFORM HEX-CONVERT 2 TIMES   ADD 1 TO L.
       HEX-CONVERT.
           ADD 1 TO J   ADD 1 TO L.
           DIVIDE WORK-WORD BY POS-VALUE (J) GIVING K REMAINDER R.
           MOVE R TO WORK-WORD   ADD 1 TO K.
           MOVE HEX-VALUE (K) TO LINE-DIGIT (L).
       GET-LINE-ADDR.
           DIVIDE ADDR-L BY 65536 GIVING WORK-WORD REMAINDER R-WORD.
           MOVE 1 TO L   MOVE 0 TO J.
           PERFORM HEX-BYTE 2 TIMES.
           MOVE 0 TO J.
           MOVE R-WORD TO WORK-WORD.
           PERFORM HEX-BYTE 2 TIMES.
           MOVE CORRESPONDING LINE-DISP-R TO LINE-ADDR.
           COMPUTE L = ((ADDR-L / 16) + 1).
           COMPUTE ADDR-L = 16 * L.
      *
       GET-ADDR.
           MOVE 1 TO I   PERFORM SCAN-SPACES.
           MOVE 0 TO P   MOVE 0 TO N.
           PERFORM FND-END UNTIL P = 1.
           IF N = 0 OR N > 8 PERFORM COMMAND-ERROR.
           IF N > 4 PERFORM GET-LONG ELSE PERFORM GET-SHORT.
           ADD 1 TO I   PERFORM SCAN-DELIM.
       GET-LONG.
           SUBTRACT 4 FROM N   COMPUTE J = 4 - N 
           MOVE 1 TO I   PERFORM SCAN-SPACES.
           PERFORM GET-R   MULTIPLY 65536 BY R GIVING ADDR.
           MOVE 4 TO N   MOVE 0 TO J   PERFORM GET-R   ADD R TO ADDR.
       GET-SHORT.
           COMPUTE J = 4 - N   MOVE 1 TO I   PERFORM SCAN-SPACES.
           PERFORM GET-R.
           MOVE R TO ADDR.
      *
       GET-CNT.
           SUBTRACT 1 FROM I   MOVE 0 TO P   MOVE 0 TO N.
           PERFORM FND-END UNTIL P = 1.
           IF N > 10 PERFORM COMMAND-ERROR.
           SUBTRACT N FROM I.
           SUBTRACT N FROM 11 GIVING J
           MOVE ZEROES TO CNT.
           PERFORM CNT-MV N TIMES   MOVE CNT TO R.
           IF R < 16 MOVE 16 TO R.   ADD ADDR TO R.
           DIVIDE R BY 16 GIVING R-SAVE REMAINDER P.
           SUBTRACT ADDR P FROM R
           COMPUTE D ROUNDED = (R - 9) / 17.
       GET-R.
           MOVE LOW-VALUE TO COMP1   MOVE 0 TO R.
           PERFORM ADDR-CONVERT N TIMES.
       GET-J.
           DIVIDE ADDR BY 128 GIVING L REMAINDER J.
       DOT-HEX.
           PERFORM DOT-ASCII 2 TIMES   ADD 1 TO J.
       DOT-ASCII.
           ADD 1 TO J   MOVE "." TO LINE-DIGIT (J).
       FND-END.
           ADD 1 TO I   ADD 1 TO N.
           IF CHAR (I) = " " OR CHAR (I) = ","
               SUBTRACT 1 FROM N   MOVE 1 TO P.
      *
      *
      *
       SCAN-SPACES.
      *               Note - leaves pointer -1 from arg
           IF I < 77
               ADD 1 TO I
               IF CHAR (I) = " "
                   GO TO SCAN-SPACES
                 ELSE SUBTRACT 1 FROM I.
      *
       SCAN-SPACES-P.
      *               Note - leaves pointer -1 from arg
           IF P < 77
               ADD 1 TO P
               IF CHAR (P) = " "
                   GO TO SCAN-SPACES-P
                 ELSE SUBTRACT 1 FROM P.
      *
       SCAN-DELIM.
      *               Note - leaves pointer on arg
           IF I < 77
               ADD 1 TO I
               IF CHAR (I) = " " OR CHAR (I) = ","
                   GO TO SCAN-DELIM.
      *
       CNT-MV.
           MOVE CHAR (I) TO CNT-DIGIT (J)   ADD 1 TO I   ADD 1 TO J.
      *
       ADDR-CONVERT.
           ADD 1 TO I   PERFORM ASCII-CONVERT.
       ASCII-CONVERT.
           ADD 1 TO J   MOVE CHAR (I) TO COMP2.
           IF COMP-WORD > 57 AND COMP-WORD < 65 PERFORM COMMAND-ERROR.
           IF COMP-WORD > 70 PERFORM COMMAND-ERROR.
           IF COMP-WORD > 64 SUBTRACT 55 FROM COMP-WORD
               ELSE SUBTRACT 48 FROM COMP-WORD.
           MOVE COMP-WORD TO WORK-WORD.
           MULTIPLY POS-VALUE (J) BY WORK-WORD   ADD WORK-WORD TO R.
      *
       ASCII-DISPLAY.
           PERFORM GET-WORK-WORD.
           DIVIDE WORK-WORD BY 256 GIVING K REMAINDER R.
           ADD 1 TO K   ADD 1 TO R   ADD 1 TO L.
           MOVE ASCII-VALUE (K) TO LINE-DIGIT (L)   ADD 1 TO L.
           MOVE ASCII-VALUE (R) TO LINE-DIGIT (L).
       GET-WORK-WORD.
           ADD 1 TO I   IF I = 65   ADD 128 TO ADDR
               PERFORM CALL-PARA THRU CALL-CHECK   MOVE 1 TO I.
           MOVE PATCH-WORD (I) TO WORK-WORD.
           IF WORK-WORD < 0 ADD 65536 TO WORK-WORD.
      *
      *
      *
      *
       STRING-COMPARE.
           PERFORM HEX-WORD   PERFORM WORD-COMPARE 2 TIMES.
       WORD-COMPARE.
           IF P < 77
               PERFORM CHAR-COMPARE 2 TIMES   ADD 1 TO C
               ADD 1 TO P   PERFORM SCAN-SPACES-P.
       CHAR-COMPARE.
               ADD 1 TO C   ADD 1 TO P.
           IF CHAR (P) NOT = " " 
               IF LINE-DIGIT (C) NOT = CHAR (P) PERFORM NO-MATCH.
      *
       REPLACE-MAIN-LOOP.
           MOVE 0 TO J   MOVE 0 TO R   ADD 1 TO K   MOVE 0 TO H.
           MOVE LOW-VALUE TO COMP1 PERFORM REPLACE-SUB-LOOP 2 TIMES.
           PERFORM MOVE-R.
       REPLACE-SUB-LOOP.
           IF I < 77
               PERFORM REPLACE-CONVERT 2 TIMES
               ADD 1 TO I
               PERFORM SCAN-SPACES.
       REPLACE-CONVERT.
           ADD 1 TO I.
           IF CHAR (I) = " " 
               PERFORM SHIFT-CHECK
             ELSE ADD 1 TO H   ADD 1 TO N
               PERFORM ASCII-CONVERT.
       SHIFT-CHECK.
           IF H = 1 OR H = 3
                SUBTRACT WORK-WORD FROM R
                SUBTRACT 1 FROM I
                ADD 1 TO H   ADD 1 TO N
                PERFORM ASCII-CONVERT.
       MOVE-R.
           IF R > 32767 SUBTRACT 65536 FROM R.
           MOVE R TO PATCH-WORD (K).
      /
       CHAR-CHECK.
           IF CHAR (I) = " " PERFORM COMMAND-ERROR.
       NAME-CHECK.
           IF FILE-NAME = SPACES 
               DISPLAY " Filename hasn't been specified" POSITION 1
               GO TO CONDITIONAL-RETURN.
      *
       COMMAND-ERROR.
           DISPLAY " Command Error!   " POSITION 1.
           PERFORM ERROR-PARA.
       FILE-ERROR.
           DISPLAY " File not found   " POSITION 1.
           PERFORM ERROR-PARA.
       PATCH-ERROR.
           DISPLAY " Patch File Error!" POSITION 1.
           PERFORM ERROR-PARA.
       ERROR-PARA.
           DISPLAY "Hit any key to return to command line" POSITION 0.
           ACCEPT CHAR (1) POSITION 0
           GO TO CONDITIONAL-RETURN.
       CONDITIONAL-RETURN.
           IF DSKINPUT-FLG = 1  
               MOVE 0 TO DSKINPUT-FLG
               CLOSE COMMAND-FILE.
           GO TO INPUT-COMMAND.
       NO-MATCH.
           DISPLAY " Values do not match" POSITION 1.
           GO TO CONDITIONAL-RETURN.
       ABORT-COMMAND.
           DISPLAY " Already reading a file" POSITION 1.
           PERFORM CONSOLE-RTN.
       BAD-FILENAME.
           DISPLAY " Command file can't be patched" POSITION 1.
           PERFORM CONSOLE-RTN.
       CONSOLE-RTN.
           DISPLAY " - control returned to console" POSITION 0.
           GO TO CONDITIONAL-RETURN.
      *
      /
       TITLE.
           DISPLAY "RM/COBOL Patch Utility (Ver. 2.0B)" ERASE
               SPACE POSITION 1.
       INIT-PARA.
           MOVE 0 TO STATUS-IND   MOVE 0 TO DSKINPUT-FLG, END-FLG.
           DISPLAY "Do you want filenames converted to uppercase ?"
               LINE 3 POSITION 10 ERASE EOS
               "(Necessary for CP/M and CP/M-86 type O.S.'s)"
               POSITION 14   ACCEPT U LINE 3 POSITION 58 TAB.
           IF U = "Y" OR U = "y" MOVE 1 TO UC-IND
             ELSE IF U = "N" OR U =  "n" MOVE 0 TO UC-IND
               ELSE DISPLAY "Must answer Y or N" LINE 23 POSITION 40
                   "Hit any key to try again" POSITION 40
                   ACCEPT U POSITION 0   GO TO INIT-PARA.
           DISPLAY " " LINE 5.
       CNV-TO-UC.
           MOVE 0 TO I   MOVE LOW-VALUE TO COMP1.
           PERFORM CASE-CNV-PARA 78 TIMES.
       CNV-EXIT.
           EXIT.
       CASE-CNV-PARA.
           ADD 1 TO I   MOVE CHAR (I) TO COMP2.
           IF COMP-WORD > 96 AND COMP-WORD < 123
               SUBTRACT 32 FROM COMP-WORD   MOVE COMP2 TO CHAR (I).
           IF UC-IND = 0
               IF CHAR (1) = "F" OR CHAR (1) = "I" GO TO CNV-EXIT.
       HELP-PARA.
           DISPLAY "Help Command (Ver. 2.0)" ERASE
               "Commands for this utility are one "
                   LINE 3 POSITION 10
               "character long and they must"
               "be entered immediately after the " POSITION 1
               "prompt character (\). All offsets and"
               "values must be hexadecimal in " POSITION 1
               "format. All dump lengths must be decimal."
               "All entries must be separated " POSITION 1
               "by one space. The commands are:"
               "1) Filename Command          " LINE 8 POSITION 1
               "Format:  F filename"
               "The filename command accepts the " POSITION 10
               "name of the file to be patched."
               "The name can be up to 74 characters in length."
                   POSITION 1
               "Example:    F B:RUNCOBOL.COM" LINE 12 POSITION 10
               "2) Dump Command              " LINE 14 POSITION 1
               "Format:  D offset [length]"
               "The dump command displays portions " POSITION 10
               "of the patch file on the console."
               "Display lines for the dump command " POSITION 1
               "begin on 16-byte boundaries. Offset"
               "specifies the start offset. Length," POSITION 1
               " when specified, indicates the length"
               "of the dump. When length is not " POSITION 1
               "specified sixteen bytes (one line)"
               "will be displayed." POSITION 1
               "Example:    D 1620 80" LINE 21 POSITION 10
               "Hit any key to continue" LINE 23 POSITION 50.
           ACCEPT TEMP-CHAR (1) POSITION 0.
           DISPLAY "3) Replace Command           " ERASE
               "Format:  R offset value [value] ..."
               "The replace command changes the " POSITION 10
               "contents of a portion of the patch"
               "program. Offset specifies the first " POSITION 1
               "offset to be changed. When more than"
               "one value is specified, the values " POSITION 1
               "replace the contents of the offsets"
               "immediately following offset." POSITION 1
               "Example:    R 5A21FA 0F 44 88 01" LINE 7 POSITION 10
               "4) Verify Command            " LINE 9 POSITION 1
               "Format:  V offset value [value] ..."
               "The verify command checks the " POSITION 10
               "currrent contents of offsets."
               "This command is similar to the replace " POSITION 1
               "command, except that the values are"
               "used for verification, not replacement." POSITION 1
               "Example:    V 1A90 BE OD OA 33" LINE 14 POSITION 10
               "5) End Command               " LINE 16 POSITION 1
               "Format:  E"
               "The end command terminates the " POSITION 10
               "patch program."
               "6) Help Command              " LINE 19 POSITION 1
               "Format:  H"
               "The help command displays this " POSITION 10
               "message. Additional information"
               "can be found in the RM/COBOL Patch " POSITION 1
               "Utility Documentation."
               "Hit any key to return to command line"
                   LINE 24 POSITION 39.
           ACCEPT TEMP-CHAR (1) POSITION 0.
           PERFORM TITLE.
       END PROGRAM.
