Commits

Anonymous committed 84b8242

Adding COBOL example using the Gary Cutler compiler control program

Comments (0)

Files changed (1)

tests/examplefiles/example.cob

+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. OCic.
+      *****************************************************************
+      ** This program provides a Textual User Interface (TUI) to the **
+      ** process of compiling and (optionally) executing an OpenCOBOL**
+      ** program.                                                    **
+      **                                                             **
+      ** This programs execution syntax is as follows:               **
+      **                                                             **
+      ** ocic <program-path-and-filename> [ <switch>... ]            **
+      **                                                             **
+      ** Once executed, a display screen will be presented showing   **
+      ** the compilation options that will be used.  The user will   **
+      ** have the opportunity to change options, specify new ones    **
+      ** and specify any program execution arguments to be used if   **
+      ** you select the "Execute" option.  When you press the Enter  **
+      ** key the program will be compiled.                           **
+      **                                                             **
+      ** The SCREEN SECTION contains an image of the screen.         **
+      **                                                             **
+      ** The "010-Parse-Args" section in the PROCEDURE DIVISION has  **
+      ** documentation on switches and their function.               **
+      *****************************************************************
+      **                                                             **
+      ** AUTHOR:       GARY L. CUTLER                                **
+      **               CutlerGL@gmail.com                            **
+      **               Copyright (C) 2009-2010, Gary L. Cutler, GPL  **
+      **                                                             **
+      ** DATE-WRITTEN: June 14, 2009                                 **
+      **                                                             **
+      *****************************************************************
+      ** Note: Depending on which extended DISPLAY handler you're    **
+      **       using (PDCurses, Curses, ...), you may need to un-    **
+      **       comment any source lines tagged with "SCROLL" in cols **
+      **       1-6 in order to have error messages scroll properly   **
+      **       in the OCic shell window.                             **
+      *****************************************************************
+      **  DATE  CHANGE DESCRIPTION                                   **
+      ** ====== ==================================================== **
+      ** GC0609 Don't display compiler messages file if compilation  **
+      **        Is successful.  Also don't display messages if the   **
+      **        output file is busy (just put a message on the       **
+      **        screen, leave the OC screen up & let the user fix    **
+      **        the problem & resubmit.                              **
+      ** GC0709 When 'EXECUTE' is selected, a 'FILE BUSY' error will **
+      **        still cause the (old) executable to be launched.     **
+      **        Also, the 'EXTRA SWITCHES' field is being ignored.   **
+      **        Changed the title bar to lowlighted reverse video &  **
+      **        the message area to highlighted reverse-video.       **
+      ** GC0809 Add a SPACE in from of command-line args when        **
+      **        executing users program.  Add a SPACE after the      **
+      **        -ftraceall switch when building cobc command.        **
+      ** GC0909 Convert to work on Cygwin/Linux as well as MinGW     **
+      ** GC0310 Virtualized the key codes for S-F1 thru S-F7 as they **
+      **        differ depending upon whether PDCurses or NCurses is **
+      **        being used.                                          **
+      ** GC0410 Introduced the cross-reference and source listing    **
+      **        features.  Also fixed a bug in @EXTRA switch proces- **
+      **        sing where garbage will result if more than the      **
+      **        @EXTRA switch is specified.                          **
+      *****************************************************************
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION ALL INTRINSIC.
+       INPUT-OUTPUT SECTION.
+       FILE-CONTROL.
+           SELECT Bat-File             ASSIGN TO Bat-File-Name
+                                       ORGANIZATION IS LINE SEQUENTIAL.
+
+           SELECT Cobc-Output          ASSIGN TO Cobc-Output-File
+                                       ORGANIZATION IS LINE SEQUENTIAL.
+
+           SELECT Source-Code          ASSIGN TO File-Name
+                                       ORGANIZATION IS LINE SEQUENTIAL
+                                       FILE STATUS IS FSM-Status.
+       DATA DIVISION.
+       FILE SECTION.
+       FD  Bat-File.
+       01  Bat-File-Rec                PIC X(2048).
+
+       FD  Cobc-Output.
+       01  Cobc-Output-Rec             PIC X(256).
+
+       FD  Source-Code.
+       01  Source-Code-Record          PIC X(80).
+
+       WORKING-STORAGE SECTION.
+       COPY screenio.
+
+       01  Bat-File-Name               PIC X(256).
+
+GC0909 01  Cmd                         PIC X(512).
+
+       01  Cobc-Cmd                    PIC X(256).
+
+       01  Cobc-Output-File            PIC X(256).
+
+       01  Command-Line-Args           PIC X(256).
+
+       01  Config-File                 PIC X(12).
+
+GC0310 01  Config-Keys.
+GC0310     05 CK-S-F1                  PIC 9(4).
+GC0310     05 CK-S-F2                  PIC 9(4).
+GC0310     05 CK-S-F3                  PIC 9(4).
+GC0310     05 CK-S-F4                  PIC 9(4).
+GC0310     05 CK-S-F5                  PIC 9(4).
+GC0310     05 CK-S-F6                  PIC 9(4).
+GC0310     05 CK-S-F7                  PIC 9(4).
+
+GC0909 01  Dir-Char                    PIC X(1).
+
+       01  Dummy                       PIC X(1).
+
+       01  Env-TEMP                    PIC X(256).
+
+       01  File-Name.
+           05 FN-Char                  OCCURS 256 TIMES PIC X(1).
+
+       01  File-Status-Message.
+           05 FILLER                   PIC X(13) VALUE 'Status Code: '.
+           05 FSM-Status               PIC 9(2).
+           05 FILLER                   PIC X(11) VALUE ', Meaning: '.
+           05 FSM-Msg                  PIC X(25).
+
+       01  Flags.
+           05 F-Compilation-Succeeded  PIC X(1).
+              88 88-Compile-OK         VALUE 'Y'.
+GC0909        88 88-Compile-OK-Warn    VALUE 'W'.
+              88 88-Compile-Failed     VALUE 'N'.
+GC0609     05 F-Complete               PIC X(1).
+GC0609        88 88-Complete           VALUE 'Y'.
+GC0609        88 88-Not-Complete       VALUE 'N'.
+GC0809     05 F-IDENT-DIVISION         PIC X(1).
+GC0809        88 88-1st-Prog-Complete  VALUE 'Y'.
+GC0809        88 88-More-To-1st-Prog   VALUE 'N'.
+           05 F-LINKAGE-SECTION        PIC X(1).
+              88 88-Compile-As-Subpgm  VALUE 'Y'.
+              88 88-Compile-As-Mainpgm VALUE 'N'.
+           05 F-No-Switch-Changes      PIC X(1).
+              88 88-No-Switch-Changes  VALUE 'Y'.
+              88 88-Switch-Changes     VALUE 'N'.
+GC0709     05 F-Output-File-Busy       PIC X(1).
+GC0709        88 88-Output-File-Busy   VALUE 'Y'.
+GC0709        88 88-Output-File-Avail  VALUE 'N'.
+GC0809     05 F-Source-Record-Type     PIC X(1).
+GC0809        88 88-Source-Rec-Linkage VALUE 'L'.
+GC0809        88 88-Source-Rec-Ident   VALUE 'I'.
+GC0809        88 88-Source-Rec-IgnoCOB-COLOR-RED VALUE ' '.
+           05 F-Switch-Error           PIC X(1).
+              88 88-Switch-Is-Bad      VALUE 'Y'.
+              88 88-Switch-Is-Good     VALUE 'N'.
+
+GC0909 01  Horizontal-Line             PIC X(80).
+GC0909
+       01  I                           USAGE BINARY-LONG.
+
+       01  J                           USAGE BINARY-LONG.
+
+GC0909 01  MS                          USAGE BINARY-LONG.
+
+GC0909 01  ML                          USAGE BINARY-LONG.
+
+       01  OC-Compiled                 PIC XXXX/XX/XXBXX/XX.
+
+GC0909 01  OS-Type                     USAGE BINARY-LONG.
+GC0909     88 OS-Unknown               VALUE 0.
+GC0909     88 OS-Windows               VALUE 1.
+GC0909     88 OS-Cygwin                VALUE 2.
+GC0909     88 OS-UNIX                  VALUE 3.
+
+GC0909 01  OS-Type-Literal             PIC X(7).
+
+       01  Output-Message              PIC X(80).
+
+       01  Path-Delimiter              PIC X(1).
+
+       01  Prog-Folder                 PIC X(256).
+
+       01  Prog-Extension              PIC X(30).
+
+       01  Prog-File-Name              PIC X(40).
+
+       01  Prog-Name                   PIC X(31).
+
+       78  Selection-Char              VALUE '>'.
+
+       01  Switch-Display.
+           05 SD-Switch-And-Value      PIC X(19).
+           05 FILLER                   PIC X(1).
+           05 SD-Description           PIC X(60).
+
+       01  Switch-Keyword              PIC X(12).
+GC0410     88 Switch-Is-CONFIG     VALUE '@CONFIG', '@C'.
+GC0410     88 Switch-Is-DEBUG      VALUE '@DEBUG', '@D'.
+GC0410     88 Switch-Is-DLL        VALUE '@DLL'.
+GC0410     88 Switch-Is-EXECUTE    VALUE '@EXECUTE', '@E'.
+GC0410     88 Switch-Is-EXTRA      VALUE '@EXTRA', '@EX'.
+GC0410     88 Switch-Is-NOTRUNC    VALUE '@NOTRUNC', '@N'.
+GC0410     88 Switch-Is-TRACE      VALUE '@TRACE', '@T'.
+GC0410     88 Switch-Is-SOURCE     VALUE '@SOURCE', '@S'.
+GC0410     88 Switch-Is-XREF       VALUE '@XREF', '@X'.
+
+       01  Switch-Keyword-And-Value    PIC X(256).
+
+       01  Switch-Value.
+           05 SV-1                     PIC X(1).
+           05 FILLER                   PIC X(255).
+       01  Switch-Value-Alt            REDEFINES Switch-Value
+                                       PIC X(256).
+           88 Valid-Config-Filename
+              VALUE 'BS2000', 'COBOL85', 'COBOL2002', 'DEFAULT',
+                    'IBM',    'MF',      'MVS'.
+
+       01  Switches.
+           05 S-ARGS                   PIC X(75) VALUE SPACES.
+           05 S-CfgS.
+              10 S-Cfg-BS2000          PIC X(1)  VALUE ' '.
+              10 S-Cfg-COBOL85         PIC X(1)  VALUE ' '.
+              10 S-Cfg-COBOL2002       PIC X(1)  VALUE ' '.
+              10 S-Cfg-DEFAULT         PIC X(1)  VALUE Selection-Char.
+              10 S-Cfg-IBM             PIC X(1)  VALUE ' '.
+              10 S-Cfg-MF              PIC X(1)  VALUE ' '.
+              10 S-Cfg-MVS             PIC X(1)  VALUE ' '.
+           05 S-EXTRA                  PIC X(75) VALUE SPACES.
+           05 S-Yes-No-Switches.
+              10 S-DEBUG               PIC X(1)  VALUE 'N'.
+              10 S-DLL                 PIC X(1)  VALUE 'N'.
+GC0410        10 S-XREF                PIC X(1)  VALUE 'N'.
+GC0410        10 S-SOURCE              PIC X(1)  VALUE 'N'.
+              10 S-EXECUTE             PIC X(1)  VALUE 'N'.
+              10 S-NOTRUNC             PIC X(1)  VALUE 'Y'.
+              10 S-SUBROUTINE          PIC X(1)  VALUE 'A'.
+              10 S-TRACE               PIC X(1)  VALUE 'N'.
+              10 S-TRACEALL            PIC X(1)  VALUE 'N'.
+
+       01  Tally                       USAGE BINARY-LONG.
+
+         SCREEN SECTION.
+      *>
+      *> Here is the layout of the OCic screen.
+      *>
+      *> Note that this program can utilize the traditional PC line-drawing characters,
+      *> if they are available.
+      *>
+      *> If this program is run on Windows, it must run with codepage 437 activated to
+      *> display the line-drawing characters.  With a native Windows build or a
+      *> Windows/MinGW build, one could use the command "chcp 437" to set that codepage
+      *> for display within a Windows console window (that should be the default, though).
+      *> With a Windows/Cygwin build, set the environment variable CYGWIN to a value of
+      *> "codepage:oem" (this cannot be done from within the program though - you will
+      *> have to use the "Computer/Advanced System Settings/Environment Variables" (Vista or
+      *> Windows 7) function to define the variable.  XP Users: use "My Computer/Properties/
+      *> Advanced/Environment Variables".
+      *>
+      *> To use OCic without the line-drawing characters, comment-out the first set of
+      *> 78 "LD" items and uncomment the second.
+      *>
+      *> The following sample screen layout shows how the screen looks with line-drawing
+      *> characters disabled.
+      *>
+      *>===================================================================================
+      *> OCic (2010/04/02 11:36) - OpenCOBOL V1.1 Interactive Compilation        Windows 01
+      *> +-----------------------------------------------------------------------------+ 02
+      *> | Program:  OCic                                            F-Key: Select Opt | 03
+      *> | Folder:   E:\OpenCOBOL\Samples                            Enter: Compile    | 04
+      *> | Filename: OCic.cbl                                        Esc:   Quit       | 05
+      *> +-----------------------------------------------------------------------------+ 06
+      *>   On/Off Switches:                                          Configuration:      07
+      *> +---------------------------------------------------------+-------------------+ 08
+      *> | F1   Compile debug lines    F8   Produce source listing | S-F1   BS2000     | 09
+      *> | F2   Always make DLLs       F9   Produce xref listing   | S-F2   COBOL85    | 10
+      *> | F3   Pgm is a SUBROUTINE                                | S-F3   COBOL2002  | 11
+      *> | F4   Execute if compile OK                              | S-F4 > Default    | 12
+      *> | F5 > No COMP/BINARY trunc                               | S-F5   IBM        | 13
+      *> | F6   Trace procedures                                   | S-F6   MicroFocus | 14
+      *> | F7   Trace proc + stmnts                                | S-F7   MVS        | 15
+      *> +---------------------------------------------------------+-------------------+ 16
+      *>   Additional "cobc" Switches (if any):                                          17
+      *> +-----------------------------------------------------------------------------+ 18
+      *> | -O2________________________________________________________________________ | 19
+      *> +-----------------------------------------------------------------------------+ 20
+      *>   Program Execution Arguments (if any):                                         21
+      *> +-----------------------------------------------------------------------------+ 22
+      *> | ___________________________________________________________________________ | 23
+      *> +-----------------------------------------------------------------------------+ 24
+      *> OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL                               25
+      *>===================================================================================
+      *>12345678901234567890123456789012345678901234567890123456789012345678901234567890
+      *>         1         2         3         4         5         6         7         8
+      *>
+      *> USE THESE CHARS FOR LINE-DRAWING IF YOU HAVE ACCESS TO PC-DOS CODEPAGE 437:
+      *>
+       78 LD-UL-Corner                 VALUE X"DA".
+       78 LD-LL-Corner                 VALUE X"C0".
+       78 LD-UR-Corner                 VALUE X"BF".
+       78 LD-LR-Corner                 VALUE X"D9".
+       78 LD-Upper-T                   VALUE X"C2".
+       78 LD-Lower-T                   VALUE X"C1".
+       78 LD-Horiz-Line                VALUE X"C4".
+       78 LD-Vert-Line                 VALUE X"B3".
+      *>
+      *> USE THESE CHARS FOR LINE-DRAWING IF YOU DO NOT HAVE ACCESS TO PC-DOS CODEPAGE 437:
+      *>
+      *> 78 LD-UL-Corner                          VALUE '+'.
+      *> 78 LD-LL-Corner                          VALUE '+'.
+      *> 78 LD-UR-Corner                          VALUE '+'.
+      *> 78 LD-LR-Corner                          VALUE '+'.
+      *> 78 LD-Upper-T                            VALUE '+'.
+      *> 78 LD-Lower-T                            VALUE '+'.
+      *> 78 LD-Horiz-Line                         VALUE '-'.
+      *> 78 LD-Vert-Line                          VALUE '|'.
+      *>
+       01 Blank-Screen LINE 1 COLUMN 1 BLANK SCREEN.
+
+       01 Switches-Screen BACKGROUND-COLOR COB-COLOR-BLACK
+                          FOREGROUND-COLOR COB-COLOR-WHITE AUTO.
+      *>
+      *> GENERAL SCREEN FRAMEWORK
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-BLUE  HIGHLIGHT.
+             05 LINE 02 COL 02           VALUE LD-UL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-UR-Corner.
+
+             05 LINE 03 COL 02           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 04 COL 02           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 05 COL 02           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 06 COL 02           VALUE LD-LL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-LR-Corner.
+
+             05 LINE 08 COL 02           VALUE LD-UL-Corner.
+             05                PIC X(57) FROM  Horizontal-Line.
+             05         COL 60           VALUE LD-Upper-T.
+             05                PIC X(19) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-UR-Corner.
+
+             05 LINE 09 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 10 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 11 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 12 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 13 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 14 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 15 COL 02           VALUE LD-Vert-Line.
+             05         COL 60           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 16 COL 02           VALUE LD-LL-Corner.
+             05                PIC X(57) FROM  Horizontal-Line.
+             05         COL 60           VALUE LD-Lower-T.
+             05                PIC X(19) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-LR-Corner.
+
+             05 LINE 18 COL 02           VALUE LD-UL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-UR-Corner.
+
+             05 LINE 19 COL 02           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 20 COL 02           VALUE LD-LL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-LR-Corner.
+
+             05 LINE 22 COL 02           VALUE LD-UL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-UR-Corner.
+
+             05 LINE 23 COL 02           VALUE LD-Vert-Line.
+             05         COL 80           VALUE LD-Vert-Line.
+
+             05 LINE 24 COL 02           VALUE LD-LL-Corner.
+             05                PIC X(77) FROM  Horizontal-Line.
+             05         COL 80           VALUE LD-LR-Corner.
+      *>
+      *> TOP AND BOTTOM LINES
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLUE  BLINK
+             FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
+GC0410       05 LINE 01 COL 01 VALUE ' OCic ('.
+GC0410       05                PIC X(16) FROM OC-Compiled.
+GC0410       05                VALUE ') OpenCOBOL V1.1 06FEB2009 ' &
+GC0410                               'Interactive Compilation         '.
+GC0410       05 LINE 25 COL 01 PIC X(81) FROM Output-Message.
+      *>
+      *> LABELS
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-CYAN  HIGHLIGHT.
+             05 LINE 07 COL 04 VALUE 'On/Off Switches:'.
+             05         COL 62 VALUE 'Configuration:'.
+             05 LINE 17 COL 04 VALUE 'Additional "cobc" Switches (if any
+      -                              '):'.
+             05 LINE 21 COL 04 VALUE 'Program Execution Arguments (if an
+      -                              'y):'.
+      *>
+      *> TOP SECTION BACKGROUND
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
+             05 LINE 03 COL 04 VALUE 'Program:  '.
+             05 LINE 04 COL 04 VALUE 'Folder:   '.
+             05 LINE 05 COL 04 VALUE 'Filename: '.
+
+             05 LINE 03 COL 62 VALUE 'F-Key: Select Opt'.
+             05 LINE 04 COL 62 VALUE 'Enter: Compile   '.
+             05 LINE 05 COL 62 VALUE 'Esc:   Quit      '.
+      *>
+      *> TOP SECTION PROGRAM INFO
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
+             05 LINE 03 COL 14 PIC X(47) FROM Prog-Name.
+             05 LINE 04 COL 14 PIC X(47) FROM Prog-Folder.
+             05 LINE 05 COL 14 PIC X(47) FROM Prog-File-Name.
+      *>
+      *> MIDDLE LEFT SECTION F-KEYS
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
+             05 LINE 09 COL 04 VALUE 'F1'.
+             05 LINE 10 COL 04 VALUE 'F2'.
+             05 LINE 11 COL 04 VALUE 'F3'.
+             05 LINE 12 COL 04 VALUE 'F4'.
+             05 LINE 13 COL 04 VALUE 'F5'.
+             05 LINE 14 COL 04 VALUE 'F6'.
+             05 LINE 15 COL 04 VALUE 'F7'.
+             05 LINE 09 COL 32 VALUE 'F8'.
+             05 LINE 10 COL 32 VALUE 'F9'.
+      *>
+      *> MIDDLE LEFT SECTION SWITCHES
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-RED   HIGHLIGHT.
+             05 LINE 09 COL 07 PIC X(1) FROM S-DEBUG.
+             05 LINE 10 COL 07 PIC X(1) FROM S-DLL.
+             05 LINE 11 COL 07 PIC X(1) FROM S-SUBROUTINE.
+             05 LINE 12 COL 07 PIC X(1) FROM S-EXECUTE.
+             05 LINE 13 COL 07 PIC X(1) FROM S-NOTRUNC.
+             05 LINE 14 COL 07 PIC X(1) FROM S-TRACE.
+             05 LINE 15 COL 07 PIC X(1) FROM S-TRACEALL.
+             05 LINE 09 COL 35 PIC X(1) FROM S-SOURCE.
+             05 LINE 10 COL 35 PIC X(1) FROM S-XREF.
+      *>
+      *> MIDDLE LEFT SECTION BACKGROUND
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-CYAN  LOWLIGHT.
+             05 LINE 09 COL 09 VALUE 'Compile debug lines   '.
+             05 LINE 10 COL 09 VALUE 'Always make DLLs      '.
+             05 LINE 11 COL 09 VALUE 'Pgm is a SUBROUTINE   '.
+             05 LINE 12 COL 09 VALUE 'Execute if compile OK '.
+             05 LINE 13 COL 09 VALUE 'No COMP/BINARY trunc  '.
+             05 LINE 14 COL 09 VALUE 'Trace procedures      '.
+             05 LINE 15 COL 09 VALUE 'Trace proc + stmnts   '.
+             05 LINE 09 COL 37 VALUE 'Produce source listing'.
+             05 LINE 10 COL 37 VALUE 'Produce xref listing  '.
+      *>
+      *> MIDDLE RIGHT SECTION F-KEYS
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
+             05 LINE 09 COL 62 VALUE 'S-F1'.
+             05 LINE 10 COL 62 VALUE 'S-F2'.
+             05 LINE 11 COL 62 VALUE 'S-F3'.
+             05 LINE 12 COL 62 VALUE 'S-F4'.
+             05 LINE 13 COL 62 VALUE 'S-F5'.
+             05 LINE 14 COL 62 VALUE 'S-F6'.
+             05 LINE 15 COL 62 VALUE 'S-F7'.
+      *>
+      *> MIDDLE RIGHT SECTION SWITCHES
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-RED HIGHLIGHT.
+             05 LINE 09 COL 67 PIC X(1) FROM S-Cfg-BS2000.
+             05 LINE 10 COL 67 PIC X(1) FROM S-Cfg-COBOL85.
+             05 LINE 11 COL 67 PIC X(1) FROM S-Cfg-COBOL2002.
+             05 LINE 12 COL 67 PIC X(1) FROM S-Cfg-DEFAULT.
+             05 LINE 13 COL 67 PIC X(1) FROM S-Cfg-IBM.
+             05 LINE 14 COL 67 PIC X(1) FROM S-Cfg-MF.
+             05 LINE 15 COL 67 PIC X(1) FROM S-Cfg-MVS.
+      *>
+      *> MIDDLE RIGHT SECTION BACKGROUND
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
+             05 LINE 09 COL 69 VALUE 'BS2000    '.
+             05 LINE 10 COL 69 VALUE 'COBOL85   '.
+             05 LINE 11 COL 69 VALUE 'COBOL2002 '.
+             05 LINE 12 COL 69 VALUE 'Default   '.
+             05 LINE 13 COL 69 VALUE 'IBM       '.
+             05 LINE 14 COL 69 VALUE 'MicroFocus'.
+             05 LINE 15 COL 69 VALUE 'MVS       '.
+      *>
+      *> FREE-FORM OPTIONS FIELDS
+      *>
+          03 BACKGROUND-COLOR COB-COLOR-BLACK
+             FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
+             05 LINE 19 COL 04 PIC X(75) USING S-EXTRA.
+             05 LINE 23 COL 04 PIC X(75) USING S-ARGS.
+      /
+       PROCEDURE DIVISION.
+      *****************************************************************
+      ** Legend to procedure names:                                  **
+      **                                                             **
+      ** 00x-xxx   All MAIN driver procedures                        **
+      ** 0xx-xxx   All GLOBAL UTILITY procedures                     **
+      ** 1xx-xxx   All INITIALIZATION procedures                     **
+      ** 2xx-xxx   All CORE PROCESSING procedures                    **
+      ** 9xx-xxx   All TERMINATION procedures                        **
+      *****************************************************************
+       DECLARATIVES.
+       000-File-Error SECTION.
+           USE AFTER STANDARD ERROR PROCEDURE ON Source-Code.
+       000-Handle-Error.
+           COPY FileStat-Msgs
+               REPLACING STATUS BY FSM-Status
+                         MSG    BY FSM-Msg.
+           MOVE SPACES TO Output-Message
+           IF FSM-Status = 35
+               DISPLAY
+                   'File not found: "'
+                   TRIM(File-Name,TRAILING)
+                   '"'
+               END-DISPLAY
+           ELSE
+               DISPLAY
+                   'Error accessing file: "'
+                   TRIM(File-Name,TRAILING)
+                   '"'
+               END-DISPLAY
+           END-IF
+           GOBACK
+           .
+       END DECLARATIVES.
+      /
+       000-Main SECTION.
+
+           PERFORM 100-Initialization
+GC0609     SET 88-Not-Complete TO TRUE
+GC0609     PERFORM UNTIL 88-Complete
+GC0609         PERFORM 200-Let-User-Set-Switches
+GC0609         PERFORM 210-Run-Compiler
+GC0410         IF (88-Compile-OK OR 88-Compile-OK-Warn)
+GC0410         AND (S-XREF NOT = SPACE OR S-SOURCE NOT = SPACE)
+GC0410             PERFORM 220-Make-Listing
+GC0410         END-IF
+GC0709         IF  (S-EXECUTE NOT = SPACES)
+GC0709         AND (88-Output-File-Avail)
+GC0609             PERFORM 230-Run-Program
+GC0609         END-IF
+GC0609     END-PERFORM
+           .
+
+       009-Done.
+           PERFORM 900-Terminate
+           .
+      * -- Control will NOT return
+      /
+       010-Parse-Args SECTION.
+      *****************************************************************
+      ** Process a sequence of KEYWORD=VALUE items.  These are items **
+      ** specified on the command-line to provide the initial        **
+      ** options shown selected on the screen.  When integrating     **
+      ** OCic into an edirot or framework, include these switches on **
+      ** the ocic.exe command the editor/framework executes.  Any    **
+      ** underlined choice is the default value for that switch.     **
+      **                                                             **
+      ** @CONFIG=BS2000|COBOL85|COBOL2002|DEFAULT|IBM|MF|MVS         **
+      **                                  =======                    **
+      ** This switch specifies the default cobc compiler configura-  **
+      ** tion file to be used                                        **
+      **                                                             **
+      ** @DEBUG=YES|NO                                               **
+      **            ==                                               **
+      ** This switch specifies whether (YES) or not (NO) debugging   **
+      ** lines (those with a "D" in column 7) will be compiled.      **
+      **                                                             **
+      ** @DLL=YES|NO                                                 **
+      **          ==                                                 **
+      ** Use this switch to force ALL compiled programs to be built  **
+      ** as DLLs ("@DLL=YES").  When main programs are built as DLLs **
+      ** they must be executed using the cobcrun utility.  When      **
+      ** "@DLL=NO" is in effect, main programs are generated as      **
+      ** actual "exe" files and only subprograms will be generated   **
+      ** as DLLs.                                                    **
+      **                                                             **
+      ** @EXECUTE=YES|NO                                             **
+      **              ==                                             **
+      ** This switch specifies whether ("@EXECUTE=YES") or not       **
+      ** ("@EXECUTE=NO") the program will be executed after it is    **
+      ** successfully compiled.                                      **
+      **                                                             **
+      ** @EXTRA=extra cobc argument(s)                               **
+      **                                                             **
+      ** This switch allows you to specify additional cobc arguments **
+      ** that aren't managed by the other OC switches.  If used,     **
+      ** this must be the last switch specified on the command line, **
+      ** as everything that follows the "=" will be placed on the    **
+      ** cobc command generated by OC.                               **
+      **                                                             **
+      ** @NOTRUNC=YES|NO                                             **
+      **          ===                                                **
+      ** This switch specifies whether (YES) or not (NO) the sup-    **
+      ** pression of binary field truncation will occur.  If a PIC   **
+      ** 99 COMP field (one byte of storage), for example, is given  **
+      ** the value 123, it may have its value truncated to 23 when   **
+      ** DISPLAYed.  Regardless of the NOTRUNC setting, internally   **
+      ** the full precision of the field (allowing a maximum value   **
+      ** of 255) will be preserved.  Even though truncation - if it  **
+      ** does occur - would appear to have a minimal disruption on   **
+      ** program operation, it has a significant effect on program   **
+      ** run-time speed.                                             **
+      **                                                             **
+      ** @TRACE=YES|NO|ALL                                           **
+      **            ==                                               **
+      ** This switch controls whether or not code will be added to   **
+      ** the object program to produce execution-time logic traces.  **
+      ** A specification of "@TRACE=NO" means no such code will be   **
+      ** produced.  By specifying "@TRACE=YES", code will be genera- **
+      ** ted to display procedure names as they are entered.  A      **
+      ** "@TRACE=ALL" specification will generate not only procedure **
+      ** traces (as "@TRACE=YES" would) but also statement-level     **
+      ** traces too!  All trace output is written to STDERR, so      **
+      ** adding a "2>file" to the execution of the program will pipe **
+      ** the trace output to a file.  You may find it valuable to    **
+      ** add your own DISPLAY statements to the debugging output via **
+      ** "DISPLAY xx UPON SYSERR"  The SYSERR device corresponds to  **
+      ** the Windows or UNIX STDERR device and will therefore honor  **
+      ** any "2>file" placed at the end of your program's execution. **
+      ** Add a "D" in column 7 and you can control the generation or **
+      ** ignoring of these DISPLAY statements via the "@DEBUG"       **
+      ** switch.                                                     **
+      **                                                             **
+GC0410** @SOURCE=YES|NO                                              **
+GC0410**           ==                                                **
+GC0410** Use this switch to produce a source listing of the program, **
+GC0410** PROVIDED it compiles without errors.                        **
+      **                                                             **
+GC0410** @XREF=YES|NO                                                **
+GC0410**           ==                                                **
+GC0410** Use this switch to produce a cross-reference listing of the **
+GC0410** program, PROVIDED it compiles without errors.               **
+      *****************************************************************
+
+       011-Init.
+           MOVE 1 TO I
+           .
+
+       012-Extract-Kwd-And-Value.
+           PERFORM UNTIL I NOT < LENGTH(Command-Line-Args)
+               MOVE I TO J
+               UNSTRING Command-Line-Args
+                   DELIMITED BY ALL SPACES
+                   INTO Switch-Keyword-And-Value
+                   WITH POINTER I
+               END-UNSTRING
+               IF Switch-Keyword-And-Value NOT = SPACES
+                   UNSTRING Switch-Keyword-And-Value
+                       DELIMITED BY '='
+                       INTO Switch-Keyword, Switch-Value
+                   END-UNSTRING
+                   PERFORM 030-Process-Keyword
+               END-IF
+           END-PERFORM
+           .
+
+       019-Done.
+           EXIT.
+
+      *****************************************************************
+      ** Since this program uses the SCREEN SECTION, it cannot do    **
+      ** conventional console DISPLAY operations.  This routine      **
+      ** (which, I admit, is like using an H-bomb to hunt rabbits)   **
+      ** will submit an "ECHO" command to the system to simulate a   **
+      ** DISPLAY.                                                    **
+      *****************************************************************
+       021-Build-And-Issue-Command.
+           DISPLAY
+               Output-Message
+           END-DISPLAY
+           .
+
+       029-Done.
+           EXIT.
+      /
+       030-Process-Keyword SECTION.
+      *****************************************************************
+      ** Process a single KEYWORD=VALUE item.                        **
+      *****************************************************************
+
+       031-Init.
+           MOVE UPPER-CASE(Switch-Keyword) TO Switch-Keyword
+           SET 88-Switch-Is-Good TO TRUE
+           .
+
+       032-Process.
+           EVALUATE TRUE
+               WHEN Switch-Is-EXTRA
+GC0410             MOVE J TO I
+                   UNSTRING Command-Line-Args DELIMITED BY '='
+                       INTO Dummy, S-EXTRA
+GC0410                 WITH POINTER I
+GC0410             END-UNSTRING
+                   MOVE LENGTH(Command-Line-Args) TO I
+               WHEN Switch-Is-CONFIG
+                   MOVE 'CONFIG' TO Switch-Keyword
+                   MOVE UPPER-CASE(Switch-Value)
+                     TO Switch-Value
+                   EVALUATE Switch-Value
+                       WHEN 'BS2000'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-BS2000
+                       WHEN 'COBOL85'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-COBOL85
+                       WHEN 'COBOL2002'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-COBOL2002
+                       WHEN 'DEFAULT'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-DEFAULT
+                       WHEN 'IBM'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-IBM
+                       WHEN 'MF'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-MF
+                       WHEN 'MVS'
+                           MOVE SPACES TO S-CfgS
+                           MOVE Selection-Char    TO S-Cfg-MVS
+                       WHEN OTHER
+                           MOVE 'An invalid /CONFIG switch value ' &
+                                'was specified on the command line ' &
+                                '- ignored'
+                             TO Output-Message
+                   END-EVALUATE
+               WHEN Switch-Is-DEBUG
+                   MOVE 'DEBUG' TO Switch-Keyword
+                   MOVE UPPER-CASE(Switch-Value)
+                     TO Switch-Value
+                   PERFORM 040-Process-Yes-No-Value
+                   IF 88-Switch-Is-Good
+                       MOVE SV-1 TO S-DEBUG
+                   END-IF
+GC0410         WHEN Switch-Is-DLL
+GC0410             MOVE 'DLL' TO Switch-Keyword
+GC0410             MOVE UPPER-CASE(Switch-Value)
+GC0410               TO Switch-Value
+GC0410             PERFORM 040-Process-Yes-No-Value
+GC0410             IF 88-Switch-Is-Good
+GC0410                 MOVE SV-1 TO S-DLL
+GC0410             END-IF
+               WHEN Switch-Is-EXECUTE
+                   MOVE 'EXECUTE' TO Switch-Keyword
+                   MOVE UPPER-CASE(Switch-Value)
+                     TO Switch-Value
+                   PERFORM 040-Process-Yes-No-Value
+                   IF 88-Switch-Is-Good
+                       MOVE SV-1 TO S-EXECUTE
+                   END-IF
+               WHEN Switch-Is-NOTRUNC
+                   MOVE 'NOTRUNC' TO Switch-Keyword
+                   MOVE UPPER-CASE(Switch-Value)
+                     TO Switch-Value
+                   PERFORM 040-Process-Yes-No-Value
+                   IF 88-Switch-Is-Good
+                       MOVE SV-1 TO S-NOTRUNC
+                   END-IF
+GC0410         WHEN Switch-Is-SOURCE
+GC0410             MOVE 'SOURCE' TO Switch-Keyword
+GC0410             MOVE UPPER-CASE(Switch-Value)
+GC0410               TO Switch-Value
+GC0410             PERFORM 050-Process-Yes-No-All
+GC0410             IF 88-Switch-Is-Good
+GC0410                 MOVE SV-1 TO S-SOURCE
+GC0410             END-IF
+               WHEN Switch-Is-TRACE
+                   MOVE 'TRACE' TO Switch-Keyword
+                   MOVE UPPER-CASE(Switch-Value)
+                     TO Switch-Value
+                   PERFORM 050-Process-Yes-No-All
+                   IF 88-Switch-Is-Good
+                       MOVE SV-1 TO S-TRACE
+                   END-IF
+GC0410         WHEN Switch-Is-XREF
+GC0410             MOVE 'XREF' TO Switch-Keyword
+GC0410             MOVE UPPER-CASE(Switch-Value)
+GC0410               TO Switch-Value
+GC0410             PERFORM 050-Process-Yes-No-All
+GC0410             IF 88-Switch-Is-Good
+GC0410                 MOVE SV-1 TO S-XREF
+GC0410             END-IF
+               WHEN OTHER
+                   MOVE SPACES TO Output-Message
+                   STRING '"'
+                          TRIM(Switch-Keyword)
+                          '" is not a valid switch ' &
+                                         '- ignored'
+                          DELIMITED SIZE
+                          INTO Output-Message
+                   END-STRING
+                   SET 88-Switch-Is-Bad TO TRUE
+           END-EVALUATE
+           .
+
+       039-Done.
+           EXIT.
+      /
+       040-Process-Yes-No-Value SECTION.
+      *****************************************************************
+      ** Process a switch value of YES or NO                         **
+      *****************************************************************
+
+       042-Process.
+           EVALUATE SV-1
+               WHEN 'Y'
+                   MOVE 'YES' TO Switch-Value
+               WHEN 'N'
+                   MOVE 'NO'  To Switch-Value
+               WHEN OTHER
+                   MOVE SPACES TO Output-Message
+                   STRING '*ERROR: "' TRIM(Switch-Value)
+                           '" is not a valid value for the "'
+                           TRIM(Switch-Keyword) '" switch'
+                           DELIMITED SPACES
+                           INTO Output-Message
+                   END-STRING
+                   SET 88-Switch-Is-Bad TO TRUE
+           END-EVALUATE
+           .
+
+       049-Done.
+           EXIT.
+      /
+       050-Process-Yes-No-All SECTION.
+      *****************************************************************
+      ** Process a switch value of YES, NO or ALL                    **
+      *****************************************************************
+
+       052-Process.
+           IF SV-1 = 'A'
+               MOVE 'ALL' TO Switch-Value
+           ELSE
+               PERFORM 040-Process-Yes-No-Value
+           END-IF
+           .
+
+       059-Done.
+           EXIT.
+      /
+       060-Process-Yes-No-Auto SECTION.
+      *****************************************************************
+      ** Process a switch value of YES, NO or AUTO                   **
+      *****************************************************************
+
+       061-Init.
+           IF SV-1 = 'A'
+               PERFORM 070-Find-LINKAGE-SECTION
+               IF 88-Compile-As-Subpgm
+                   MOVE 'Y' TO Switch-Value
+               ELSE
+                   MOVE 'N' TO Switch-Value
+               END-IF
+           ELSE
+               PERFORM 040-Process-Yes-No-Value
+           END-IF
+           .
+      /
+       070-Find-LINKAGE-SECTION SECTION.
+      *****************************************************************
+      ** Determine if the program being compiled is a MAIN program   **
+      *****************************************************************
+
+       071-Init.
+           OPEN INPUT Source-Code
+           SET 88-Compile-As-Mainpgm TO TRUE
+           SET 88-More-To-1st-Prog   TO TRUE
+           PERFORM UNTIL 88-1st-Prog-Complete
+               READ Source-Code AT END
+                   CLOSE Source-Code
+                   EXIT SECTION
+               END-READ
+               CALL 'CHECKSOURCE' USING Source-Code-Record
+                                       F-Source-Record-Type
+               END-CALL
+               IF 88-Source-Rec-Ident
+                   SET 88-1st-Prog-Complete TO TRUE
+               END-IF
+           END-PERFORM
+           .
+
+       072-Process-Source.
+           SET 88-Source-Rec-IgnoCOB-COLOR-RED TO TRUE
+           PERFORM UNTIL 88-Source-Rec-Linkage
+                      OR 88-Source-Rec-Ident
+               READ Source-Code AT END
+                   CLOSE Source-Code
+                   EXIT SECTION
+               END-READ
+               CALL 'CHECKSOURCE' USING Source-Code-Record
+                                       F-Source-Record-Type
+               END-CALL
+           END-PERFORM
+           CLOSE Source-Code
+           IF 88-Source-Rec-Linkage
+               SET 88-Compile-As-Subpgm TO TRUE
+           END-IF
+           .
+
+       079-Done.
+           EXIT.
+      /
+       100-Initialization SECTION.
+      *****************************************************************
+      ** Perform all program-wide initialization operations          **
+      *****************************************************************
+
+
+GC0909 101-Determine-OS-Type.
+GC0909     CALL 'GETOSTYPE'
+GC0909     END-CALL
+GC0909     MOVE RETURN-CODE TO OS-Type
+GC0909     EVALUATE TRUE
+GC0909         WHEN OS-Unknown
+GC0909             MOVE '\'         TO Dir-Char
+GC0909             MOVE 'Unknown'   TO OS-Type-Literal
+GC0310             MOVE COB-SCR-F11 TO CK-S-F1
+GC0310             MOVE COB-SCR-F12 TO CK-S-F2
+GC0310             MOVE COB-SCR-F13 TO CK-S-F3
+GC0310             MOVE COB-SCR-F14 TO CK-S-F4
+GC0310             MOVE COB-SCR-F15 TO CK-S-F5
+GC0310             MOVE COB-SCR-F16 TO CK-S-F6
+GC0310             MOVE COB-SCR-F17 TO CK-S-F7
+GC0909         WHEN OS-Windows
+GC0909             MOVE '\'         TO Dir-Char
+GC0909             MOVE 'Windows'   TO OS-Type-Literal
+GC0310             MOVE COB-SCR-F13 TO CK-S-F1
+GC0310             MOVE COB-SCR-F14 TO CK-S-F2
+GC0310             MOVE COB-SCR-F15 TO CK-S-F3
+GC0310             MOVE COB-SCR-F16 TO CK-S-F4
+GC0310             MOVE COB-SCR-F17 TO CK-S-F5
+GC0310             MOVE COB-SCR-F18 TO CK-S-F6
+GC0310             MOVE COB-SCR-F19 TO CK-S-F7
+GC0909         WHEN OS-Cygwin
+GC0909             MOVE '/'         TO Dir-Char
+GC0410             MOVE 'Cygwin'    TO OS-Type-Literal
+GC0310             MOVE COB-SCR-F11 TO CK-S-F1
+GC0310             MOVE COB-SCR-F12 TO CK-S-F2
+GC0310             MOVE COB-SCR-F13 TO CK-S-F3
+GC0310             MOVE COB-SCR-F14 TO CK-S-F4
+GC0310             MOVE COB-SCR-F15 TO CK-S-F5
+GC0310             MOVE COB-SCR-F16 TO CK-S-F6
+GC0310             MOVE COB-SCR-F17 TO CK-S-F7
+GC0909         WHEN OS-UNIX
+GC0909             MOVE '/'         TO Dir-Char
+GC0410             MOVE 'UNIX   '   TO OS-Type-Literal
+GC0310             MOVE COB-SCR-F11 TO CK-S-F1
+GC0310             MOVE COB-SCR-F12 TO CK-S-F2
+GC0310             MOVE COB-SCR-F13 TO CK-S-F3
+GC0310             MOVE COB-SCR-F14 TO CK-S-F4
+GC0310             MOVE COB-SCR-F15 TO CK-S-F5
+GC0310             MOVE COB-SCR-F16 TO CK-S-F6
+GC0310             MOVE COB-SCR-F17 TO CK-S-F7
+GC0909     END-EVALUATE
+GC0909     .
+
+       102-Set-Environment-Vars.
+           SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'
+           SET ENVIRONMENT 'COB_SCREEN_ESC'        TO 'Y'
+           .
+
+       103-Generate-Cobc-Output-Fn.
+           ACCEPT Env-TEMP
+               FROM ENVIRONMENT "TEMP"
+           END-ACCEPT
+           MOVE SPACES TO Cobc-Output-File
+           STRING TRIM(Env-TEMP,TRAILING)
+GC0909            Dir-Char
+GC0909            'OC-Messages.TXT'
+                  DELIMITED SIZE
+                  INTO Cobc-Output-File
+           END-STRING
+           .
+
+       104-Generate-Banner-Line-Info.
+           MOVE WHEN-COMPILED (1:12) TO OC-Compiled
+           INSPECT OC-Compiled
+               REPLACING ALL '/' BY ':'
+               AFTER INITIAL SPACE
+           .
+
+       105-Establish-Switch-Settings.
+           ACCEPT Command-Line-Args
+               FROM COMMAND-LINE
+           END-ACCEPT
+           MOVE TRIM(Command-Line-Args, Leading)
+             TO Command-Line-Args
+           MOVE 0 TO Tally
+GC0410     INSPECT Command-Line-Args TALLYING Tally FOR ALL '@'
+           IF Tally = 0
+               MOVE Command-Line-Args TO File-Name
+               MOVE SPACES            TO Command-Line-Args
+           ELSE
+GC0410         UNSTRING Command-Line-Args DELIMITED BY '@'
+                   INTO File-Name, Dummy
+               END-UNSTRING
+               INSPECT Command-Line-Args
+GC0410             REPLACING FIRST '@' BY LOW-VALUES
+               UNSTRING Command-Line-Args
+                   DELIMITED BY LOW-VALUES
+                   INTO Dummy, Cmd
+               END-UNSTRING
+               MOVE SPACES TO Command-Line-Args
+GC0410         STRING '@' Cmd DELIMITED SIZE
+                   INTO Command-Line-Args
+               END-STRING
+           END-IF
+           IF File-Name = SPACES
+               DISPLAY
+                   'No program filename was specified'
+               END-DISPLAY
+               PERFORM 900-Terminate
+           END-IF
+           PERFORM 010-Parse-Args
+           IF S-SUBROUTINE = 'A'
+               MOVE 'S' TO Switch-Keyword
+               MOVE 'A' TO Switch-Value
+               PERFORM 070-Find-LINKAGE-SECTION
+               IF 88-Compile-As-Subpgm
+                   MOVE 'Y' TO S-SUBROUTINE
+               ELSE
+                   MOVE 'N' TO S-SUBROUTINE
+               END-IF
+           END-IF
+           INSPECT S-Yes-No-Switches REPLACING ALL 'Y' BY Selection-Char
+           INSPECT S-Yes-No-Switches REPLACING ALL 'N' BY ' '
+           .
+
+       106-Determine-Folder-Path.
+           Move 256 TO I
+GC0909     IF OS-Cygwin AND File-Name (2:1) = ':'
+GC0909         MOVE '\' TO Dir-Char
+GC0909     END-IF
+           PERFORM UNTIL I = 0 OR FN-Char (I) = Dir-Char
+               SUBTRACT 1 FROM I
+           END-PERFORM
+           IF I = 0
+               MOVE SPACES    TO Prog-Folder
+               MOVE File-Name TO Prog-File-Name
+           ELSE
+               MOVE '*' TO FN-Char (I)
+               UNSTRING File-Name DELIMITED BY '*'
+                   INTO Prog-Folder
+                        Prog-File-Name
+               END-UNSTRING
+               MOVE Dir-Char TO FN-Char (I)
+           END-IF
+           UNSTRING Prog-File-Name DELIMITED BY '.'
+               INTO Prog-Name, Prog-Extension
+           END-UNSTRING
+           IF Prog-Folder = SPACES
+               ACCEPT Prog-Folder
+                   FROM ENVIRONMENT 'CD'
+               END-ACCEPT
+GC0909     ELSE
+GC0909         CALL "CBL_CHANGE_DIR"
+GC0909             USING TRIM(Prog-Folder,TRAILING)
+GC0909         END-CALL
+           END-IF
+GC0909     IF OS-Cygwin AND File-Name (2:1) = ':'
+GC0909         MOVE '/' TO Dir-Char
+GC0909     END-IF
+           .
+
+GC0909 107-Other.
+GC0909     MOVE ALL LD-Horiz-Line TO Horizontal-Line.
+GC0410     MOVE CONCATENATE(' OCic for ',
+GC0410                      TRIM(OS-Type-Literal,Trailing),
+GC0410                      ' Copyright (C) 2009-2010, Gary L. Cutler,',
+GC0410                      ' GPL')
+GC0410       TO Output-Message.
+GC0909     .
+GC0909
+       109-Done.
+           EXIT.
+      /
+       200-Let-User-Set-Switches SECTION.
+      *****************************************************************
+      ** Show the user the current switch settings and allow them to **
+      ** be changed.                                                 **
+      *****************************************************************
+
+       201-Init.
+           SET 88-Switch-Changes TO TRUE
+           .
+
+       202-Show-And-Change-Switches.
+           PERFORM UNTIL 88-No-Switch-Changes
+               ACCEPT
+                   Switches-Screen
+               END-ACCEPT
+               IF COB-CRT-STATUS > 0
+                   EVALUATE COB-CRT-STATUS
+                       WHEN COB-SCR-F1
+                           IF S-DEBUG = SPACE
+                               MOVE Selection-Char TO S-DEBUG
+                           ELSE
+                               MOVE ' ' TO S-DEBUG
+                           END-IF
+                       WHEN COB-SCR-F2
+                           IF S-DLL = SPACE
+                               MOVE Selection-Char TO S-DLL
+                           ELSE
+                               MOVE ' ' TO S-DLL
+                           END-IF
+                       WHEN COB-SCR-F3
+                           IF S-SUBROUTINE = SPACE
+                               MOVE Selection-Char TO S-SUBROUTINE
+                               MOVE ' ' TO S-EXECUTE
+                           ELSE
+                               MOVE ' ' TO S-SUBROUTINE
+                           END-IF
+                       WHEN COB-SCR-F4
+                           IF  S-EXECUTE = SPACE
+                           AND S-SUBROUTINE = SPACE
+                               MOVE Selection-Char TO S-EXECUTE
+                           ELSE
+                               MOVE ' ' TO S-EXECUTE
+                           END-IF
+                       WHEN COB-SCR-F5
+                           IF  S-NOTRUNC = SPACE
+                               MOVE Selection-Char TO S-NOTRUNC
+                           ELSE
+                               MOVE ' ' TO S-NOTRUNC
+                           END-IF
+                       WHEN COB-SCR-F6
+                           IF  S-TRACE = SPACE
+                               MOVE Selection-Char TO S-TRACE
+                               MOVE ' ' TO S-TRACEALL
+                           ELSE
+                               MOVE ' ' TO S-TRACE
+                           END-IF
+                       WHEN COB-SCR-F7
+                           IF  S-TRACEALL = SPACE
+                               MOVE Selection-Char TO S-TRACEALL
+                               MOVE ' ' TO S-TRACE
+                           ELSE
+                               MOVE ' ' TO S-TRACEALL
+                           END-IF
+GC0410                 WHEN COB-SCR-F8
+GC0410                     IF S-SOURCE = SPACE
+GC0410                         MOVE Selection-Char TO S-SOURCE
+GC0410                     ELSE
+GC0410                         MOVE ' ' TO S-SOURCE
+GC0410                     END-IF
+GC0410                 WHEN COB-SCR-F9
+GC0410                     IF S-XREF = SPACE
+GC0410                         MOVE Selection-Char TO S-XREF
+GC0410                     ELSE
+GC0410                         MOVE ' ' TO S-XREF
+GC0410                     END-IF
+                       WHEN COB-SCR-ESC
+                           PERFORM 900-Terminate
+GC0310                 WHEN CK-S-F1
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-BS2000
+GC0310                 WHEN CK-S-F2
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-COBOL85
+GC0310                 WHEN CK-S-F3
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-COBOL2002
+GC0310                 WHEN CK-S-F4
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-DEFAULT
+GC0310                 WHEN CK-S-F5
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-IBM
+GC0310                 WHEN CK-S-F6
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-MF
+GC0310                 WHEN CK-S-F7
+                           MOVE SPACES         TO S-CfgS
+                           MOVE Selection-Char TO S-Cfg-MVS
+                       WHEN OTHER
+                           MOVE 'An unsupported key was pressed'
+                             TO Output-Message
+                   END-EVALUATE
+               ELSE
+                   SET 88-No-Switch-Changes TO TRUE
+               END-IF
+           END-PERFORM
+           .
+
+       209-Done.
+           EXIT.
+      /
+       210-Run-Compiler SECTION.
+      *****************************************************************
+      ** Run the compiler using the switch settings we've prepared.  **
+      *****************************************************************
+
+       211-Init.
+           MOVE SPACES TO Cmd
+                          Cobc-Cmd
+                          Output-Message
+           DISPLAY
+               Switches-Screen
+           END-DISPLAY
+           MOVE 1 TO I
+           EVALUATE TRUE
+               WHEN S-Cfg-BS2000 NOT = SPACES
+                   MOVE 'bs2000' TO Config-File
+               WHEN S-Cfg-COBOL85  NOT = SPACES
+                   MOVE 'cobol85' TO Config-File
+               WHEN  S-Cfg-COBOL2002  NOT = SPACES
+                   MOVE 'cobol2002' TO Config-File
+               WHEN  S-Cfg-IBM  NOT = SPACES
+                   MOVE 'ibm' TO Config-File
+               WHEN  S-Cfg-MF  NOT = SPACES
+                   MOVE 'mf' TO Config-File
+               WHEN  S-Cfg-MVS  NOT = SPACES
+                   MOVE 'mvs' TO Config-File
+               WHEN OTHER
+                   MOVE 'default' TO Config-File
+           END-EVALUATE
+           .
+
+       212-Build-Compile-Command.
+GC0909    MOVE SPACES TO Cobc-Cmd
+GC0909     STRING 'cobc -std='
+GC0909         TRIM(Config-File,TRAILING)
+GC0909         ' '
+GC0909         INTO Cobc-Cmd
+GC0909         WITH POINTER I
+GC0909     END-STRING
+           IF S-SUBROUTINE NOT = ' '
+               STRING '-m '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           ELSE
+               STRING '-x '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           IF S-DEBUG NOT = ' '
+               STRING '-fdebugging-line '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           IF S-NOTRUNC NOT = ' '
+               STRING '-fnotrunc '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           IF S-TRACEALL NOT = ' '
+GC0809         STRING '-ftraceall '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           IF S-TRACE NOT = ' '
+               STRING '-ftrace '
+                   DELIMITED SIZE INTO Cobc-Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+
+GC0709     IF S-EXTRA > SPACES
+GC0709         STRING ' '
+GC0709                TRIM(S-Extra,TRAILING)
+GC0709                ' '
+GC0709                DELIMITED SIZE INTO Cobc-Cmd
+GC0709                WITH POINTER I
+GC0709         END-STRING
+GC0709     END-IF
+GC0909     STRING TRIM(Prog-File-Name,TRAILING)
+GC0909         DELIMITED SIZE INTO Cobc-Cmd
+GC0909         WITH POINTER I
+GC0909     END-STRING
+           .
+
+       213-Run-Compiler.
+GC0410     MOVE ' Compiling...' TO Output-Message
+GC0410     DISPLAY
+GC0410         Switches-Screen
+GC0410     END-DISPLAY
+GC0609     SET 88-Output-File-Avail TO TRUE
+           MOVE SPACES TO Cmd
+           STRING TRIM(Cobc-Cmd,TRAILING)
+                  ' 2>'
+                  TRIM(Cobc-Output-File,TRAILING)
+                  DELIMITED SIZE
+                  INTO Cmd
+           END-STRING
+           CALL 'SYSTEM'
+               USING TRIM(Cmd,TRAILING)
+           END-CALL
+GC0909     IF RETURN-CODE = 0
+GC0909         SET 88-Compile-OK TO TRUE
+GC0909     ELSE
+GC0909         SET 88-Compile-Failed TO TRUE
+GC0909     END-IF
+GC0909     IF 88-Compile-OK
+GC0909         OPEN INPUT Cobc-Output
+GC0909         READ Cobc-Output
+GC0909             AT END
+GC0909                 CONTINUE
+GC0909             NOT AT END
+GC0909                 SET 88-Compile-OK-Warn TO TRUE
+GC0909         END-READ
+GC0909         CLOSE Cobc-Output
+GC0909     END-IF
+GC0909     MOVE SPACES TO Output-Message
+           IF 88-Compile-OK
+GC0909         MOVE ' Compilation Was Successful' TO Output-Message
+GC0909         DISPLAY
+GC0909             Switches-Screen
+GC0909         END-DISPLAY
+GC0909         CALL 'C$SLEEP'
+GC0909             USING 2
+GC0909         END-CALL
+GC0909         MOVE SPACES TO Output-Message
+GC0609         SET 88-Complete TO TRUE
+           ELSE
+GC0909         DISPLAY
+GC0909             Blank-Screen
+GC0909         END-DISPLAY
+GC0909         IF 88-Compile-OK-Warn
+GC0909             DISPLAY ' Compilation was successful, but ' &
+GC0909                     'warnings were generated:'
+SCROLL*                AT LINE 24 COLUMN 1
+SCROLL*                WITH SCROLL UP 1 LINE
+GC0909             END-DISPLAY
+GC0909         ELSE
+GC0909             DISPLAY 'Compilation Failed:'
+SCROLL*                AT LINE 24 COLUMN 1
+SCROLL*                WITH SCROLL UP 1 LINE
+GC0909             END-DISPLAY
+GC0909         END-IF
+GC0609         SET 88-Compile-Failed TO TRUE
+GC0609         SET 88-Complete TO TRUE
+GC0909         DISPLAY ' '
+SCROLL*            AT LINE 24 COLUMN 1
+SCROLL*            WITH SCROLL UP 1 LINE
+GC0909         END-DISPLAY
+GC0909         OPEN INPUT Cobc-Output
+GC0909         PERFORM FOREVER
+GC0909             READ Cobc-Output AT END
+GC0909                 EXIT PERFORM
+GC0909             END-READ
+GC0909             DISPLAY TRIM(Cobc-Output-Rec,TRAILING)
+SCROLL*                AT LINE 24 COLUMN 1
+SCROLL*                WITH SCROLL UP 1 LINE
+GC0909             END-DISPLAY
+GC0909         END-PERFORM
+GC0909         CLOSE Cobc-Output
+GC0909         DISPLAY ' '
+SCROLL*            AT LINE 24 COLUMN 1
+SCROLL*            WITH SCROLL UP 2 LINES
+GC0909         END-DISPLAY
+GC0909         DISPLAY 'Press ENTER to close:'
+SCROLL*            AT LINE 24 COLUMN 1
+SCROLL*            WITH SCROLL UP 1 LINE
+GC0909         END-DISPLAY
+GC0909         ACCEPT Dummy
+GC0909             FROM CONSOLE
+GC0909         END-ACCEPT
+GC0909         DISPLAY
+GC0909             Blank-Screen
+GC0909         END-DISPLAY
+           END-IF
+           .
+
+       219-Done.
+           IF 88-Compile-Failed
+               PERFORM 900-Terminate
+           END-IF
+           .
+      /
+GC0410 220-Make-Listing SECTION.
+GC0410*****************************************************************
+GC0410** Generate a source and/or xref listing using XREF            **
+GC0410*****************************************************************
+GC0410
+GC0410 221-Init.
+GC0410     MOVE ' Generating cross-reference listing...'
+GC0410       TO Output-Message
+GC0410     DISPLAY
+GC0410         Switches-Screen
+GC0410     END-DISPLAY
+GC0410     CALL "CBL_DELETE_FILE"
+GC0410         USING CONCATENATE(TRIM(Prog-Name,Trailing),".lst")
+GC0410     END-CALL
+GC0410     MOVE 0 TO RETURN-CODE
+GC0410     .
+GC0410
+GC0410 213-Run-OCXref.
+GC0410     MOVE SPACES TO Output-Message
+GC0410     CALL 'LISTING'
+GC0410         USING S-SOURCE
+GC0410               S-XREF
+GC0410               File-Name
+GC0410         ON EXCEPTION
+GC0410             MOVE ' LISTING module is not available'
+GC0410               TO Output-Message
+GC0410             MOVE 1 TO RETURN-CODE
+GC0410     END-CALL
+GC0410     IF RETURN-CODE = 0
+GC0410         MOVE ' Listing generated'
+GC0410           TO Output-Message
+GC0410         IF OS-Windows OR OS-Cygwin
+GC0410             MOVE SPACES TO Cmd
+GC0410             STRING
+GC0410                 'cmd /c '
+GC0410                 TRIM(Prog-Name,TRAILING)
+GC0410                 '.lst'
+GC0410                 DELIMITED SIZE INTO Cmd
+GC0410             END-STRING
+GC0410             CALL 'SYSTEM'
+GC0410                 USING TRIM(Cmd,TRAILING)
+GC0410             END-CALL
+GC0410         END-IF
+GC0410     ELSE
+GC0410         IF Output-Message = SPACES
+GC0410             MOVE ' Listing generation failed'
+GC0410               TO Output-Message
+GC0410         END-IF
+GC0410     END-IF
+GC0410     DISPLAY
+GC0410         Switches-Screen
+GC0410     END-DISPLAY
+GC0410     CALL 'C$SLEEP'
+GC0410         USING 2
+GC0410     END-CALL
+GC0410     .
+      /
+       230-Run-Program SECTION.
+      *****************************************************************
+      ** Run the compiled program                                    **
+      *****************************************************************
+
+       232-Build-Command.
+GC0909     MOVE SPACES TO Cmd
+GC0909     MOVE 1 TO I
+           IF S-SUBROUTINE NOT = ' '
+           OR S-DLL NOT = ' '
+               STRING 'cobcrun ' DELIMITED SIZE
+                      INTO Cmd
+                      WITH POINTER I
+               END-STRING
+           END-IF
+           IF Prog-Folder NOT = SPACES
+GC0909         IF OS-Cygwin AND Prog-Folder (2:1) = ':'
+GC0909             STRING '/cygdrive/'
+GC0909                 INTO Cmd
+GC0909                 WITH POINTER I
+GC0909             END-STRING
+GC0909             STRING LOWER-CASE(Prog-Folder (1:1))
+GC0909                 INTO Cmd
+GC0909                 WITH POINTER I
+GC0909             END-STRING
+GC0909             PERFORM VARYING J FROM 3 BY 1
+GC0909                       UNTIL J > LENGTH(TRIM(Prog-Folder))
+GC0909                 IF Prog-Folder (J:1) = '\'
+GC0909                     STRING '/'
+GC0909                         INTO Cmd
+GC0909                         WITH POINTER I
+GC0909                     END-STRING
+GC0909                 ELSE
+GC0909                     STRING Prog-Folder (J:1)
+GC0909                         INTO Cmd
+GC0909                         WITH POINTER I
+GC0909                     END-STRING
+GC0909                 END-IF
+GC0909             END-PERFORM
+GC0909         ELSE
+GC0410             STRING '"' TRIM(Prog-Folder,TRAILING)
+GC0909                 INTO Cmd
+GC0909                 WITH POINTER I
+GC0909             END-STRING
+GC0909         END-IF
+GC0909         STRING Dir-Char
+GC0909             INTO Cmd
+GC0909             WITH POINTER I
+GC0909         END-STRING
+GC0909     ELSE
+GC0909         IF OS-Cygwin OR OS-UNIX
+GC0909             STRING './'
+GC0909                 INTO Cmd
+GC0909                 WITH POINTER I
+GC0909             END-STRING
+GC0909         END-IF
+           END-IF
+GC0909     STRING TRIM(Prog-Name,TRAILING)
+GC0909         INTO Cmd
+GC0909         WITH POINTER I
+GC0909     END-STRING
+GC0909     IF S-SUBROUTINE = ' '
+GC0909     AND S-DLL NOT = ' '
+GC0909         STRING '.exe' DELIMITED SIZE
+                      INTO Cmd
+                      WITH POINTER I
+               END-STRING
+           END-IF
+           IF S-ARGS NOT = SPACES
+GC0809         STRING ' ' TRIM(S-ARGS,TRAILING)
+                   INTO Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           IF OS-Unknown OR OS-Windows
+GC0410         STRING '"&&pause'
+                   INTO Cmd
+                   WITH POINTER I
+               END-STRING
+           ELSE
+               STRING ';echo "Press ENTER to close...";read'
+                   INTO Cmd
+                   WITH POINTER I
+               END-STRING
+           END-IF
+           .
+
+       233-Run-Program.
+GC0909     DISPLAY
+GC0909         Blank-Screen
+GC0909     END-DISPLAY
+
+           CALL 'SYSTEM'
+               USING TRIM(Cmd,TRAILING)
+           END-CALL
+           PERFORM 900-Terminate
+           .
+
+       239-Done.
+           EXIT.
+      /
+       900-Terminate SECTION.
+      *****************************************************************
+      ** Display a message and halt the program                      **
+      *****************************************************************
+
+       901-Display-Message.
+GC0909     IF Output-Message > SPACES
+GC0909         DISPLAY
+GC0909             Switches-Screen
+GC0909         END-DISPLAY
+GC0909         CALL 'C$SLEEP'
+GC0909             USING 2
+GC0909         END-CALL
+GC0909     END-IF
+           DISPLAY
+               Blank-Screen
+           END-DISPLAY
+           .
+
+       909-Done.
+           GOBACK
+           .
+
+       END PROGRAM OCic.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID.  GETOSTYPE.
+      *****************************************************************
+      ** This subprogram determine the OS type the program is run-   **
+      ** ning under, passing that result back in RETURN-CODE as fol- **
+      ** lows:                                                       **
+      **                                                             **
+      ** 0:   Cannot be determined                                   **
+      ** 1:   Native Windows or Windows/MinGW                        **
+      ** 2:   Cygwin                                                 **
+      ** 3:   UNIX/Linux/MacOS                                       **
+      *****************************************************************
+      **  DATE  CHANGE DESCRIPTION                                   **
+      ** ====== ==================================================== **
+      ** GC0909 Initial coding.                                      **
+      *****************************************************************
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION ALL INTRINSIC.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  Env-Path                    PIC X(1024).
+       01  Tally                       USAGE BINARY-LONG.
+       PROCEDURE DIVISION.
+       000-Main SECTION.
+       010-Get-TEMP-Var.
+           MOVE SPACES TO Env-Path
+           ACCEPT Env-Path
+               FROM ENVIRONMENT "PATH"
+               ON EXCEPTION
+                   MOVE 0 TO RETURN-CODE
+                   GOBACK
+           END-ACCEPT
+           IF Env-Path = SPACES
+               MOVE 0 TO RETURN-CODE
+           ELSE
+               MOVE 0 TO Tally
+               INSPECT Env-Path
+                   TALLYING Tally FOR ALL ";"
+               IF Tally = 0 *> Must be some form of UNIX
+                   MOVE 0 TO Tally
+                   INSPECT Env-Path
+                       TALLYING TALLY FOR ALL "/cygdrive/"
+                   IF Tally = 0 *> UNIX/MacOS
+                       MOVE 3 TO RETURN-CODE
+                   ELSE *> Cygwin
+                       MOVE 2 TO RETURN-CODE
+                   END-IF
+               ELSE *> Assume Windows[/MinGW]
+                   MOVE 1 TO RETURN-CODE
+               END-IF
+           END-IF
+           GOBACK
+           .
+       END PROGRAM GETOSTYPE.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID.  CHECKSOURCE.
+      *****************************************************************
+      ** This subprogram will scan a line of source code it is given **
+      ** looking for "LINKAGE SECTION" or "IDENTIFICATION DIVISION". **
+      **                                                             **
+      **  ****NOTE****   ****NOTE****    ****NOTE****   ****NOTE***  **
+      **                                                             **
+      ** These two strings must be found IN THEIR ENTIRETY within    **
+      ** the 1st 80 columns of program source records, and cannot    **
+      ** follow either a "*>" sequence OR a "*" in col 7.            **
+      *****************************************************************
+      **  DATE  CHANGE DESCRIPTION                                   **
+      ** ====== ==================================================== **
+      ** GC0809 Initial coding.                                      **
+      *****************************************************************
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION ALL INTRINSIC.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  Compressed-Src.
+           05 CS-Char                  OCCURS 80 TIMES PIC X(1).
+
+       01  Flags.
+           05 F-Found-SPACE            PIC X(1).
+              88 88-Skipping-SPACE     VALUE 'Y'.
+              88 88-Not-Skipping-SPACE VALUE 'N'.
+
+       01  I                           USAGE BINARY-CHAR.
+
+       01  J                           USAGE BINARY-CHAR.
+       LINKAGE SECTION.
+       01  Argument-1.
+           02 A1-Char                  OCCURS 80 TIMES PIC X(1).
+
+       01  Argument-2                  PIC X(1).
+           88 88-A2-LINKAGE-SECTION         VALUE 'L'.
+           88 88-A2-IDENTIFICATION-DIVISION VALUE 'I'.
+           88 88-A2-Nothing-Special         VALUE ' '.
+       PROCEDURE DIVISION USING Argument-1, Argument-2.
+       000-Main SECTION.
+
+       010-Initialize.
+           SET 88-A2-Nothing-Special TO TRUE
+           IF A1-Char (7) = '*'
+               GOBACK
+           END-IF
+           .
+
+       020-Compress-Multiple-SPACES.
+           SET 88-Not-Skipping-SPACE TO TRUE
+           MOVE 0 TO J
+           MOVE SPACES TO Compressed-Src
+           PERFORM VARYING I FROM 1 BY 1
+                     UNTIL I > 80
+               IF A1-Char (I) = SPACE
+                   IF 88-Not-Skipping-SPACE
+                       ADD 1 TO J
+                       MOVE UPPER-CASE(A1-Char (I)) TO CS-Char (J)
+                       SET 88-Skipping-SPACE TO TRUE
+                   END-IF
+               ELSE
+                   SET 88-Not-Skipping-SPACE TO TRUE
+                   ADD 1 TO J
+                   MOVE A1-Char (I) TO CS-Char (J)
+               END-IF
+           END-PERFORM
+           .
+
+       030-Scan-Compressed-Src.
+           PERFORM VARYING I FROM 1 BY 1
+                     UNTIL I > 66
+               EVALUATE TRUE
+                   WHEN CS-Char (I) = '*'
+                       IF Compressed-Src (I : 2) = '*>'
+                           GOBACK
+                       END-IF
+                   WHEN (CS-Char (I) = 'L') AND (I < 66)
+                       IF Compressed-Src (I : 15) = 'LINKAGE SECTION'
+                           SET 88-A2-LINKAGE-SECTION TO TRUE
+                           GOBACK
+                       END-IF
+                   WHEN (CS-Char (I) = 'I') AND (I < 58)
+                       IF Compressed-Src (I : 23) = 'IDENTIFICATION ' &
+                                                       'DIVISION'
+                           SET 88-A2-IDENTIFICATION-DIVISION TO TRUE
+                           GOBACK
+                       END-IF
+               END-EVALUATE
+           END-PERFORM
+           .
+
+       099-Never-Found-Either-One.
+           GOBACK
+           .
+       END PROGRAM CHECKSOURCE.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID.  LISTING.
+      *****************************************************************
+      ** This subprogram generates a cross-reference listing of an   **
+      ** OpenCOBOL program.                                          **
+      **                                                             **
+      ** Linkage:      CALL "LISTING" USING <source>                 **
+      **                                    <xref>                   **
+      **                                    <filename>               **
+      **                                                             **
+      **               Where:                                        **
+      **                  <source>   is a PIC X(1) flag indicating   **
+      **                             whether or not a source listing **
+      **                             should be produced (space=NO,   **
+      **                             non-space=yes)                  **
+      **                  <xref>     is a PIC X(1) flag indicating   **
+      **                             whether or not an xref listing  **
+      **                             should be produced (space=NO,   **
+      **                             non-space=yes)                  **
+      **                  <filename> is the [path]filename of the    **
+      **                             program being listed and/or     **
+      **                             xreffed in a PIC X(256) form.   **
+      *****************************************************************
+      **                                                             **
+      ** AUTHOR:       GARY L. CUTLER                                **
+      **               CutlerGL@gmail.com                            **
+      **               Copyright (C) 2010, Gary L. Cutler, GPL       **
+      **                                                             **
+      ** DATE-WRITTEN: April 1, 2010                                 **
+      **                                                             **
+      *****************************************************************
+      **  DATE  CHANGE DESCRIPTION                                   **
+      ** ====== ==================================================== **
+      ** GC0410 Initial coding                                       **
+      ** GC0710 Handle duplicate data names (i.e. "CORRESPONDING" or **
+      **        qualified items) better; ignore "END PROGRAM" recs   **
+      **        so program name doesn't appear in listing.           **
+      *****************************************************************
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION ALL INTRINSIC.
+       INPUT-OUTPUT SECTION.
+       FILE-CONTROL.
+           SELECT Expand-Code          ASSIGN TO Expanded-Src-Filename
+                                       ORGANIZATION IS LINE SEQUENTIAL.
+           SELECT Report-File          ASSIGN TO Report-Filename
+                                       ORGANIZATION IS LINE SEQUENTIAL.
+           SELECT Sort-File            ASSIGN TO DISK.
+           SELECT Source-Code          ASSIGN TO Src-Filename
+                                       ORGANIZATION IS LINE SEQUENTIAL.
+       DATA DIVISION.
+       FILE SECTION.
+       FD  Expand-Code.
+       01  Expand-Code-Rec.
+           05 ECR-1                    PIC X.
+           05 ECR-2-256                PIC X(256).
+       01  Expand-Code-Rec-Alt.
+           05 ECR-1-128                PIC X(128).
+           05 ECR-129-256              PIC X(128).
+
+       FD  Report-File.
+       01  Report-Rec                  PIC X(135).
+
+       SD  Sort-File.
+       01  Sort-Rec.
+           05 SR-Prog-ID               PIC X(15).
+           05 SR-Token-UC              PIC X(32).
+           05 SR-Token                 PIC X(32).
+           05 SR-Section               PIC X(15).
+           05 SR-Line-No-Def           PIC 9(6).
+           05 SR-Reference.
+              10 SR-Line-No-Ref        PIC 9(6).
+              10 SR-Ref-Flag           PIC X(1).
+
+       FD  Source-Code.
+       01  Source-Code-Rec.
+GC0410     05 SCR-1-128.
+GC0410        10 FILLER                PIC X(6).
+GC0410        10 SCR-7                 PIC X(1).
+GC0410        10 FILLER                PIC X(121).
+           05 SCR-129-256              PIC X(128).
+
+       WORKING-STORAGE SECTION.
+       78  Line-Nos-Per-Rec            VALUE 8.
+
+       01  Cmd                         PIC X(256).
+
+       01  Delim                       PIC X(2).
+
+       01  Detail-Line-S.
+           05 DLS-Line-No              PIC ZZZZZ9.
+           05 FILLER                   PIC X(1).
+           05 DLS-Statement            PIC X(128).
+
+       01  Detail-Line-X.
+           05 DLX-Prog-ID              PIC X(15).
+           05 FILLER                   PIC X(1).
+           05 DLX-Token                PIC X(32).
+           05 FILLER                   PIC X(1).
+           05 DLX-Line-No-Def          PIC ZZZZZ9.
+           05 FILLER                   PIC X(1).
+           05 DLX-Section              PIC X(15).
+           05 FILLER                   PIC X(1).
+           05 DLX-Reference            OCCURS Line-Nos-Per-Rec TIMES.
+              10 DLX-Line-No-Ref       PIC ZZZZZ9.
+              10 DLX-Ref-Flag          PIC X(1).
+              10 FILLER                PIC X(1).
+
+       01  Dummy                       PIC X(1).
+
+       01  Env-TEMP                    PIC X(256).
+
+       01  Expanded-Src-Filename       PIC X(256).
+
+       01  Filename                    PIC X(256).
+
+       01  Flags.
+GC0710     05 F-Duplicate              PIC X(1).
+           05 F-First-Record           PIC X(1).
+           05 F-In-Which-Pgm           PIC X(1).
+              88 In-Main-Module        VALUE 'M'.
+              88 In-Copybook           VALUE 'C'.
+           05 F-Last-Token-Ended-Sent  PIC X(1).
+           05 F-Processing-PICTURE     PIC X(1).
+           05 F-Token-Ended-Sentence   PIC X(1).
+GC0710     05 F-Verb-Has-Been-Found    PIC X(1).
+
+       01  Group-Indicators.
+           05 GI-Prog-ID               PIC X(15).
+           05 GI-Token                 PIC X(32).
+
+       01  Heading-1S.
+           05 FILLER                   PIC X(125) VALUE
+              "OpenCOBOL 1.1 06FEB2009 Source Listing - " &
+              "OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL".
+           05 H1S-Date                 PIC 9999/99/99.
+
+       01  Heading-1X.
+           05 FILLER                   PIC X(125) VALUE
+              "OpenCOBOL 1.1 06FEB2009 Cross-Reference Listing - " &
+              "OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL".
+           05 H1X-Date                 PIC 9999/99/99.
+
+       01  Heading-2                   PIC X(135).
+
+       01  Heading-4S                  PIC X(16) VALUE
+           "Line   Statement".
+
+       01  Heading-4X                  PIC X(96) VALUE
+           "PROGRAM-ID      Identifier/Register/Function     Defn   Wher
+      -    "e Defined   References (* = Updated)".
+
+       01  Heading-5S                  PIC X(135) VALUE
+           "====== =====================================================
+      -    "============================================================
+      -    "===============".
+
+       01  Heading-5X                  PIC X(135) VALUE
+           "=============== ================================ ====== ====
+      -    "=========== ================================================
+      -    "===============".
+
+       01  Held-Reference              PIC X(100).
+
+       01  I                           USAGE BINARY-LONG.
+
+       01  J                           USAGE BINARY-LONG.
+
+       01  Lines-Left                  USAGE BINARY-LONG.
+
+       01  Lines-Per-Page              USAGE BINARY-LONG.
+
+       01  Lines-Per-Page-ENV          PIC X(256).
+
+       01  Num-UserNames               USAGE BINARY-LONG.
+
+       01  PIC-X10                     PIC X(10).
+
+       01  PIC-X32                     PIC X(32).
+
+       01  PIC-X256                    PIC X(256).
+
+       01  Program-Path                PIC X(256).
+
+       01  Report-Filename             PIC X(256).
+
+       01  Reserved-Words.
+           05 FILLER PIC X(33) VALUE "IABS".
+           05 FILLER PIC X(33) VALUE "VACCEPT".
+           05 FILLER PIC X(33) VALUE " ACCESS".
+           05 FILLER PIC X(33) VALUE "IACOS".
+           05 FILLER PIC X(33) VALUE " ACTIVE-CLASS".
+           05 FILLER PIC X(33) VALUE "VADD".
+           05 FILLER PIC X(33) VALUE " ADDRESS".
+           05 FILLER PIC X(33) VALUE " ADVANCING".
+           05 FILLER PIC X(33) VALUE "KAFTER".
+           05 FILLER PIC X(33) VALUE " ALIGNED".
+           05 FILLER PIC X(33) VALUE " ALL".
+           05 FILLER PIC X(33) VALUE "VALLOCATE".
+           05 FILLER PIC X(33) VALUE " ALPHABET".
+           05 FILLER PIC X(33) VALUE " ALPHABETIC".
+           05 FILLER PIC X(33) VALUE " ALPHABETIC-LOWER".
+           05 FILLER PIC X(33) VALUE " ALPHABETIC-UPPER".
+           05 FILLER PIC X(33) VALUE " ALPHANUMERIC".
+           05 FILLER PIC X(33) VALUE " ALPHANUMERIC-EDITED".
+           05 FILLER PIC X(33) VALUE " ALSO".
+           05 FILLER PIC X(33) VALUE "VALTER".
+           05 FILLER PIC X(33) VALUE " ALTERNATE".
+           05 FILLER PIC X(33) VALUE " AND".
+           05 FILLER PIC X(33) VALUE "IANNUITY".
+           05 FILLER PIC X(33) VALUE " ANY".
+           05 FILLER PIC X(33) VALUE " ANYCASE".
+           05 FILLER PIC X(33) VALUE " ARE".
+           05 FILLER PIC X(33) VALUE " AREA".
+           05 FILLER PIC X(33) VALUE " AREAS".
+           05 FILLER PIC X(33) VALUE " ARGUMENT-NUMBER".
+           05 FILLER PIC X(33) VALUE " ARGUMENT-VALUE".
+           05 FILLER PIC X(33) VALUE " AS".
+           05 FILLER PIC X(33) VALUE " ASCENDING".
+           05 FILLER PIC X(33) VALUE "IASIN".
+           05 FILLER PIC X(33) VALUE " ASSIGN".
+           05 FILLER PIC X(33) VALUE " AT".
+           05 FILLER PIC X(33) VALUE "IATAN".
+           05 FILLER PIC X(33) VALUE " AUTHOR".
+           05 FILLER PIC X(33) VALUE " AUTO".
+           05 FILLER PIC X(33) VALUE " AUTO-SKIP".
+           05 FILLER PIC X(33) VALUE " AUTOMATIC".
+           05 FILLER PIC X(33) VALUE " AUTOTERMINATE".
+           05 FILLER PIC X(33) VALUE " BACKGROUND-COLOR".
+           05 FILLER PIC X(33) VALUE " BASED".
+           05 FILLER PIC X(33) VALUE " BEEP".
+           05 FILLER PIC X(33) VALUE " BEFORE".
+           05 FILLER PIC X(33) VALUE " BELL".
+           05 FILLER PIC X(33) VALUE " BINARY".
+           05 FILLER PIC X(33) VALUE " BINARY-C-LONG".
+           05 FILLER PIC X(33) VALUE " BINARY-CHAR".
+           05 FILLER PIC X(33) VALUE " BINARY-DOUBLE".
+           05 FILLER PIC X(33) VALUE " BINARY-LONG".
+           05 FILLER PIC X(33) VALUE " BINARY-SHORT".
+           05 FILLER PIC X(33) VALUE " BIT".
+           05 FILLER PIC X(33) VALUE " BLANK".
+           05 FILLER PIC X(33) VALUE " BLINK".
+           05 FILLER PIC X(33) VALUE " BLOCK".
+           05 FILLER PIC X(33) VALUE " BOOLEAN".
+           05 FILLER PIC X(33) VALUE " BOTTOM".
+           05 FILLER PIC X(33) VALUE "YBY".
+           05 FILLER PIC X(33) VALUE "IBYTE-LENGTH".
+           05 FILLER PIC X(33) VALUE "MC01".
+           05 FILLER PIC X(33) VALUE "MC02".
+           05 FILLER PIC X(33) VALUE "MC03".
+           05 FILLER PIC X(33) VALUE "MC04".
+           05 FILLER PIC X(33) VALUE "MC05".
+           05 FILLER PIC X(33) VALUE "MC06".
+           05 FILLER PIC X(33) VALUE "MC07".
+           05 FILLER PIC X(33) VALUE "MC08".
+           05 FILLER PIC X(33) VALUE "MC09".
+           05 FILLER PIC X(33) VALUE "MC10".
+           05 FILLER PIC X(33) VALUE "MC11".
+           05 FILLER PIC X(33) VALUE "MC12".
+           05 FILLER PIC X(33) VALUE "VCALL".
+           05 FILLER PIC X(33) VALUE "VCANCEL".
+           05 FILLER PIC X(33) VALUE " CF".
+           05 FILLER PIC X(33) VALUE " CH".
+           05 FILLER PIC X(33) VALUE " CHAINING".
+           05 FILLER PIC X(33) VALUE "ICHAR".
+           05 FILLER PIC X(33) VALUE " CHARACTER".
+           05 FILLER PIC X(33) VALUE " CHARACTERS".
+           05 FILLER PIC X(33) VALUE " CLASS".
+           05 FILLER PIC X(33) VALUE " CLASS-ID".
+           05 FILLER PIC X(33) VALUE "VCLOSE".
+           05 FILLER PIC X(33) VALUE "ICOB-CRT-STATUS".
+           05 FILLER PIC X(33) VALUE " CODE".
+           05 FILLER PIC X(33) VALUE " CODE-SET".
+           05 FILLER PIC X(33) VALUE " COL".
+           05 FILLER PIC X(33) VALUE " COLLATING".
+           05 FILLER PIC X(33) VALUE " COLS".
+           05 FILLER PIC X(33) VALUE " COLUMN".
+           05 FILLER PIC X(33) VALUE " COLUMNS".
+           05 FILLER PIC X(33) VALUE "ICOMBINED-DATETIME".
+           05 FILLER PIC X(33) VALUE " COMMA".
+           05 FILLER PIC X(33) VALUE " COMMAND-LINE".
+           05 FILLER PIC X(33) VALUE "VCOMMIT".