       >>SOURCE FORMAT IS VARIABLE
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MAIN.
      *>************************************************************************
      *> Please read the file gcic-readme.html file, which should be included **
      *> in the distribution of this file.                                    **
      *>************************************************************************
      *> AUTHOR:       Gary L. Cutler (GLC)                                   **
      *>               Copyright (C) 2009-2022, Gary L. Cutler, GPL           **
      *> CONTRIBUTORS: Vince B. Coen (VBC)                                    **
      *> DATE-WRITTEN: June 14, 2009                                          **
      *> LAST-UPDATED: August 7, 2022                                         **
      *>************************************************************************
      *> For a record of changes, see "gcic-readme.html" file                 **
      *>************************************************************************
       ENVIRONMENT DIVISION.
      *> Cobc Switches: -x -std=default
LOCAL *> Cobc Switches: -lpdcurses
LOCAL *> On Success:                          Set-Icon   gcic.exe      gcic.ico          gcic.lst
LOCAL *> On Success:                          PromoteToP \GnuCOBOL\bin gcic.exe COPY     gcic.lst
LOCAL *> On Success:    START /MIN cmd.exe /C Promote    bin           gcic.exe MOVEWAIT gcic.lst
      *>************************************************************************
      *> Configuration settings - see "gcic-readme.html" for explanations     **
      *>************************************************************************
       >>DEFINE CONSTANT CMDMAXSIZE 8191                  *> Max chars in "cobc" command
       >>DEFINE CONSTANT DEF        '^'                   *> Xref "line number defined at" char
       >>DEFINE CONSTANT F1         1                     *> Debugging feature default option #
       >>DEFINE CONSTANT F2         1                     *> Run-time Err Checking feature default option #
       >>DEFINE CONSTANT F3         1                     *> Generate Tracing Code feature default option #
       >>DEFINE CONSTANT F4         1                     *> Compiler Output feature default option #
       >>DEFINE CONSTANT F5         1                     *> Run After Compilation feature default option #
       >>DEFINE CONSTANT F6         1                     *> Source & Xref Listing feature default option #
       >>DEFINE CONSTANT F7         1                     *> Listing Generated By feature default option #
       >>DEFINE CONSTANT F8         2                     *> Commands and Warnings feature default option #
       >>DEFINE CONSTANT F9         2                     *> FUNCTION w/ Intrinsics feature default option #
       >>DEFINE CONSTANT F10        3                     *> Program Source Format feature default option #
       >>DEFINE CONSTANT F11        2                     *> Truncate COMP to PIC feature default option #
       >>DEFINE CONSTANT F12        1                     *> Optimization feature default option #
       >>DEFINE CONSTANT F13        1                     *> Dump DATA DIV on Abort feature default option #
       >>DEFINE CONSTANT F14        8                     *> Behavior & Standards feature default option #
       >>DEFINE CONSTANT F15        2                     *> Pgm-Specified Switches feature default option #
       >>DEFINE CONSTANT F16        1                     *> Save Temporary Files feature default option #
       >>DEFINE CONSTANT F17        1                     *> 'On Success' Commands feature default option #
       >>DEFINE CONSTANT FASTSIZE   50                    *> "Files and Statuses" size
       >>DEFINE CONSTANT GCICVER    '2.0 Rc4'             *> Version/Release
       >>DEFINE CONSTANT LINEDRAW   1                     *> Line-drawing option for screen
       >>DEFINE CONSTANT LISTEXT    '.lst'                *> Listing file extension
       >>DEFINE CONSTANT LOCKFILE   1                     *> Locking feature on (1) or off (0)
       >>DEFINE CONSTANT LPP        51                    *> Printable lines-per-page (landscape)
       >>DEFINE CONSTANT LPPP       78                    *> Printable lines-per-page (portrait)
       >>DEFINE CONSTANT MAXSWITCH  200                   *> Max # of switches on "cobc" command
       >>DEFINE CONSTANT OS         3                     *> 0 = Determine OS Automatically
       >>DEFINE CONSTANT OSCQTY     10                    *> Max # of "On Success" commands
LOCAL  >>DEFINE CONSTANT OSCQTY     20    OVERRIDE        *> LOCAL OVERRIDE: Max # of "On Success" commands
       >>DEFINE CONSTANT PROMPTCHAR ' '                   *> Screen PROMPT character
       >>DEFINE CONSTANT PSSQTY     5                     *> Max # of Program-Specified switches
       >>DEFINE CONSTANT PSTACKSIZE 50                    *> Procedure stack size - maximum PERFORM/CALL depth
       >>DEFINE CONSTANT RAFTSIZE   150                   *> "Records and Files" table size
       >>DEFINE CONSTANT RESIZE     0                     *> Resize screen method (1=determine from OS)
LOCAL  >>DEFINE CONSTANT RESIZE     0     OVERRIDE        *> Resize screen method (6=Use curses)
       >>DEFINE CONSTANT RESIZESEQ  ' '                   *> Command OR ESC sequence to resize screen (ESC will be added automatically)
       >>DEFINE CONSTANT REF        ' '                   *> Xref "line number referenced at" char
       >>DEFINE CONSTANT RWTSIZE    2047                  *> "Reserved Words Table" size
       >>DEFINE CONSTANT STACKSIZE  50                    *> Arithmetic operand "Stack" size
       >>DEFINE CONSTANT STSIZE     7500                  *> "Symbol Table" size
       >>DEFINE CONSTANT UPD        '*'                   *> Xref "line number updated at" char
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
           CURSOR Cursor-Coordinates.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT COBC-Messages-File ASSIGN TO Messages-Filename  ORGANIZATION IS LINE SEQUENTIAL.
           SELECT COBC-Output-File   ASSIGN TO "gcic-output.txt"  ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Source-Code-File   ASSIGN TO Source-Filename    ORGANIZATION IS LINE SEQUENTIAL.

       DATA DIVISION.
       FILE SECTION.
       FD  COBC-Messages-File.                             *> Commands, messages, and source/xref listing
       01  COBC-Messages-Rec           PIC X(132).

       FD  COBC-Output-File.                               *> COBC Source/Xref *or* COBC Source/symbol-Table
       01  COBC-Output-Rec             PIC X(120).

       FD  Source-Code-File.                               *> Program source code file
       01  Source-Code-Rec             PIC X(320).

       WORKING-STORAGE SECTION.

       COPY screenio.                                      *> Define SCREEN SECTION constants

       01  Arg-Value                   PIC X(12).          *> Debugging command line argument

       01  Banner                      PIC X(104).         *> Banner line (top screen line)

       01  Bottom-Line-Back            PIC 9(2).           *> Background color of bottom line

       01  Bottom-Line-Text            PIC 9(2).           *> Text color of bottom line

       01  Button-Colors-FILLER.                           *> Function button foreground (Text) & background colors
           05 BC-F1-Back               PIC 9(2).
           05 BC-F1-Text               PIC 9(2).
           05 BC-F2-Back               PIC 9(2).
           05 BC-F2-Text               PIC 9(2).
           05 BC-F3-Back               PIC 9(2).
           05 BC-F3-Text               PIC 9(2).
           05 BC-F4-Back               PIC 9(2).
           05 BC-F4-Text               PIC 9(2).
           05 BC-F5-Back               PIC 9(2).
           05 BC-F5-Text               PIC 9(2).
           05 BC-F6-Back               PIC 9(2).
           05 BC-F6-Text               PIC 9(2).
           05 BC-F7-Back               PIC 9(2).
           05 BC-F7-Text               PIC 9(2).
           05 BC-F8-Back               PIC 9(2).
           05 BC-F8-Text               PIC 9(2).
           05 BC-F9-Back               PIC 9(2).
           05 BC-F9-Text               PIC 9(2).
           05 BC-F10-Back              PIC 9(2).
           05 BC-F10-Text              PIC 9(2).
           05 BC-F11-Back              PIC 9(2).
           05 BC-F11-Text              PIC 9(2).
           05 BC-F12-Back              PIC 9(2).
           05 BC-F12-Text              PIC 9(2).
           05 BC-F13-Back              PIC 9(2).
           05 BC-F13-Text              PIC 9(2).
           05 BC-F14-Back              PIC 9(2).
           05 BC-F14-Text              PIC 9(2).
           05 BC-F15-Back              PIC 9(2).
           05 BC-F15-Text              PIC 9(2).
           05 BC-F16-Back              PIC 9(2).
           05 BC-F16-Text              PIC 9(2).
           05 BC-F17-Back              PIC 9(2).
           05 BC-F17-Text              PIC 9(2).
           05 BC-F18-Back              PIC 9(2).           *> Unused
           05 BC-F18-Text              PIC 9(2).           *> Unused
           05 BC-F19-Back              PIC 9(2).           *> Unused
           05 BC-F19-Text              PIC 9(2).           *> Unused
           05 BC-F20-Back              PIC 9(2).           *> Unused
           05 BC-F20-Text              PIC 9(2).           *> Unused
       01  Button-Colors               REDEFINES Button-Colors-FILLER.
           05 BC-Color-Tbl             OCCURS 22 TIMES.
              10 BC-Back               PIC 9(2).
              10 BC-Text               PIC 9(2).

       01  Button-FILLER.
      *>************************************************************************
      *> Button coordinates for the four two-line entry fields                **
      *>************************************************************************
           05 PIC X(21) VALUE "018003104NOP".              *> COBCPY COPY Libraries
           05 PIC X(21) VALUE "020003104NOP".              *> Additional 'cobc' Switches
           05 PIC X(21) VALUE "022003104NOP".              *> Additional 'cobc' Arguments
           05 PIC X(21) VALUE "024003104NOP".              *> Program Execution Arguments (line 1)
           05 PIC X(21) VALUE "025003104NOP".              *> Program Execution Arguments (line 2)
      *>************************************************************************
      *> Button coordinates for the seventeen function option buttons         **
      *>************************************************************************
           05 PIC X(21) VALUE "008004025F01".              *> Debugging
           05 PIC X(21) VALUE "010004025F02".              *> Run-time Err Checking
           05 PIC X(21) VALUE "012004025F03".              *> Generate Tracing Code
           05 PIC X(21) VALUE "014004025F04".              *> Compiler Output
           05 PIC X(21) VALUE "016004025F05".              *> Run After Compilation
           05 PIC X(21) VALUE "008027048F06".              *> Source & Xref Listing
           05 PIC X(21) VALUE "010027048F07".              *> Listing Produced By
           05 PIC X(21) VALUE "012027048F08".              *> FUNCTION w/ Intrinsics
           05 PIC X(21) VALUE "014027048F09".              *> Commands and Warnings
           05 PIC X(21) VALUE "016027048F10".              *> Program Source Format
           05 PIC X(21) VALUE "008050071F11".              *> Truncate COMP to PIC
           05 PIC X(21) VALUE "010050071F12".              *> Optimization
           05 PIC X(21) VALUE "012050071F13".              *> Dump DATA DIV on Abort
           05 PIC X(21) VALUE "014050071F14".              *> Behavior & Standards
           05 PIC X(21) VALUE "016050071F15".              *> Pgm-Specified Switches
           05 PIC X(21) VALUE "008073094F16".              *> Save Temporary Files
           05 PIC X(21) VALUE "010073094F17".              *> 'On Success' Commands
      *>   05 PIC X(21) VALUE "012073094F18".              *> Unused
      *>   05 PIC X(21) VALUE "014073094F19".              *> Unused
      *>   05 PIC X(21) VALUE "016073094F20".              *> Unused
      *>************************************************************************
      *> Button coordinates for the main screen static buttons                **
      *>************************************************************************
           05 PIC X(21) VALUE "008096103OK    OK   8".     *> All captions must have at least ONE...
           05 PIC X(21) VALUE "010096103CAN CANCEL 8".     *> leading and ONE trailing space
           05 PIC X(21) VALUE "012096103HLP  HELP  8".
           05 PIC X(21) VALUE LOW-VALUES.                  *> Must be last entry
       01  All-Buttons REDEFINES Button-FILLER.
           05 Button-Tbl               OCCURS 26 TIMES
                                       INDEXED BY Button-Idx.
              10 BT-Row                PIC 9(3).           *> The screen row number where the button resides
              10 BT-Col-Start          PIC 9(3).           *> The screen column where the button begins
              10 BT-Col-End            PIC 9(3).           *> The screen column where the button ends
              10 BT-ID.                                    *> Three-character button function, or...
                 15 BT-ID-Type         PIC X(1).           *> ...The letter "F", followed by...
                 15 BT-Function-No     PIC 9(2).           *> ...The 2-digit function button # (01-15)
              10 BT-Caption            PIC X(8).           *> Fixed-caption btns (OK, HELP, ...), caption text
              10 BT-Caption-Size       PIC 9(1).           *> The size (chars) of the caption

       01  Cmd.                                            *> Buffer commands GCic submits to the OS
           05 OCCURS CMDMAXSIZE        PIC X(1).

       01  COB-COPY-DIR-Env            PIC X(256).         *> COB-COPY-DIR environment variable

       01  COB-MOUSE-FLAGS             PIC 9(4).           *> Bit mask for mouse-events to be captured

       01  Cobc-Cmd.                                       *> Buffer used to create a "cobc" command
           05 OCCURS CMDMAXSIZE        PIC X(1).

       01  Cobc-Switches.                                  *> The cobc switches get built here
           05 OCCURS CMDMAXSIZE        PIC X(1).

       01  Cobc-Switch-Table.                              *> Used to eliminate duplicate switches
           05 CST-Sub                  PIC 9(4).
           05 CST-Switch-Arg           PIC X(256).         *> Argument for 035-Load-Switches
           05 Cobc-Switch-Tbl          OCCURS MAXSWITCH TIMES
                                       DESCENDING KEY CST-Switch.
              10 CST-Switch            PIC X(256).         *> "-xxx", "-xxx arg", "-xxx=arg"
              10 CST-Switch-Name       PIC X(256).         *> "-xxx" Only
              10 CST-Dup               PIC X(1).

       01  Compile-Status              PIC X(4).           *> Compilation result flag
           88 CS-Compile-Clean         VALUE "OK  ".
           88 CS-Compile-Failed        VALUE "FAIL".

       01  Config-Switch               PIC X(30).          *> Will be passed to LISTER for "-list-reserved"

       01  Copyright                   PIC X(104).         *> Copyright line for last screen line and reports

       01  Cursor-Coordinates          PIC 9(6).           *> Location of cursor on screen ACCEPTs
       01  REDEFINES Cursor-Coordinates.
           05 CC-Row                   PIC 9(3).
           05 CC-Col                   PIC 9(3).

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  Debugging-Mode              PIC X(1).           *> Y/N flag for DEBUGGING MODE.
           88 DM-Debugging-Active      VALUE 'Y', FALSE 'N'.

       01  Dummy                       PIC X(1).           *> Dummy Input Field For Help Screens

       01  Entry-Fields.                                   *> Data entry lines and corresponding merged fields
           05 EF-COPY                  PIC X(102).
           05 EF-CompilerArgs          PIC X(102).
           05 EF-Switches              PIC X(102).
           05 EF-ProgramArgs.
              10 EF-ProgramArgs-1      PIC X(102).
              10 EF-ProgramArgs-2      PIC X(102).
              10 EF-ProgramArgs-All    PIC X(205).

       01  Error-Msg-Arg.
           05 EMA-AAAA                 PIC 9(4).
           05 EMA-BBBB                 PIC 9(4).
           05 EMA-X1X                  PIC X(1).

       01  Error-Messages-FILLER.
           05 PIC X(90) VALUE " Fatal Error: No program filename was specified                    ". *> 01
           05 PIC X(90) VALUE " Fatal Error: 'Option-Tbl' OCCURS count is AAAA, should be BBBB    ". *> 02
           05 PIC X(90) VALUE " Fatal Error: 'Button-Tbl' OCCURS count is AAAA, should be BBBB    ". *> 03
           05 PIC X(90) VALUE " Fatal Error: 'Temp-File' OCCURS count is AAAA, should be BBBB     ". *> 04
           05 PIC X(90) VALUE " Compilation Failed - Correct error and try again                  ". *> 05 [1]
           05 PIC X(90) VALUE " Fatal Error: LISTER module is not available                       ". *> 06
           05 PIC X(90) VALUE " Fatal Error: 'All-Verbs-Tbl' OCCURS count is AAAA, should be BBBB ". *> 07
           05 PIC X(90) VALUE " Fatal Error: 'Buzzwords-Tbl' OCCURS count is AAAA, should be BBBB ". *> 08
           05 PIC X(90) VALUE " Fatal Error: LISTER Could Not Open Expanded Source File           ". *> 09
           05 PIC X(90) VALUE " Fatal Error: 'Reserved-Word-Tbl' is full - Increase RWTSIZE       ". *> 10
           05 PIC X(90) VALUE " Fatal Error: Unexpected character ('@') found in 405-State-1      ". *> 11
           05 PIC X(90) VALUE " Fatal Error: 'Stack-Entry' is full - Increase STACKSIZE           ". *> 12
           05 PIC X(90) VALUE " Fatal Error: 'Records-And-Files-Tbl' is full - Increase RAFTSIZE  ". *> 13
           05 PIC X(90) VALUE " Fatal Error: 'Files-And-Statuses-Tbl' is full - Increase FASTSIZE ". *> 14
           05 PIC X(90) VALUE " Fatal Error: 'ST-Entry' is full - Increase STSIZE                 ". *> 15
           05 PIC X(90) VALUE " Fatal Error: Undefined error message code: AAAA                   ". *> 16
           05 PIC X(90) VALUE " Fatal Error: Missing Option in Option-tbl (AAAA)                  ". *> 17
           05 PIC X(90) VALUE " Fatal Error: Specified source program file does not exist         ". *> 18
           05 PIC X(90) VALUE " Fatal Error: 'Function-Tbl' OCCURS count is AAAA, should be BBBB  ". *> 19
      *> [1] Error #5 is recoverable
       01  Error-Messages-Tbl REDEFINES Error-Messages-FILLER.
           05 Error-Msg                OCCURS 19 TIMES
                                       PIC X(90).

       01  Exit-Code                   PIC S9(4).          *> Argument to 099-Terminate

       01  Flags.
           05 F-Cancel-Flag            PIC X(1).           *> "Y" = user clicked "CANCEL" or pressed ESC
              88 FCF-User-Wants-Out    VALUE "Y",
                                       FALSE "N".
           05 F-Delete-Temps           PIC X(1).           *> "Y" = it's OK to delete temp files
              88 FDT-Delete-Temps      VALUE "Y",
                                       FALSE "N".
           05 F-PSS-Scanned            PIC X(1).           *> "Y" = Already did a PSS Scan
              88 FPSSS-Scanned         VALUE "Y",
                                       FALSE "N".
           05 F-Screen-Refresh         PIC X(1).           *> "Y" = Need to refresh display
              88 FSR-Refresh-Needed    VALUE "Y",
                                       FALSE "N".
           05 F-Subprog-Search         PIC X(1).
              88 FLS-LINKAGE-SECTION   VALUE "L",          *> "L" = found LINKAGE SECTION
                                       FALSE " ".
              88 FLS-END-PROGRAM       VALUE "E".          *> "E" = hit END PROGRAM, before LINKAGE SECTION
              88 FLS-Hit-EOF           VALUE "X".          *> "X" = hit EOF w/o finding either of the above
              88 FLS-Done              VALUE "E" OR "L"    *> "TRUE" = any of the above has become "TRUE"
                                          OR "X".

       01  Function-Captions.                              *> Current on-screen captions for function buttons
           05 F1-Caption               PIC X(22).
           05 F2-Caption               PIC X(22).
           05 F3-Caption               PIC X(22).
           05 F4-Caption               PIC X(22).
           05 F5-Caption               PIC X(22).
           05 F6-Caption               PIC X(22).
           05 F7-Caption               PIC X(22).
           05 F8-Caption               PIC X(22).
           05 F9-Caption               PIC X(22).
           05 F10-Caption              PIC X(22).
           05 F11-Caption              PIC X(22).
           05 F12-Caption              PIC X(22).
           05 F13-Caption              PIC X(22).
           05 F14-Caption              PIC X(22).
           05 F15-Caption              PIC X(22).
           05 F16-Caption              PIC X(22).
           05 F17-Caption              PIC X(22).
      *>   05 F18-Caption              PIC X(22).
      *>   05 F19-Caption              PIC X(22).
      *>   05 F20-Caption              PIC X(22).
       01  REDEFINES Function-Captions.
           05 FCT-Caption              OCCURS 17 TIMES
                                       PIC X(22).

       01  Function-FILLER.                                *> Function button characteristics
           05 Function-No              PIC 9(2) VALUE 0.   *> Subscript of most-recently clicked function button
      *>   ------------------------------------------------------------------------
      *>   Function 1 - Debugging
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F1.                           *> FT-Curr-Opt-No   (1)
           05 PIC 9(2) VALUE F1.                           *> FT-Default-Opt-No(1)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (1)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 2 - Run-time Err Checking
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F2.                           *> FT-Curr-Opt-No   (2)
           05 PIC 9(2) VALUE F2.                           *> FT-Default-Opt-No(2)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (2)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 3 - Generate Tracing Code
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F3.                           *> FT-Curr-Opt-No   (3)
           05 PIC 9(2) VALUE F3.                           *> FT-Default-Opt-No(3)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (3)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 4 - Compiler Output
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F4.                           *> FT-Curr-Opt-No   (4)
           05 PIC 9(2) VALUE F4.                           *> FT-Default-Opt-No(4)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (4)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 5 - Run After Compilation
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F5.                           *> FT-Curr-Opt-No   (5)
           05 PIC 9(2) VALUE F5.                           *> FT-Default-Opt-No(5)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (5)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 6 - Source & Xref Listing
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F6.                           *> FT-Curr-Opt-No   (6)
           05 PIC 9(2) VALUE F6.                           *> FT-Default-Opt-No(6)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (6)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 7 - Listing Produced By
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F7.                           *> FT-Curr-Opt-No   (7)
           05 PIC 9(2) VALUE F7.                           *> FT-Default-Opt-No(7)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (7)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 8 - FUNCTION w/ Intrinsics
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F8.                           *> FT-Curr-Opt-No   (8)
           05 PIC 9(2) VALUE F8.                           *> FT-Default-Opt-No(8)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (8)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 9 - Commands and Warnings
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F9.                           *> FT-Curr-Opt-No   (9)
           05 PIC 9(2) VALUE F9.                           *> FT-Default-Opt-No(9)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (9)  Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 10 - Program Source Format
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F10.                          *> FT-Curr-Opt-No   (10)
           05 PIC 9(2) VALUE F10.                          *> FT-Default-Opt-No(10)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (10) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 11 - Truncate COMP to PIC
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F11.                          *> FT-Curr-Opt-No   (11)
           05 PIC 9(2) VALUE F11.                          *> FT-Default-Opt-No(11)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (11) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 12 - Optimization
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F12.                          *> FT-Curr-Opt-No   (12)
           05 PIC 9(2) VALUE F12.                          *> FT-Default-Opt-No(12)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (12) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 13 - Dump DATA DIV on Abort
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F13.                          *> FT-Curr-Opt-No   (13)
           05 PIC 9(2) VALUE F13.                          *> FT-Default-Opt-No(13)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (13) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 14 - Behavior & Standards
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F14.                          *> FT-Curr-Opt-No   (14)
           05 PIC 9(2) VALUE F14.                          *> FT-Default-Opt-No(14)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (14) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 15 - Pgm-Specific Switches
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F15.                          *> FT-Curr-Opt-No   (15)
           05 PIC 9(2) VALUE F15.                          *> FT-Default-Opt-No(15)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (15) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 16 - Save Temporary Files
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F16.                          *> FT-Curr-Opt-No   (16)
           05 PIC 9(2) VALUE F16.                          *> FT-Default-Opt-No(16)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (16) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 17 - 'On Success' Commands
      *>   ------------------------------------------------------------------------
           05 PIC 9(2) VALUE F17.                          *> FT-Curr-Opt-No   (17)
           05 PIC 9(2) VALUE F17.                          *> FT-Default-Opt-No(17)
           05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (17) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 18 - ???
      *>   ------------------------------------------------------------------------
      *>   05 PIC 9(2) VALUE F18.                          *> FT-Curr-Opt-No   (18)
      *>   05 PIC 9(2) VALUE F18.                          *> FT-Default-Opt-No(18)
      *>   05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (18) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 19 - ???
      *>   ------------------------------------------------------------------------
      *>   05 PIC 9(2) VALUE F19.                          *> FT-Curr-Opt-No   (19)
      *>   05 PIC 9(2) VALUE F19.                          *> FT-Default-Opt-No(19)
      *>   05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (19) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
      *>   Function 20 - ???
      *>   ------------------------------------------------------------------------
      *>   05 PIC 9(2) VALUE F20.                          *> FT-Curr-Opt-No   (20)
      *>   05 PIC 9(2) VALUE F20.                          *> FT-Default-Opt-No(20)
      *>   05 PIC 9(2) VALUE 0.                            *> FT-Opt-Qty       (20) Computed by 100-Initialization
      *>   ------------------------------------------------------------------------
           05 PIC X(6) VALUE LOW-VALUES.                   *> Must be the last entry
       01  Function-Redef REDEFINES Function-FILLER.
           05                          PIC 9(2).
           05 Function-Tbl             OCCURS 18 TIMES.    *> # Supported funcs + 1 for end sentinel
              10 FT-Curr-Opt-No        PIC 9(2).           *> Current displayed option (varies)
              10 FT-Default-Opt-No     PIC 9(2).           *> Default displayed option (unchanging)
              10 FT-Opt-Qty            PIC 9(2).           *> Number of option choices (unchanging)
       01  Function-Names REDEFINES Function-FILLER.
           05                          PIC 9(2).
           05 F1-Debugging-Opt-No      PIC 9(2).
           05                          PIC X(4).
           05 F2-ErrCheck-Opt-No       PIC 9(2).
           05                          PIC X(4).
           05 F3-Tracing-Opt-No        PIC 9(2).
           05                          PIC X(4).
           05 F4-Output-Opt-No         PIC 9(2).
           05                          PIC X(4).
           05 F5-Run-Opt-No            PIC 9(2).
           05                          PIC X(4).
           05 F6-Listing-Opt-No        PIC 9(2).
              88 F6-No-Listing-Wanted        VALUE 1.
              88 F6-Landscape-Listing-Wanted VALUE 2.
              88 F6-Portrait-Listing-Wanted  VALUE 3.
              88 F6-Exp-Srce-Listing-Wanted  VALUE 4.
           05                          PIC X(4).
           05 F7-Lister-Opt-No         PIC 9(2).
              88 Listing-Generated-By-GCic VALUE 1.
              88 Listing-Generated-By-Cobc VALUE 2.
           05                          PIC X(4).
           05 F8-Function-Opt-No       PIC 9(2).
           05                          PIC X(4).
           05 F9-CmdWarn-Opt-No        PIC 9(2).
           05                          PIC X(4).
           05 F10-SrceFmt-Opt-No       PIC 9(2).
           05                          PIC X(2).
           05 F10-Qty-Override         PIC 9(2).
           05 F11-Truncation-Opt-No    PIC 9(2).
           05                          PIC X(4).
           05 F12-Optimization-Opt-No  PIC 9(2).
           05                          PIC X(4).
           05 F13-Dump-Opt-No          PIC 9(2).
           05                          PIC X(4).
           05 F14-Config-Opt-No        PIC 9(2).
           05                          PIC X(4).
           05 F15-PrgSpcSwtchs-Opt-No  PIC 9(2).
           05                          PIC X(4).
           05 F16-SaveTemps-Opt-No     PIC 9(2).
           05                          PIC X(4).
           05 F17-Success-Opt-No       PIC 9(2).
              88 F17-Success-Ignore    VALUE 1.
              88 F17-Success-Xqt       VALUE 2.
           05                          PIC X(4).
      *>   05 F18-XXXX-Opt-No          PIC 9(2).
      *>   05                          PIC X(4).
      *>   05 F19-XXXX-Opt-No          PIC 9(2).
      *>   05                          PIC X(4).
      *>   05 F20-XXXX-Opt-No          PIC 9(2).
      *>   05                          PIC X(4).
           05                          PIC X(6).           *> Lines up w/ end-of-table sentinal

       01  GC-Compile-DateTime       PIC XXXX/XX/XXBXX/XX. *> "YYYY/MM/DD hh:mm"

       01  GCic-Execution-Date-Time.
           05 GCic-Execution-Date      PIC 9(8).
           05 VALUE "-"                PIC X(1).
           05 GCic-Execution-Time      PIC 9(8).
       01  GCInfo-Arg.                                   *> Arguments to GCINFO subroutine
           05 GA-Version               PIC X(20).          *> i.e. "3.1.2.0"
                                                           *>       | | | |
                                                           *>       | | | +-- Update minor #
                                                           *>       | | +---- Update major #
                                                           *>       | +------ Release #
                                                           *>       +-------- Version #
           05 GA-Version-No-X.
              10 GA-Version-No         PIC 9(8).           *> Numeric Version #
           05 GA-Release-No-X.
              10 GA-Release-No         PIC 9(8).           *> Numeric Release #
           05 GA-Update-Major-No-X.
              10 GA-Update-Major-No    PIC 9(8).           *> Numeric Update Major #
           05 GA-Update-Minor-No-X.
              10 GA-Update-Minor-No    PIC 9(8).           *> Numeric Update Minor #
           05 GA-Release-Date          PIC X(9).           *> GnuCOBOL Release Date (ddMMMyyyy)
           05 GA-Build-Date            PIC X(9).           *> GnuCOBOL Build Date (ddMMMyyyy)
           05 GA-Build-Env             PIC X(30).          *> "x86_64-pc-linux-gnu", "i686-pc-mingw32", ...
           05 GA-OS-Type               PIC 9(1).           *> Deduced from GA-Build-Env
              88 GA-OS-Unknown         VALUE 0.
              88 GA-OS-Windows         VALUE 1.
              88 GA-OS-Cygwin          VALUE 2.
              88 GA-OS-SplatNIX        VALUE 3.
              88 GA-OS-MacOS           VALUE 4.
              88 GA-OS-MinGW           VALUE 5.


       01  GnuCOBOL-COPY-Right         PIC X(25)           *> Right-justified COB-COPY-DIR
                                       JUSTIFIED RIGHT.

       01  Help-File.
           05 OCCURS CMDMAXSIZE        PIC X(1).           *> Fully-qualified name of the HELP file

       01  Horiz-Line-102              PIC X(102).         *> Used when building main screen

       01  I                           PIC 9(4).           *> General-use subscript

       01  Increment-Value             PIC S9(1).          *> +1: user left-clicked function button
                                                           *> -1: user right-clicked function button

       01  J                           PIC 9(4).           *> Another general-use subscript

       >>IF LOCKFILE = 1
       01  Lock-Filename               PIC X(256).         *> "gcic-lock-xx", xx="Program-Name" value
       >>END-IF

       01  Messages-Filename           PIC X(256).         *> filename.ext of the listing file

       01  NArgs                       PIC 9(2).           *> Total # of args specified on the command line

       01  On-Success-Commands.                            *> Hold all "On Success" commands
           05 OSC-Sub                  PIC 9(2) VALUE 0.
           05 OSC-All-Commands.
              10 OSC-Command           OCCURS OSCQTY TIMES
                                       PIC X(256).

       01  Open-Files.                                     *> Flags set to 1 when corresponding file open
           05 Listing-Open             PIC 9(1).
           05 Source-Open              PIC 9(1).
           05 COBC-Output-Open         PIC 9(1).

      *>************************************************************************
      *> See the "Options Table" documentation in "gcic-readme.html" for more **
      *> information on the following table.                                  **
      *>************************************************************************

       01  Option-FILLER.
      *>   -----------------------------------==========||==========------------
      *>   Function 1 - Debugging
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "010100".
           05 PIC X(22)                VALUE "'D' Lines Are Comments".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Debugging lines (marked with 'D' or '>>D') will be treated as comments".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "010217".
           05 PIC X(22)                VALUE "   Compile 'D' Lines  ".
           05 PIC X(30)                VALUE "-fdebugging-line".
           05 PIC X(104)               VALUE " Debugging lines (marked with 'D' or '>>D') will be compiled".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 2 - Runtime Err Checking
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "020100".
           05 PIC X(22)                VALUE "        Normal        ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Standard run-time error reporting will apply".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "020207".
           05 PIC X(22)                VALUE "       Enhanced       ".
           05 PIC X(30)                VALUE "-debug".
           05 PIC X(104)               VALUE " Full run-time error checking will apply ".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 3 - Generate Tracing Code
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "030100".
           05 PIC X(22)                VALUE "          No          ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " No statement or procedure tracing code will be generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "030208".
           05 PIC X(22)                VALUE " Yes: Procedures Only ".
           05 PIC X(30)                VALUE "-ftrace".
           05 PIC X(104)               VALUE " Procedure-entry tracing code will be generated; needs 'READY TRACE' or " &
                                             "'COB_SET_TRACE' to activate".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "030311".
           05 PIC X(22)                VALUE "Yes: Procedures+Stmnts".
           05 PIC X(30)                VALUE "-ftraceall".
           05 PIC X(104)               VALUE " Generates procedure-entry and statement tracing code; activate via " &
                                             "'READY TRACE' or 'COB_SET_TRACE".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 4 - Compiler Output
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "040103".
           05 F4-O1-Caption PIC X(22)  VALUE "  Make an Executable  ".
           05 PIC X(30)                VALUE "-x".
           05 PIC X(104)               VALUE " A standaline executable that can be run directly will be produced".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "040203".
           05 F4-O2-Caption PIC X(22)  VALUE "    Make a Library    ".
           05 PIC X(30)                VALUE "-m".
           05 PIC X(104)               VALUE " An executable library will be produced; may be loaded and executed" &
                                             " via CALL or executed via 'cobcrun'".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "040300".
           05 PIC X(22)                VALUE "  Save C Source (-C)  ".
           05 PIC X(30)                VALUE "-C -save-temps".
           05 PIC X(104)               VALUE " Compilation will stop at the point C code was generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "040400".
           05 PIC X(22)                VALUE " Save Asm Source (-S) ".
           05 PIC X(30)                VALUE "-S -save-temps".
           05 PIC X(104)               VALUE " Compilation will stop at the point Assembler source code was generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "040500".
           05 PIC X(22)                VALUE " Save Object Code (-c)".
           05 PIC X(30)                VALUE "-c -save-temps".
           05 PIC X(104)               VALUE " Compilation will stop at the point unlinked object code was generated".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 5 - Run After Compilation
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "050100".
           05 PIC X(22)                VALUE "          No          ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " The program will be compiled, but not executed".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "050200".
           05 PIC X(22)                VALUE " Yes: If Comp. OK (-j)".
           05 PIC X(30)                VALUE "-j".
           05 PIC X(104)               VALUE " The program will be executed if it compiles successfully".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 6 - Source & Xref Listing
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "060100".
           05 PIC X(22)                VALUE "         None         ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " No Source/Cross-Reference listing will be generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "060200".
           05 PIC X(22)                VALUE " Yes: Wide (Landscape)".
           05 PIC X(30)                VALUE "-T gcic-output.txt".
           05 PIC X(104)               VALUE " A LANDSCAPE (wide) format Source and Cross-Reference li#ting will be generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "060300".
           05 PIC X(22)                VALUE "Yes: Narrow (Portrait)".
           05 Portrait-Opts  PIC X(30) VALUE "-T gcic-output.txt".
           05 PIC X(104)               VALUE " A PORTRAIT (narrow) format Source and Cross-Reference li#ting will be generated".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "060400".
           05 PIC X(22)                VALUE "  Yes: Preproc. COBOL ".
           05 PIC X(30)                VALUE "-E".
           05 PIC X(104)               VALUE " A listing of the expanded COBOL source will be generated by cobc".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 7 - Listing Produced By
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "070100".
           05 PIC X(22)                VALUE "         GCic         ".
           05 PIC X(30)                VALUE "-ftsymbols -save-temps".
           05 PIC X(104)               VALUE " Listings (if any) will be generated by GCic".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "070200".
           05 PIC X(22)                VALUE "         cobc         ".
           05 PIC X(30)                VALUE "-X".
           05 PIC X(104)               VALUE " Listings (if any) will be generated by cobc".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 8 - Commands and Messages
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "080100".
           05 PIC X(22)                VALUE " No Commands/Warnings ".
           05 PIC X(30)                VALUE "-q -w".
           05 PIC X(104)               VALUE " The briefest possible listing of messages will be produced by cobc".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "080200".
           05 PIC X(22)                VALUE "Cmds, Minimal Warnings".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Cobc will list all generated commands, all error messages, and common warnings".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "080300".
           05 PIC X(22)                VALUE "  Cmds, Most Warnings ".
           05 PIC X(30)                VALUE "-W".
           05 PIC X(104)               VALUE " Cobc will list all generated commands, all error messages, and most warnings".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "080400".
           05 PIC X(22)                VALUE "  Cmds, All Warnings  ".
           05 PIC X(30)                VALUE "-Wall -Wextra -Wadditional".
           05 PIC X(104)               VALUE " Cobc will list all generated commands, all error messages, and all warnings".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 9 - FUNCTION w/ Intrinsics
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "090117".
           05 PIC X(22)                VALUE " FUNCTION Is Optional ".
           05 PIC X(30)                VALUE "-fintrinsics=all".
           05 PIC X(104)               VALUE " The keyword FUNCTION is optional for all intrinsic (i.e. built-in functions)".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "090200".
           05 PIC X(22)                VALUE " Managed By REPOSITORY".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " The REPOSITORY paragraph of the CONFIGURATION SECTION will control the use " &
                                             "of FUNCTION".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 10 - Program Source Format
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100114".
           05 PIC X(22)                VALUE "         Free         ".
           05 F10-1-Switch PIC X(30)   VALUE "-fformat=free".        *> Use "-free" before GnuCOBOL 3.2
           05 PIC X(104)               VALUE " Full free-format from columns 1-255".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100215".
           05 PIC X(22)                VALUE "        Fixed         ".
           05 F10-2-Switch PIC X(30)   VALUE "-fformat=fixed".      *> Use "-fixed" before GnuCOBOL 3.2
           05 PIC X(104)               VALUE " Cols 1-6 sequence numbers, 7 : indicator, 8-72 : program text, 73-80 : reference area".
      *>   -----------------------------------==========||==========------------
           05 PIC X(4)                 VALUE "1003".
           05 F10-3-Len    PIC X(2)    VALUE "18".
           05 PIC X(22)                VALUE "       Variable       ".
           05 F10-3-Switch PIC X(30)   VALUE "-fformat=variable".   *> Use "-fixed -ftext-column=250" before GnuCOBOL 3.2
           05 PIC X(104)               VALUE " Cols 1-6 sequence numbers, 7 : indicator, 8-250 : program text".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100417".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "       COBOL85        ".
           05 PIC X(30)                VALUE "-fformat=cobol85".
           05 PIC X(104)               VALUE " Cols 1-6 : seq. nos, 7 : indicator, 8-11 : Area A (enforced), 12-72 : Area B, 73-80" &
                                            " : reference area".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100515".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "        XOPEN         ".
           05 PIC X(30)                VALUE "-fformat=xopen".
           05 PIC X(104)               VALUE " Col 1 : indicator, 1-80 : program text".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100615".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "     ICOBOL XCARD     ".
           05 PIC X(30)                VALUE "-fformat=xcard".
           05 PIC X(104)               VALUE " Cols 1-6 sequence numbers, 7 : indicator, 8-255 : program text".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100713".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "  ICOBOL Free (CRT)   ".
           05 PIC X(30)                VALUE "-fformat=crt".
           05 PIC X(104)               VALUE " Col 1 : indicator, 1-320 : program text".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100818".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "  AcuCOBOL Terminal   ".
           05 PIC X(30)                VALUE "-fformat=terminal".
           05 PIC X(104)               VALUE " Cols 1-320 : program text; use \D for debugging indicator".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "100916".              *> GnuCOBOL 3.2+
           05 PIC X(22)                VALUE "        COBOLX        ".
           05 PIC X(30)                VALUE "-fformat=cobolx".
           05 PIC X(104)               VALUE " Col 1 : indicator, 2-255 : program text".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 11 - Truncate COMP to PIC
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "110110".
           05 PIC X(22)                VALUE "          No          ".
           05 PIC X(30)                VALUE "-fnotrunc".
           05 PIC X(104)               VALUE " USAGE BINARY-xxx and USAGE COMP can use allocated bytes fully".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "110200".
           05 PIC X(22)                VALUE "         Yes          ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " USAGE BINARY-xxx and USAGE COMP truncate to PICTURE size".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 12 - Optimization
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "120104".
           05 PIC X(22)                VALUE "         None         ".
           05 PIC X(30)                VALUE "-O0".
           05 PIC X(104)               VALUE " No optimization".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "120204".
           05 PIC X(22)                VALUE "       Size Only      ".
           05 PIC X(30)                VALUE "-Os".
           05 PIC X(104)               VALUE " Optimize size of executable only".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "120303".
           05 PIC X(22)                VALUE " Size+Speed (Level 1) ".
           05 PIC X(30)                VALUE "-O".
           05 PIC X(104)               VALUE " Optimize executable size and speed (1)".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "120404".
           05 PIC X(22)                VALUE " Size+Speed (Level 2) ".
           05 PIC X(30)                VALUE "-O2".
           05 PIC X(104)               VALUE " Optimize executable size and speed (2)".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 13 - Dump DATA DIV on Abort
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "130100".
           05 PIC X(22)                VALUE "          No          ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Do not dump DATA DIVISION if program aborts".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "130211".
           05 PIC X(22)                VALUE "         Yes          ".
           05 PIC X(30)                VALUE "-fdump=all".
           05 PIC X(104)               VALUE " Dump entire DATA DIVISION if program aborts; needs env var COB_DUMP_FILE to define " &
                                             "dump destination".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 14 - (B)ehavior & (S)tandards
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140109".
           05 PIC X(22)                VALUE "       AcuCOBOL       ".
           05 PIC X(30)                VALUE "-std=acu".
           05 PIC X(104)               VALUE " AcuCOBOL, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140216".
           05 PIC X(22)                VALUE "   AcuCOBOL (Strict)  ".
           05 PIC X(30)                VALUE "-std=acu-strict".
           05 PIC X(104)               VALUE " AcuCOBOL, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140311".
           05 PIC X(22)                VALUE "        BS2000        ".
           05 PIC X(30)                VALUE "-std=bs2000".
           05 PIC X(104)               VALUE " BS2000, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140419".
           05 PIC X(22)                VALUE "    BS2000 (Strict)   ".
           05 PIC X(30)                VALUE "-std=bs2000-strict".
           05 PIC X(104)               VALUE " BS2000, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140516".
           05 PIC X(22)                VALUE "       COBOL2002      ".
           05 PIC X(30)                VALUE "-std=cobol2002".
           05 PIC X(104)               VALUE " COBOL 2002 standard rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140616".
           05 PIC X(22)                VALUE "       COBOL2014      ".
           05 PIC X(30)                VALUE "-std=cobol2014".
           05 PIC X(104)               VALUE " COBOL 2014 standard rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140713".
           05 PIC X(22)                VALUE "        COBOL85       ".
           05 PIC X(30)                VALUE "-std=cobol85".
           05 PIC X(104)               VALUE " ANS85 standard rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140813".
           05 PIC X(22)                VALUE "       DEFAULT        ".
           05 PIC X(30)                VALUE "-std=default".
           05 PIC X(104)               VALUE " Full GnuCOBOL".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "140910".
           05 PIC X(22)                VALUE "       Bull GCOS      ".
           05 PIC X(30)                VALUE "-std=gcos".
           05 PIC X(104)               VALUE " Bull GCOS COBOL, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141018".
           05 PIC X(22)                VALUE "  Bull GCOS (Strict)  ".
           05 PIC X(30)                VALUE "-std=gcos-strict".
           05 PIC X(104)               VALUE " Bull GCOS COBOL, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141110".
           05 PIC X(22)                VALUE "    IBM Enterprise    ".
           05 PIC X(30)                VALUE "-std=ibm".
           05 PIC X(104)               VALUE " IBM Enterprise COBOL, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141215".
           05 PIC X(22)                VALUE "IBM Enterprise(Strict)".
           05 PIC X(30)                VALUE "-std=ibm-strict".
           05 PIC X(104)               VALUE " IBM Enterprise COBOL, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141308".
           05 PIC X(22)                VALUE "      MicroFocus      ".
           05 PIC X(30)                VALUE "-std=mf".
           05 PIC X(104)               VALUE " MicroFocus, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141415".
           05 PIC X(22)                VALUE "  MicroFOCUS (Strict) ".
           05 PIC X(30)                VALUE "-std=mf-strict".
           05 PIC X(104)               VALUE " Microfocus, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141512".
           05 PIC X(22)                VALUE "        REALIA        ".
           05 PIC X(30)                VALUE "-std=realia".
           05 PIC X(104)               VALUE " CA-Realia, relaxed rules ".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141619".
           05 PIC X(22)                VALUE "    REALIA (Strict)   ".
           05 PIC X(30)                VALUE "-std=realia-strict".
           05 PIC X(104)               VALUE " CA-Realia, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141708".
           05 PIC X(22)                VALUE "        RmCOBOL       ".
           05 PIC X(30)                VALUE "-std=rm".
           05 PIC X(104)               VALUE " RM/COBOL, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141816".
           05 PIC X(22)                VALUE "   RmCOBOL (Strict)   ".
           05 PIC X(30)                VALUE "-std=rm-strict".
           05 PIC X(104)               VALUE " RM/COBOL, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "141909".
           05 PIC X(22)                VALUE "    IBM VSCOBOL II    ".
           05 PIC X(30)                VALUE "-std=mvs".
           05 PIC X(104)               VALUE " IBM MVS/VM VSCOBOL II, relaxed rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "142016".
           05 PIC X(22)                VALUE "IBM VSCOBOL II(Strict)".
           05 PIC X(30)                VALUE "-std=mvs-strict".
           05 PIC X(104)               VALUE " IBM MVS/VM VSCOBOL II, strict rules".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "142111".
           05 PIC X(22)                VALUE "         XOPEN        ".
           05 PIC X(30)                VALUE "-std=xopen".
           05 PIC X(104)               VALUE " MicroFocus X/Open, strict rules ".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 15 - Pgm-Specified Switches
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "150100".
           05 PIC X(22)                VALUE "        Ignore        ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Ignore '*> COBC SWITCHES' comments".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "150200".
           05 PIC X(22)                VALUE "         Honor        ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Use '*> COBC SWITCHES' comments to define switches for compiler".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 16 - Save Temporary Files
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "160100".
           05 PIC X(22)                VALUE "          No          ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Do not save any cobc or GCic temporary files".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "160211".
           05 PIC X(22)                VALUE "          Yes         ".
           05 PIC X(30)                VALUE "-save-temps".
           05 PIC X(104)               VALUE " Save all cobc and GCic temporary files".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Function 17 - 'On Success' Commands
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "170100".
           05 PIC X(22)                VALUE "        Ignore        ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Ignore '*> ON SUCCESS' comments".
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE "170200".
           05 PIC X(22)                VALUE "        Execute       ".
           05 PIC X(30)                VALUE SPACES.
           05 PIC X(104)               VALUE " Run '*> ON SUCCESS' commands if compilation is successful".
      *>   -----------------------------------==========||==========------------

      *>   -----------------------------------==========||==========------------
      *>   Must be the last entry
      *>   -----------------------------------==========||==========------------
           05 PIC X(6)                 VALUE LOW-VALUES.
           05 PIC X(22)                VALUE LOW-VALUES.
           05 PIC X(30)                VALUE LOW-VALUES.
           05 PIC X(104)               VALUE LOW-VALUES.

       01  Option-Redef                REDEFINES Option-FILLER.
           05 Option-Tbl               OCCURS 71 TIMES
                                       ASCENDING KEY Option-Func
                                       INDEXED BY Option-Idx.
              10 Option-Func.
                 15 OF-Func-No         PIC 9(2).           *> Function # (static) - 01-20
                 15 OF-Opt-No          PIC 9(2).           *> Option # (static)   - 01-FT-Opt-Qty(n)
              10 Option-PSS-Size       PIC 9(2).           *> > 0 means eligible for PSS match
              10 Option-Text           PIC X(22).          *> Function button text for option (static)
              10 Option-Switch         PIC X(30).          *> "cobc" switches for this option (static)
              10 Option-Long-Text      PIC X(104).         *> Destined for line 27

      *>************************************************************************
      *> The following are OS-dependent items.  When GCINFO runs, it will at- **
      *> tempt to determine the value of "OS-Type-Code".  If it cannot, it    **
      *> will return a value of zero, which will cause the user to be prompt- **
      *> ed to set the appropriate value manually in the constants area back  **
      *> in the ENVIRONMENT DIVISION, and then recompile "gcic.cbl".          **
      *>************************************************************************
       01  OS-Dir-Chr                  PIC X(1).
       01  OS-Path-Char                PIC X(1).
       01  OS-Null-Device              PIC X(9).
       01  OS-Resize                   PIC X(256).
       01  OS-Type-Code                PIC 9(1) VALUE OS.
           88 OTC-Is-Windows           VALUE 1, 5.
           88 OTC-Is-Cygwin            VALUE 2.
           88 OTC-Is-SplatNIX          VALUE 3, 4.
           88 OTC-Is-MACOS             VALUE 4.
       01  OS-Type-FILLER.                                 *> Supported OS names used when building "Banner"
           05 VALUE "Windows"          PIC X(14).
           05 VALUE "Windows/Cygwin"   PIC X(14).
           05 VALUE "UNIX/Linux"       PIC X(14).
           05 VALUE "MACOS"            PIC X(14).
           05 VALUE "Windows/MinGW"    PIC X(14).
       01  REDEFINES OS-Type-FILLER.
           05 OS-Type                  OCCURS 5 TIMES
                                       PIC X(14).

       01  Output-Msg-106.                                 *> "xxxxx is already being compiled" message
           05                          PIC X(2).
           05 Output-Msg               PIC X(104).         *> Message line on screen (last line)

           >>IF LOCKFILE = 1
       01  PID                         USAGE BINARY-LONG.  *> This process' PID number

       01  PID-Formatted               PIC Z(6)9.          *> Max PID = 4194304, Windows, *NIX, 32767 (MacOSJ
       >>END-IF

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       01  Prog-Filename.                                  *> The filename argument from the command line (NO PATH)
           05 PF-Char                  OCCURS 2048 TIMES
                                       PIC X(1).

       01  Prog-Folder-Right           PIC X(64)           *> The last 64 chars of the program's folder name
                                       JUSTIFIED RIGHT.

       01  Prog-Folder                 PIC X(2048).        *> The entirety of the program's folder name

       01  Prog-Specified-Switches.                        *> Hold all Program-Specified Switches
           05 PSS-Sub                  PIC 9(2) VALUE 0.
           05 PSS-All-Switches.
              10 PSS-Text              OCCURS PSSQTY TIMES
                                       PIC X(256).

       01  Program-Name                PIC X(31).          *> The first 31 chars of the program's filename

       01  Resize-Type                 PIC S9(1) VALUE RESIZE.
      *>************************************************************************
      *> These are set via the RESIZE constant (see the ENVIRONMENT DIVISION) **
      *> and actually come in positive or negative values, depending on       **
      *> whether the action is taken BEFORE (negative) or AFTER (positive)    **
      *> extended screen I/O has been activated.                              **
      *>************************************************************************
           88 RT-None                  VALUE 0.            *> User must manually resize
           88 RT-Auto                  VALUE 1.            *> Windows: Assume -2; MacOS: Assume +3; Cygwin: Assume +4
           88 RT-Mode                  VALUE -2.           *> "mode con: cols=106 lines=28"
           88 RT-Mode-Before           VALUE -2.
           88 RT-Resize                VALUE -3, +3.       *> "resize -s 28 106&&stty rows 28&&stty cols 106"
           88 RT-Resize-Before         VALUE -3.
           88 RT-Resize-After          VALUE     +3.
           88 RT-Cygwin                VALUE -4, +4.       *> ESC sequence "@[8;28;106t" (@ = ESC)
           88 RT-Cygwin-Before         VALUE -4.
           88 RT-Cygwin-After          VALUE     +4.
           88 RT-Cmd                   VALUE -5, +5.       *> Value of RESIZECMD executed via "SYSTEM"
           88 RT-Cmd-Before            VALUE -5.
           88 RT-Cmd-After             VALUE     +5.
           88 RT-Curses                VALUE     +6.       *> Requires "-lpdcurses" or "-lncurses" switch to build GCic
           88 RT-Curses-After          VALUE     +6.
           88 RT-Esc                   VALUE -7, +7.       *> Value of RESIZEESC printed to STDOUT
           88 RT-Esc-Before            VALUE -7.
           88 RT-Esc-After             VALUE     +7.
           88 RT-Invalid               VALUE -6, +2,
                                             -8, +8,
                                             -9, +9.

DEBUG D01  Return-Code-Display         PIC +9(11).

       01  Search-Key.
           05 SK-Function              PIC 9(2).           *> Populate before searching Options-Tbl
           05 SK-Opt-No                PIC 9(2).
       01  Search-Key-9999             REDEFINES Search-Key
                                       PIC 9(4).

       01  Source-Filename.                                *> The complete path/filenm from the command line
           05 SF-Char                  OCCURS 2048 TIMES
                                       PIC X(1).

       01  Tally-1                     PIC 9(4).           *> General-purpose counter for INSPECT TALLYING

       01  Tally-2                     PIC 9(4).           *> General-purpose counter for INSPECT TALLYING

       01  Temp-Files-FILLER.                              *> Files to clean up on normal finish
      *>   *********************************************************************
      *>   ** Entries containing "xxxxxx" will have the command-line program  **
      *>   ** filename (minus extension) substituted for the "xxxxxx".  Those **
      *>   ** entries with a TF-Wildcard value of "*" will be deleted using   **
      *>   ** a "SYSTEM" command while all others will be deleted via the     **
      *>   ** CBL_DELETE_FILE subroutine.                                     **
      *>   *********************************************************************
           05 PIC X(21) VALUE "*xxxxxx.c.l*.h".            *> "C" header for local storage from "cobc"
           05 PIC X(21) VALUE " gcic-info.txt".            *> "cobc --info" output
           05 PIC X(21) VALUE " gcic-list.txt".            *> "cobc -list-reserved", etc. output
           05 PIC X(21) VALUE " gcic-output.txt".          *> "cobc -T|t [-ftsymbols]" output
           05 PIC X(21) VALUE " gcic-source.txt".          *> "cobc -T" source listing
           05 PIC X(21) VALUE " gcic-symbols.txt".         *> "cobc -ftsymbols" listing
           05 PIC X(21) VALUE " xxxxxx.c".                 *> "C" source code from "cobc"
           05 PIC X(21) VALUE " xxxxxx.c.h".               *> "C" header file from "cobc"
           05 PIC X(21) VALUE " xxxxxx.i".                 *> Expanded COBOL code from "cobc"
           05 PIC X(21) VALUE " xxxxxx.o".                 *> Object code from "cobc"
           05 PIC X(21) VALUE " xxxxxx.s".                 *> Assembler source from "cobc -S"
           05 PIC X(21) VALUE LOW-VALUES.                  *> End-of-table sentinal
       01  Temp-Files-Tbl REDEFINES Temp-Files-FILLER.
           05 Temp-File                OCCURS 12.
              10 TF-Wildcard           PIC X(1).
              10 TF-Filename           PIC X(20).

       01  Temps-Dir                   PIC X(2048).        *> Folder where "cobc" puts it's temp files

       01  Text-31                     PIC X(31).          *> Used by 025-Scan-PSS when processing PSS

       01  Text-104                    PIC X(104).         *> Used by 099-Terminate to assemble error msgs

       01  Text-256                    PIC X(256).         *> Used by 110-Debugging to hold command-line
                                                           *> And by 099-Terminate as a place to hold file info
                                                           *> And by 035-Load-Switches to load Cobc-Switch-Tbl

       01  Tokens.                                         *> UNSTRING dest fields for parsing user input
           05 Token-1                  PIC X(256).
           05 Token-2                  PIC X(256).

       01  User-Action-Taken           PIC X(3).           *> Gets updated when user clicks a button
           88 User-Clicked-CANCEL      VALUE "CAN".
           88 User-Clicked-Field       VALUE "NOP".
           88 User-Clicked-Function    VALUE "FUN".
           88 User-Clicked-HELP        VALUE "HLP".
           88 User-Clicked-OK          VALUE "OK ".
           88 User-Goofed              VALUE "BAD".

       SCREEN SECTION.

      *>************************************************************************
      *> Screen color pallette                                                **
      *>************************************************************************
       78  BTN-BACK          VALUE COB-COLOR-GREEN.  *> Button Default Background
       78  BTN-CUSTOM-BACK   VALUE COB-COLOR-YELLOW. *> Button Custom Background (Function set to non-default option)
       78  BTN-CUSTOM-TEXT   VALUE COB-COLOR-BLACK.  *> Button Custom Text (Function set to non-default option)
       78  BTN-TEXT          VALUE COB-COLOR-BLACK.  *> Button Default Text

       78  HELP-BACK         VALUE COB-COLOR-WHITE.  *> Help Screen Background
       78  HELP-TEXT         VALUE COB-COLOR-BLACK.  *> Help Screen Text
       78  HELP-TRIM         VALUE COB-COLOR-BLUE.   *> Help Screen Border Trim

       78  MAIN-BACK         VALUE COB-COLOR-BLACK.  *> Main Screen Background
       78  MAIN-LABELS       VALUE COB-COLOR-YELLOW. *> Main Screen Field Labels
       78  MAIN-PROT         VALUE COB-COLOR-CYAN.   *> Main Screen Non-Updateable Text
       78  MAIN-TEXT         VALUE COB-COLOR-WHITE.  *> Main Screen Updateable Text
       78  MAIN-TRIM         VALUE COB-COLOR-GREEN.  *> Main Screen Border Trim

       78  TITLE-BACK        VALUE COB-COLOR-GREEN.  *> Title (Line 2) Background
       78  TITLE-TEXT        VALUE COB-COLOR-BLACK.  *> Title (Line 2) Text

       78  COPYRIGHT-BACK    VALUE COB-COLOR-GREEN.  *> Copyright (Line 34) Background
       78  COPYRIGHT-TEXT    VALUE COB-COLOR-BLACK.  *> Copyright (Line 34) Background

       78  ERROR-BACK        VALUE COB-COLOR-RED  .  *> Error (Line 34) Background
       78  ERROR-TEXT        VALUE COB-COLOR-WHITE.  *> Error (Line 34) Background

      *>************************************************************************
      *> Trim drawing characters                                              **
      *>************************************************************************

       >>IF LINEDRAW IS EQUAL TO 1
       78  LD-UL-Corner                VALUE X"DA". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-LL-Corner                VALUE X"C0". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-UR-Corner                VALUE X"BF". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-LR-Corner                VALUE X"D9". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Left-T                   VALUE X"C3". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Right-T                  VALUE X"B4". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Cross                    VALUE X"C5". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Upper-T                  VALUE X"C2". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Lower-T                  VALUE X"C1". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Horiz-Line               VALUE X"C4". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       78  LD-Vert-Line                VALUE X"B3". *> Codepage 437, 85x (x=0125789), 86x (x=01234569)
       >>ELIF LINEDRAW IS EQUAL TO 2
       78  LD-UL-Corner                VALUE "+".
       78  LD-LL-Corner                VALUE "+".
       78  LD-UR-Corner                VALUE "+".
       78  LD-LR-Corner                VALUE "+".
       78  LD-Left-T                   VALUE "+".
       78  LD-Right-T                  VALUE "+".
       78  LD-Cross                    VALUE "+".
       78  LD-Upper-T                  VALUE "+".
       78  LD-Lower-T                  VALUE "+".
       78  LD-Horiz-Line               VALUE "-".
       78  LD-Vert-Line                VALUE "|".
       >>ELIF LINEDRAW IS EQUAL TO 3
       78  LD-UL-Corner                VALUE "/".
       78  LD-LL-Corner                VALUE "\".
       78  LD-UR-Corner                VALUE "\".
       78  LD-LR-Corner                VALUE "/".
       78  LD-Left-T                   VALUE "|".
       78  LD-Right-T                  VALUE "|".
       78  LD-Cross                    VALUE "+".
       78  LD-Upper-T                  VALUE "-".
       78  LD-Lower-T                  VALUE "-".
       78  LD-Horiz-Line               VALUE "-".
       78  LD-Vert-Line                VALUE "|".
       >>ELIF LINEDRAW IS EQUAL TO 4
       78  LD-UL-Corner                VALUE "*".
       78  LD-LL-Corner                VALUE "*".
       78  LD-UR-Corner                VALUE "*".
       78  LD-LR-Corner                VALUE "*".
       78  LD-Left-T                   VALUE "*".
       78  LD-Right-T                  VALUE "*".
       78  LD-Cross                    VALUE "*".
       78  LD-Upper-T                  VALUE "*".
       78  LD-Lower-T                  VALUE "*".
       78  LD-Horiz-Line               VALUE "*".
       78  LD-Vert-Line                VALUE "*".
       >>ELIF LINEDRAW IS EQUAL TO 5
       78  LD-UL-Corner                VALUE " ".
       78  LD-LL-Corner                VALUE "|".
       78  LD-UR-Corner                VALUE " ".
       78  LD-LR-Corner                VALUE "|".
       78  LD-Left-T                   VALUE "|".
       78  LD-Right-T                  VALUE "|".
       78  LD-Cross                    VALUE "|".
       78  LD-Upper-T                  VALUE "_".
       78  LD-Lower-T                  VALUE "_".
       78  LD-Horiz-Line               VALUE "_".
       78  LD-Vert-Line                VALUE "|".
       >>ELSE
       78  LD-UL-Corner                VALUE " ".
       78  LD-LL-Corner                VALUE " ".
       78  LD-UR-Corner                VALUE " ".
       78  LD-LR-Corner                VALUE " ".
       78  LD-Left-T                   VALUE " ".
       78  LD-Right-T                  VALUE " ".
       78  LD-Cross                    VALUE " ".
       78  LD-Upper-T                  VALUE " ".
       78  LD-Lower-T                  VALUE " ".
       78  LD-Horiz-Line               VALUE " ".
       78  LD-Vert-Line                VALUE " ".
       >>END-IF
      *>                                                                                                      1
      *>            1         2         3         4         5         6         7         8         9         0
      *>   1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
      *> 01                                                                                                          01
      *> 02  GCic 2.0 (2022/06/11 08:52) - GnuCOBOL 3.2.1 23DEC2020 Interactive Compilation                          02
      *> 03 +-------------------------------------------------------------------------- Automatic COPY libraries: -+ 03
      *> 04 | Folder:   E:\GnuCOBOL\extras........................................................E:\GnuCOBOL\copy | 04
      *> 05 | Filename: GCic.cbl................................................................E:\GnuCOBOL\extras | 05
      *> 06 +------------------------------------------------------------------------------------------------------+ 06
      *> 07 | ......Debugging....... Source & Xref Listing  .Truncate COMP to PIC. .Save Temporary Files.          | 07
      *> 08 | 'D' Lines are Comments Yes: Wide (Landscape)  ..........No.......... ..........No.......... ...OK... | 08
      *> 09 | Run-time Err Checking  .Listing Produced By.. .....Optimization..... 'On Success' Commands.          | 09
      *> 10 | .......Normal........  .........GCic......... .........None......... ........Ignore........ .CANCEL. | 10
      *> 11 | Generate Tracing Code. FUNCTION w/ Intrinsics Dump DATA DIV on Abort                                 | 11
      *> 12 | ..........No.......... .FUNCTION is Optional. ..........No..........                        ..HELP.. | 12
      *> 13 | ...Compiler Output.... Commands and Warnings. .Behavior & Standards.                                 | 13
      *> 14 | ......A DLL (-m)...... .No Commands/Warnings. .......DEFAULT........                                 | 14
      *> 15 | Run After Compilation. Program Source Format. Pgm-Specified Switches                                 | 15
      *> 16 | ..........No.......... .......Variable....... .......Ignore.........                                 | 16
      *> 17 +- COBCPY COPY Libraries: -----------------------------------------------------------------------------+ 17
      *> 18 |______________________________________________________________________________________________________| 18
      *> 19 +- Extra 'cobc' Switches: -----------------------------------------------------------------------------+ 19
      *> 20 |______________________________________________________________________________________________________| 20
      *> 21 +- Extra 'cobc' Arguments: ----------------------------------------------------------------------------+ 21
      *> 22 |______________________________________________________________________________________________________| 22
      *> 23 +- Program Execution Arguments: -----------------------------------------------------------------------+ 23
      *> 24 |______________________________________________________________________________________________________| 24
      *> 25 |______________________________________________________________________________________________________| 25
      *> 26 +------------------------------------------------------------------------------------------------------+ 26
      *> 27  GCic Copyright (C) 2009-2022, Gary L. Cutler, GPL                                                       27
      *> 28                                                                                                          28
      *>   1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
      *>            1         2         3         4         5         6         7         8         9         0
      *>                                                                                                      1
       01  Erase-Screen    BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-TRIM ERASE SCREEN.

       01  Switches-Screen BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-TRIM ERASE SCREEN.
      *>
      *> GENERAL SCREEN FRAMEWORK
      *>
           03 BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-TRIM.

      *>         LINE 02  -  Top of screen banner line

              05 LINE 03  COL 02             VALUE LD-UL-Corner.
              05          COL 03  PIC X(74)  FROM  Horiz-Line-102(1:74).
              05          COL 104 PIC X(1)   VALUE LD-Horiz-Line.
              05          COL 105            VALUE LD-UR-Corner.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE 06  COL 02             VALUE LD-Left-T.
              05          COL 03  PIC X(102) FROM  Horiz-Line-102.
              05          COL 105            VALUE LD-Right-T.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE 17  COL 02             VALUE LD-Left-T.
              05          COL 03  PIC X(1)   VALUE LD-Horiz-Line.
              05          COL 28  PIC X(77)  FROM  Horiz-Line-102(1:77).
              05          COL 105            VALUE LD-Right-T.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE  19 COL 02             VALUE LD-Left-T.
              05          COL 03  PIC X(1)   VALUE LD-Horiz-Line.
              05          COL 28  PIC X(77)  FROM  Horiz-Line-102(1:77).
              05          COL 105            VALUE LD-Right-T.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE 21  COL 02             VALUE LD-Left-T.
              05          COL 03  PIC X(1)   VALUE LD-Horiz-Line.
              05          COL 29  PIC X(76)  FROM  Horiz-Line-102(1:76).
              05          COL 105            VALUE LD-Right-T.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE 23  COL 02             VALUE LD-Left-T.
              05          COL 03  PIC X(1)   VALUE LD-Horiz-Line.
              05          COL 34  PIC X(71)  FROM  Horiz-Line-102.
              05          COL 105            VALUE LD-Right-T.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE + 1 COL 02             VALUE LD-Vert-Line.
              05          COL + 1 PIC X(102) VALUE SPACES.
              05          COL 105            VALUE LD-Vert-Line.

              05 LINE 26  COL 02             VALUE LD-LL-Corner.
              05          COL 03 PIC X(102)  FROM  Horiz-Line-102.
              05          COL 105            VALUE LD-LR-Corner.

      *>         LINE 27 -  Copyright Statement

      *>         LINE 28 -  Blank

      *>
      *> TOP AND BOTTOM LINES
      *>
           03 BACKGROUND-COLOR TITLE-BACK FOREGROUND-COLOR TITLE-TEXT.
              05 LINE 02 COL 02 PIC X(104) FROM Banner.

           03 BACKGROUND-COLOR Bottom-Line-Back FOREGROUND-COLOR Bottom-Line-Text.
              05 LINE 27 COL 02 PIC X(104) FROM Output-Msg.

      *>
      *> LABELS
      *>
           03 BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-LABELS.
              05 LINE 04 COL 04            VALUE "Folder:   ".
              05 LINE 05 COL 04            VALUE "Filename: ".

              05 LINE 03 COL 77  PIC X(27) VALUE " Automatic COPY Libraries: ".
              05 LINE 17 COL 04  PIC X(24) VALUE " COBCPY COPY Libraries: ".
              05 LINE 19 COL 04  PIC X(24) VALUE " Extra 'cobc' Switches: ".
              05 LINE 21 COL 04  PIC X(25) VALUE " Extra 'cobc' Arguments: ".
              05 LINE 23 COL 04  PIC X(30) VALUE " Program Execution Arguments: ".

              05 LINE 07 COL 04  PIC X(22) VALUE "      Debugging       ".
              05 LINE 09 COL 04  PIC X(22) VALUE "Run-time Err Checking ".
              05 LINE 11 COL 04  PIC X(22) VALUE "Generate Tracing Code ".
              05 LINE 13 COL 04  PIC X(22) VALUE "   Compiler Output    ".
              05 LINE 15 COL 04  PIC X(22) VALUE "Run After Compilation ".

              05 LINE 07 COL 27  PIC X(22) VALUE "Source & Xref Listing ".
              05 LINE 09 COL 27  PIC X(22) VALUE " Listing Generated By ".
              05 LINE 11 COL 27  PIC X(22) VALUE "Commands and Warnings ".
              05 LINE 13 COL 27  PIC X(22) VALUE "FUNCTION w/ Intrinsics".
              05 LINE 15 COL 27  PIC X(22) VALUE "Program Source Format ".

              05 LINE 07 COL 50  PIC X(22) VALUE " Truncate COMP to PIC ".
              05 LINE 09 COL 50  PIC X(22) VALUE "     Optimization     ".
              05 LINE 11 COL 50  PIC X(22) VALUE "Dump DATA DIV on Abort".
              05 LINE 13 COL 50  PIC X(22) VALUE " Behavior & Standards ".
              05 LINE 15 COL 50  PIC X(22) VALUE " Prog-Spec. Switches  ".

              05 LINE 07 COL 73  PIC X(22) VALUE " Save Temporary Files ".
              05 LINE 09 COL 73  PIC X(22) VALUE "'On Success' Commands ".
      *>      05 LINE 11 COL 73  PIC X(22) VALUE "                      ".
      *>      05 LINE 13 COL 73  PIC X(22) VALUE "                      ".
      *>      05 LINE 15 COL 73  PIC X(22) VALUE "                      ".
      *>
      *> FOLDERS AND FILENAMEs
      *>
           03 BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-PROT.
              05 LINE 04 COL 14 PIC X(64) FROM Prog-Folder.
              05         COL 79 PIC X(25) FROM GnuCOBOL-COPY-Right.
              05 LINE 05 COL 14 PIC X(25) FROM Prog-Filename.
              05         COL 40 PIC X(64) FROM Prog-Folder-Right.
      *>
      *> Function "buttons"
      *>
           03 BACKGROUND-COLOR BTN-BACK FOREGROUND-COLOR BTN-TEXT.
              05 LINE 08 COL 04 PIC X(22) FROM F1-Caption   BACKGROUND-COLOR BC-F1-Back  FOREGROUND-COLOR BC-F1-Text.
              05 LINE 10 COL 04 PIC X(22) FROM F2-Caption   BACKGROUND-COLOR BC-F2-Back  FOREGROUND-COLOR BC-F2-Text.
              05 LINE 12 COL 04 PIC X(22) FROM F3-Caption   BACKGROUND-COLOR BC-F3-Back  FOREGROUND-COLOR BC-F3-Text.
              05 LINE 14 COL 04 PIC X(22) FROM F4-Caption   BACKGROUND-COLOR BC-F4-Back  FOREGROUND-COLOR BC-F4-Text.
              05 LINE 16 COL 04 PIC X(22) FROM F5-Caption   BACKGROUND-COLOR BC-F5-Back  FOREGROUND-COLOR BC-F5-Text.

              05 LINE 08 COL 27 PIC X(22) FROM F6-Caption   BACKGROUND-COLOR BC-F6-Back  FOREGROUND-COLOR BC-F6-Text.
              05 LINE 10 COL 27 PIC X(22) FROM F7-Caption   BACKGROUND-COLOR BC-F7-Back  FOREGROUND-COLOR BC-F7-Text.
              05 LINE 12 COL 27 PIC X(22) FROM F8-Caption   BACKGROUND-COLOR BC-F8-Back  FOREGROUND-COLOR BC-F8-Text.
              05 LINE 14 COL 27 PIC X(22) FROM F9-Caption   BACKGROUND-COLOR BC-F9-Back  FOREGROUND-COLOR BC-F9-Text.
              05 LINE 16 COL 27 PIC X(22) FROM F10-Caption  BACKGROUND-COLOR BC-F10-Back FOREGROUND-COLOR BC-F10-Text.

              05 LINE 08 COL 50 PIC X(22) FROM F11-Caption  BACKGROUND-COLOR BC-F11-Back FOREGROUND-COLOR BC-F11-Text.
              05 LINE 10 COL 50 PIC X(22) FROM F12-Caption  BACKGROUND-COLOR BC-F12-Back FOREGROUND-COLOR BC-F12-Text.
              05 LINE 12 COL 50 PIC X(22) FROM F13-Caption  BACKGROUND-COLOR BC-F13-Back FOREGROUND-COLOR BC-F13-Text.
              05 LINE 14 COL 50 PIC X(22) FROM F14-Caption  BACKGROUND-COLOR BC-F14-Back FOREGROUND-COLOR BC-F14-Text.
              05 LINE 16 COL 50 PIC X(22) FROM F15-Caption  BACKGROUND-COLOR BC-F15-Back FOREGROUND-COLOR BC-F15-Text.

              05 LINE 08 COL 73 PIC X(22) FROM F16-Caption  BACKGROUND-COLOR BC-F16-Back FOREGROUND-COLOR BC-F16-Text.
              05 LINE 10 COL 73 PIC X(22) FROM F17-Caption  BACKGROUND-COLOR BC-F17-Back FOREGROUND-COLOR BC-F17-Text.
      *>      05 LINE 12 COL 73 PIC X(22) FROM F18-Caption  BACKGROUND-COLOR BC-F18-Back FOREGROUND-COLOR BC-F18-Text.
      *>      05 LINE 14 COL 73 PIC X(22) FROM F19-Caption  BACKGROUND-COLOR BC-F19-Back FOREGROUND-COLOR BC-F19-Text.
      *>      05 LINE 16 COL 73 PIC X(22) FROM F20-Caption  BACKGROUND-COLOR BC-F20-Back FOREGROUND-COLOR BC-F20-Text.

              05 LINE 08 COL 96 PIC X(8)  VALUE "   OK   ".
              05 LINE 10 COL 96 PIC X(8)  VALUE " CANCEL ".
              05 LINE 12 COL 96 PIC X(8)  VALUE "  HELP  ".

      *>
      *> FREE-FORM OPTIONS FIELDS (Changeable)
      *>
           03 BACKGROUND-COLOR MAIN-BACK FOREGROUND-COLOR MAIN-TEXT PROMPT CHARACTER PROMPTCHAR.
              05 LINE 18 COL 03 PIC X(102) USING EF-COPY.
              05 LINE 20 COL 03 PIC X(102) USING EF-Switches.
              05 LINE 22 COL 03 PIC X(102) USING EF-CompilerArgs.
              05 LINE 24 COL 03 PIC X(102) USING EF-ProgramArgs-1.
              05 LINE 25 COL 03 PIC X(102) USING EF-ProgramArgs-2.
       PROCEDURE DIVISION.
      *>************************************************************************
      *>                             PROCESS TREE                             **
      *>************************************************************************
      *>                                                                      **
      *> MAIN    000-Main                                                     **
      *> MAIN        100-Initialization                                       **
      *> MAIN            CALL "GCINFO"                                        **
      *> MAIN            010-Set-Button-Caption-And-Color                     **
      *> MAIN                099-Terminate                                    **
      *> MAIN                    CALL "LOADER"                                **
      *> MAIN                    030-Delete-Files                             **
      *> MAIN            020-Is-Prog-A-Subprogram                             **
      *> MAIN                099-Terminate                                    **
      *> MAIN                    CALL "LOADER"                                **
      *> MAIN                    030-Delete-Files                             **
      *> MAIN            025-Scan-PSS                                         **
      *> MAIN                035-Load-Switches                                **
      *> MAIN            099-Terminate                                        **
      *> MAIN                CALL "LOADER"                                    **
      *> MAIN                030-Delete-Files                                 **
      *> MAIN        200-Let-User-Set-Switches                                **
      *> MAIN            010-Set-Button-Caption-And-Color                     **
      *> MAIN            015-Identify-Click                                   **
      *> MAIN            025-Scan-PSS                                         **
      *> MAIN                035-Load-Switches                                **
      *> MAIN            099-Terminate                                        **
      *> MAIN                CALL "LOADER"                                    **
      *> MAIN                030-Delete-Files                                 **
      *> MAIN        300-Run-Compiler                                         **
      *> MAIN            010-Set-Button-Caption-And-Color                     **
      *> MAIN            020-Is-Prog-A-Subprogram                             **
      *> MAIN                099-Terminate                                    **
      *> MAIN                    CALL "LOADER"                                **
      *> MAIN                    030-Delete-Files                             **
      *> MAIN            099-Terminate                                        **
      *> MAIN                CALL "LOADER"                                    **
      *> MAIN                030-Delete-Files                                 **
      *> MAIN            035-Load-Switches                                    **
      *> MAIN        400-Generate-Listing                                     **
      *> MAIN            CALL "LISTER"                                        **
      *> MAIN            099-Terminate                                        **
      *> MAIN                CALL "LOADER"                                    **
      *> MAIN                030-Delete-Files                                 **
      *> MAIN        500-Submit-Commands                                      **
      *> MAIN        099-Terminate                                            **
      *> MAIN            CALL "LOADER"                                        **
      *> MAIN            030-Delete-Files                                     **
      *>                                                                      **
      *>************************************************************************
       000-Main SECTION.
      *>   *********************************************************************
      *>   ** Get the number of arguments and initialize debugging if enabled **
      *>   *********************************************************************
           ACCEPT NArgs FROM ARGUMENT-NUMBER END-ACCEPT
           IF NArgs = 0
               MOVE -1 TO Exit-Code
               PERFORM 099-Terminate *> No file was specified
               *> Control will NOT return
           END-IF
DEBUG D    MOVE LOW-VALUES TO Procedure-Stack
DEBUG D    MOVE ALL "0" TO Debug-Switches
DEBUG D    ACCEPT Text-256 FROM COMMAND-LINE END-ACCEPT
DEBUG D    PERFORM VARYING I FROM 2 BY 1 UNTIL I > NArgs
DEBUG D        DISPLAY I UPON ARGUMENT-NUMBER END-DISPLAY
DEBUG D        ACCEPT Arg-Value FROM ARGUMENT-VALUE END-ACCEPT
DEBUG D        EVALUATE UPPER-CASE(Arg-Value)
DEBUG D        WHEN "ALL"      MOVE ALL "1" TO Debug-Switches
DEBUG D        WHEN "XALL"     MOVE ALL "1" TO X-OPTIONS
DEBUG D        WHEN "INFO"     COMPUTE INFO-Sw     = 1 - INFO-Sw     END-COMPUTE
DEBUG D        WHEN "INTERNAL" COMPUTE INTERNAL-Sw = 1 - INTERNAL-Sw END-COMPUTE
DEBUG D        WHEN "SOURCE"   COMPUTE SOURCE-Sw   = 1 - SOURCE-Sw   END-COMPUTE
DEBUG D        WHEN "SPLIT"    COMPUTE SPLIT-Sw    = 1 - SPLIT-Sw    END-COMPUTE
DEBUG D        WHEN "SUB"      COMPUTE SUB-Sw      = 1 - SUB-Sw      END-COMPUTE
DEBUG D        WHEN "TRACE"    COMPUTE TRACE-Sw    = 1 - TRACE-Sw    END-COMPUTE
DEBUG D        WHEN "USER"     COMPUTE USER-Sw     = 1 - USER-Sw     END-COMPUTE
DEBUG D        WHEN "XFAST"    COMPUTE XFAST-Sw    = 1 - XFAST-Sw    END-COMPUTE
DEBUG D        WHEN "XFSM"     COMPUTE XFSM-Sw     = 1 - XFSM-Sw     END-COMPUTE
DEBUG D        WHEN "XPARSE"   COMPUTE XPARSE-Sw   = 1 - XPARSE-Sw   END-COMPUTE
DEBUG D        WHEN "XRAFT"    COMPUTE XRAFT-Sw    = 1 - XRAFT-Sw    END-COMPUTE
DEBUG D        WHEN "XREAD"    COMPUTE XREAD-Sw    = 1 - XREAD-Sw    END-COMPUTE
DEBUG D        WHEN "XREF"     COMPUTE XREF-Sw     = 1 - XREF-Sw     END-COMPUTE
DEBUG D        WHEN "XTOKEN"   COMPUTE XTOKEN-Sw   = 1 - XTOKEN-Sw   END-COMPUTE
DEBUG D        WHEN "XWORDS"   COMPUTE XWORDS-Sw   = 1 - XWORDS-Sw   END-COMPUTE
DEBUG D        WHEN OTHER      DISPLAY "Unknown Option: " UPPER-CASE(Arg-Value) UPON SYSERR END-DISPLAY
DEBUG D        END-EVALUATE
DEBUG D    END-PERFORM
DEBUG D    IF Debug-Switches NOT = ALL "0"
DEBUG D        DISPLAY "******* Debugging Mode Active *******"                                  UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY " "                                                                      UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "INFO......" INFO-Sw   "  XFAST....." XFAST-Sw  "  XREAD....." XREAD-Sw  UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "INTERNAL.." SOURCE-Sw "  XFSM......" XFSM-Sw   "  XREF......" XREF-Sw   UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "SOURCE...." SOURCE-Sw "  XPARSE...." XPARSE-Sw "  XTOKEN...." XTOKEN-Sw UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "SPLIT....." SPLIT-Sw  "  XRAFT....." XRAFT-Sw  "  XWORDS...." XWORDS-Sw UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "SUB......." SUB-Sw                                                      UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "TRACE....." TRACE-Sw                                                    UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY "USER......" USER-Sw                                                     UPON SYSERR END-DISPLAY
DEBUG D        DISPLAY " "                                                                      UPON SYSERR END-DISPLAY
DEBUG D        CALL "DBGENTER" USING TRACE-Sw "TRACE" "MAIN"     END-CALL
DEBUG D        CALL "DBGENTER" USING TRACE-Sw "TRACE" "000-Main" END-CALL
DEBUG D    END-IF
      *>   *********************************************************************
      *>   ** Now the real work begins...                                     **
      *>   *********************************************************************
           PERFORM 100-Initialization
           SET FSR-Refresh-Needed TO TRUE
           PERFORM UNTIL CS-Compile-Clean
               PERFORM 200-Let-User-Set-Switches
               PERFORM 300-Run-Compiler
               PERFORM 400-Generate-Listing
           END-PERFORM
           PERFORM 500-Submit-Commands
           MOVE 0 TO Exit-Code
           PERFORM 099-Terminate *> Control will NOT return
           .
       010-Set-Button-Caption-And-Color SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "010-Set-Button-Caption-And-Color" END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-Sw "TRACE" "Search-Key" Search-Key            END-CALL
      *>************************************************************************
      *> Perform a binary search against the Option-Tbl table, locating a     **
      *> specific function's option text and switch settings.                 **
      *>************************************************************************
           SEARCH ALL Option-Tbl
           AT END
      *>       *****************************************************************
      *>       ** Couldn't find it!  Display a message on the 34th line and   **
      *>       ** quit.  This should only happen if FT-Opt-Qty has a larger   **
      *>       ** value than the actual number of Option-Tbl entries for the  **
      *>       ** function who's button the user just pressed, or if the      **
      *>       ** OF-Opt-No values for that function are not consecutive.     **
      *>       *****************************************************************
               MOVE Search-Key-9999 TO EMA-AAAA
               MOVE 17 TO Exit-Code
               PERFORM 099-Terminate *> Internal Error: Missing Option in Option-tbl (AAAA)
               *> Control will not return
           WHEN Option-Func(Option-Idx) = Search-Key
               MOVE Option-Text(Option-Idx) TO FCT-Caption(SK-Function)
               MOVE Option-Long-Text(Option-Idx) TO Output-Msg
               IF FT-Curr-Opt-No(SK-Function) = FT-Default-Opt-No(SK-Function)
                   MOVE BTN-BACK      TO BC-Back(SK-Function)
                   MOVE BTN-TEXT      TO BC-Text(SK-Function)
               ELSE
                   MOVE BTN-CUSTOM-BACK TO BC-Back(SK-Function)
                   MOVE BTN-CUSTOM-TEXT TO BC-Text(SK-Function)
               END-IF
DEBUG D        CALL "DBGKWV" USING USER-Sw "USER" "Function"    SK-Function,
DEBUG D                                           "New Option"  FCT-Caption(SK-Function)
DEBUG D        END-CALL
           END-SEARCH
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       015-Identify-Click SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "015-Identify-Click" END-CALL
      *>************************************************************************
      *> Interpret a left- or right-click of the mouse, identifying if a but- **
      *> ton was 'pushed' and - if so - which one                             **
      *>************************************************************************
           SET Button-IDX TO 1
           SEARCH Button-Tbl VARYING Button-Idx
           AT END
               SET User-Goofed TO TRUE
           WHEN BT-Row(Button-Idx)       =  CC-Row
            AND BT-Col-Start(Button-Idx) <= CC-Col
            AND BT-Col-End(Button-Idx)   >= CC-Col
               EVALUATE TRUE
      *>                                          -------------------------------------------------------------
               WHEN BT-ID(Button-Idx) = "NOP"     SET  User-Clicked-Field         TO TRUE
                                                  MOVE 003 TO CC-Col *> Reset cursor to START of entry field
DEBUG D                                           CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                                                  EXIT SECTION *> Do Nothing
      *>                                          -------------------------------------------------------------
               WHEN BT-ID-Type(Button-Idx) = "F"  MOVE BT-Function-No(Button-Idx) TO Function-No
                                                  SET  User-Clicked-Function TO TRUE
                                                  DISPLAY FCT-Caption(Function-No)
                                                      AT LINE BT-Row(Button-Idx) COL BT-Col-Start(Button-Idx)
                                                      WITH BACKGROUND-COLOR BTN-TEXT FOREGROUND-COLOR BTN-BACK
                                                  END-DISPLAY
      *>                                          -------------------------------------------------------------
               WHEN OTHER                         MOVE BT-ID(Button-Idx)           TO User-Action-Taken
                                                  MOVE BT-Caption-Size(Button-Idx) TO I
                                                  DISPLAY BT-Caption(Button-Idx)(1:I)
                                                      AT LINE BT-Row(Button-Idx) COL BT-Col-Start(Button-Idx)
                                                      WITH BACKGROUND-COLOR BTN-TEXT FOREGROUND-COLOR BTN-BACK
                                                  END-DISPLAY
      *>                                          -------------------------------------------------------------
               END-EVALUATE
               CALL "CBL_GC_NANOSLEEP" USING 050000000 END-CALL
           END-SEARCH
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       020-Is-Prog-A-Subprogram SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "020-Is-Prog-A-Subprogram" END-CALL
      *>************************************************************************
      *> Determine if the first program being compiled in the source file is  **
      *> a MAIN program or a subprogram, with the result determining whether  **
      *> the default for the F3 key is to use the "-x" switch on cobc (main)  **
      *> or the "-m" switch (subprogram).  This will be done by looking for a **
      *> LINKAGE SECTION in the file's first (or only) program.  Of course,   **
      *> if that first program really IS a subprogram (which should be compi- **
      *> led using the "-m" switch) but doesn't accept any arguments, this    **
      *> code will erroneously conclude the file should be compiled with the  **
      *> "-x" switch.  The user can always select either switch using the F3  **
      *> key.  If GCic was generated to assume the "-m" switch, this routine  **
      *> won't mess with that...it will just OPEN and CLOSE the source code   **
      *> file just to make sure that file exists.                             **
      *>                                                                      **
      *> The search will end once:                                            **
      *>                                                                      **
      *> 1. LINKAGE SECTION is found in columns 2+ * (IS a subroutine & F3    **
      *>    defaults to "-m"), OR...                                          **
      *>                                                                      **
      *> 2. End-of-file is reached (is NOT a subroutine - F3 defaults to      **
      *>    "-x"), OR...                                                      **
      *>                                                                      **
      *> 3. PROCEDURE DIVISION is found IN columns 2+ * (is NOT a subroutine  **
      *>    & F3 defaults to "-x")                                            **
      *>                                                                      **
      *>    * Columns after the first "*>" will not be checked, and records   **
      *>      containing a "*" or "/" in column 7 will be ignored altogether. **
      *>                                                                      **
      *> While THIS scan is taking place, another is being done in parallel - **
      *> looking for Program-specified cobc switch comments and "ON SUCCESS"  **
      *> records.                                                             **
      *>************************************************************************
           MOVE SPACES TO PSS-All-Switches
                          OSC-All-Commands
           MOVE 0      TO PSS-Sub
                          OSC-Sub
           CALL "CBL_CHECK_FILE_EXIST" USING TRIM(Source-Filename) Text-256 END-CALL
           IF RETURN-CODE NOT = 0
               MOVE 18 TO Exit-Code
               PERFORM 099-Terminate *> Fatal Error: Specified source program file does not exist
               *> Control will not return
           END-IF
           OPEN INPUT Source-Code-File; MOVE 1 TO Source-Open
           SET FLS-LINKAGE-SECTION TO FALSE
           PERFORM UNTIL FLS-Done
               READ Source-Code-File
               AT END
                   SET FLS-Hit-EOF TO TRUE
               NOT AT END
DEBUG D            CALL "DBGDUMP" USING SUB-Sw "SUB" "Source Code Record" Source-Code-Rec END-CALL
      *>           *************************************************************
      *>           ** Does this line contain Program-Specified Switches and/or**
      *>           ** "ON SUCCESS" records?                                   **
      *>           *************************************************************
                   MOVE SPACES TO Token-1
                                  Token-2
                   MOVE 0      TO Tally-1
                                  Tally-2
                   INSPECT UPPER-CASE(Source-Code-Rec) TALLYING Tally-1 FOR CHARACTERS BEFORE INITIAL "*> COBC SWITCHES: "
                   INSPECT UPPER-CASE(Source-Code-Rec) TALLYING Tally-2 FOR CHARACTERS BEFORE INITIAL "*> ON SUCCESS: "
DEBUG D            CALL "DBGKWV" USING SUB-Sw "SUB" "Tally-1" Tally-1 "Tally-2" Tally-2 END-CALL
                   IF Tally-1 < LENGTH(Source-Code-Rec)
                       MOVE Source-Code-Rec(Tally-1 + 19:) TO Token-1
DEBUG D                CALL "DBGKWV" Using SUB-Sw "SUB" "Token-1" Token-1 END-CALL
                   END-IF
                   IF Tally-2 < LENGTH(Source-Code-Rec)
                       MOVE Source-Code-Rec(Tally-2 + 16:) TO Token-2
DEBUG D                CALL "DBGKWV" Using SUB-Sw "SUB" "Token-2" Token-2 END-CALL
                   END-IF
                   IF Token-1 NOT = SPACES
      *>               *********************************************************
      *>               ** "YES" to Program-Specified Switches                 **
      *>               *********************************************************
                       IF PSS-Sub < PSSQTY
                           ADD 1 TO PSS-Sub END-ADD
                           MOVE TRIM(Token-1) TO PSS-Text(PSS-Sub)
                       END-IF
                       EXIT PERFORM CYCLE
                   END-IF
                   IF Token-2 NOT = SPACES
      *>               *********************************************************
      *>               ** "YES" to an ON SUCCESS record                       **
      *>               *********************************************************
                       IF OSC-Sub < OSCQTY
                           ADD 1 TO OSC-Sub END-ADD
                           MOVE TRIM(Token-2) TO OSC-Command(OSC-Sub)
                       END-IF
                       EXIT PERFORM CYCLE
                   END-IF
                   IF Source-Code-Rec(7:1) = "*" OR "/" *> Traditional comment
                       EXIT PERFORM CYCLE *> Try next record
                   END-IF
                   MOVE 0 TO Tally-1
                             Tally-2
                   INSPECT Source-Code-Rec
                       TALLYING Tally-1 FOR ALL "*>"
                                Tally-2 FOR CHARACTERS BEFORE INITIAL "*>"
                   IF Tally-1 > 0 *> There is a new-age comment
                       ADD 1 TO Tally-2 END-ADD *> #chars before *> now char ptr to *>
                       MOVE SPACES TO Source-Code-Rec(Tally-2:)
                   END-IF
                   MOVE 0      TO Tally-1
                                  Tally-2
                   INSPECT Source-Code-Rec(2:)
                       TALLYING Tally-1 FOR ALL "LINKAGE SECTION"
                                Tally-2 FOR ALL "PROCEDURE DIVISION"
DEBUG D            CALL "DBGKWV" USING SUB-Sw "SUB" "LINKAGE SECTION" Tally-1 "PROCEDURE DIVISION" Tally-2 END-CALL
                   EVALUATE TRUE
      *>                              -------------------------------
                   WHEN Tally-1 > 0   SET FLS-LINKAGE-SECTION TO TRUE *> Found LINKAGE SECTION
                                      EXIT PERFORM
      *>                              -------------------------------
                   WHEN Tally-2 > 0   SET FLS-END-PROGRAM TO TRUE     *> Found PROCEDURE DIVISION before LINKAGE SECTION
                                      EXIT PERFORM
      *>                              -------------------------------
                   END-EVALUATE
               END-READ
           END-PERFORM
           >>IF F4 = 1
           IF FLS-LINKAGE-SECTION
               MOVE 2 TO F4-Output-Opt-No
           END-IF
           >>END-IF
           CLOSE Source-Code-File; MOVE 0 TO Source-Open
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       025-Scan-PSS SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "025-Scan-PSS" END-CALL
      *>************************************************************************
      *> If function 15 = "Yes", see if any program-specified switches match  **
      *> up to the switches in the feature options table.  If they do, select **
      *> them as if the user did it.                                          **
      *>                                                                      **
      *> This will be PERFORMed two times:                                    **
      *> 1. Right before we turn control over to the user, to set up the ini- **
      *>    tial screen.                                                      **
      *> 2. Whenever the user changes F15 to "Yes".                           **
      *>************************************************************************
DEBUG D    CALL "DBGKWV" USING USER-Sw "USER" "F15-PrgSpcSwtchs-Opt-No" F15-PrgSpcSwtchs-Opt-No
DEBUG D                                       "PSS-All-Switches"        PSS-All-Switches
DEBUG D    END-CALL
           IF FPSSS-Scanned
DEBUG D        CALL "DBGTXT"  USING USER-Sw  "USER" "Already Scanned for PSS" END-CALL
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE"                          END-CALL
               EXIT SECTION
           END-IF
           IF F15-PrgSpcSwtchs-Opt-No NOT = 2              *> If "Pgm-Specified Switches" NOT = 2 ("Yes")
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-IF
           PERFORM VARYING I FROM 1 BY 1 UNTIL Option-Func(I) = LOW-VALUES
               IF Option-PSS-Size(I) > 0                   *> TRUE = Option eligible for PSS match
                   MOVE 0 TO Tally-1
                   MOVE Option-Switch(I)   TO Text-31
                   MOVE Option-PSS-Size(I) TO J
                   INSPECT PSS-All-Switches TALLYING Tally-1
                       FOR ALL Text-31(1:J)
                   IF Tally-1 > 0                          *> Found the table's switch in PSS string
                       INSPECT PSS-All-Switches
                           REPLACING ALL Text-31(1:J) BY SPACES
                       MOVE OF-Func-No(I) TO SK-Function
                       MOVE OF-Opt-No(I)  TO SK-Opt-No
                                             FT-Curr-Opt-No(SK-Function)
                       PERFORM 010-Set-Button-Caption-And-Color
                       SET FSR-Refresh-Needed TO TRUE
                   END-IF
               END-IF
           END-PERFORM
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > PSSQTY
               MOVE PSS-Text(I) TO CST-Switch-Arg
               PERFORM 035-Load-Switches
           END-PERFORM
           MOVE SPACES TO EF-Switches
           MOVE 1 TO J
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > CST-Sub
               STRING TRIM(CST-Switch(I)) DELIMITED BY SIZE
                      " "                 DELIMITED BY SIZE
                      INTO EF-Switches
                      WITH POINTER J
               ON OVERFLOW
                   MOVE SPACES TO EF-Switches
                   EXIT PERFORM
               END-STRING
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       030-Delete-Files SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "030-Delete-Files" END-CALL
      *>   *********************************************************************
      *>   ** Delete any and all temporary files created by "cobc" or "GCic"  **
      *>   *********************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL Temp-File(I) = LOW-VALUES
               IF TF-Wildcard(I) = "*"
                   MOVE CONCATENATE(
                                    "ccc ",
                                    TRIM(Temps-Dir),
                                    SUBSTITUTE(TF-Filename(I),"xxxxxx",TRIM(Program-Name))
                                    " > "
                                    OS-Null-Device
                                    " 2>&1"
                                    )
                       TO Text-104
                   IF OTC-Is-Windows
                       INSPECT Text-104 REPLACING FIRST "ccc" BY "del"
                   ELSE
                       INSPECT Text-104 REPLACING FIRST "ccc" BY "rm "
                   END-IF
DEBUG D            CALL "DBGTXT" USING USER-Sw "USER" TRIM(Text-104) END-CALL
                   CALL "SYSTEM" USING TRIM(Text-104) END-CALL
                   EXIT PERFORM CYCLE
               ELSE
                   MOVE SUBSTITUTE(TF-Filename(I),"xxxxxx",TRIM(Program-Name)) TO Text-104
                   CALL "CBL_CHECK_FILE_EXIST" USING TRIM(Text-104) Text-256 END-CALL
DEBUG D            MOVE RETURN-CODE TO Return-Code-Display        *> In case "DBGKWV" ever starts using RETURN-CODE
DEBUG D            CALL "DBGKWV" USING USER-Sw "USER" "File" Text-104
DEBUG D                                               "RETURN-CODE" Return-Code-Display
DEBUG D            END-CALL
DEBUG D            MOVE J TO RETURN-CODE                          *> In case "DBGKWV" ever starts using RETURN-CODE
                   IF RETURN-CODE = 0
                       CALL "CBL_DELETE_FILE" USING TRIM(Text-104) END-CALL
                   END-IF
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       035-Load-Switches SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "035-Load-Switches" END-CALL
      *>************************************************************************
      *> Scan "Text-256" for cobc switches and load the "Cobc-Switch-Table"   **
      *> with them                                                            **
      *>************************************************************************
           PERFORM UNTIL CST-Switch-Arg = SPACES
               IF CST-Switch-Arg(1:1) = " "                    *> If 1st char is a space...
                   MOVE TRIM(CST-Switch-Arg) TO CST-Switch-Arg *> Get rid of leading spaces
               END-IF
DEBUG D        CALL "DBGKWV" USING USER-Sw "USER" "CST-Switch-Arg" CST-Switch-Arg END-CALL
               MOVE 0 TO J
               MOVE SPACES TO Text-256
               MOVE 0 TO Tally-1
               INSPECT CST-Switch-Arg TALLYING Tally-1 FOR CHARACTERS BEFORE INITIAL " -"
               ADD 1 TO CST-Sub END-ADD
               IF Tally-1 = 256                            *> Only one switch
                   MOVE CST-Switch-Arg            TO CST-Switch(CST-Sub)
                                                     Text-256
                   MOVE SPACES                    TO CST-Switch-Arg
               ELSE                                        *> More than one switch
                   MOVE CST-Switch-Arg(1:Tally-1) TO CST-Switch(CST-Sub)
                                                     Text-256
                   MOVE SPACES                    TO CST-Switch-Arg(1:Tally-1)
               END-IF
               MOVE SPACES TO Tokens
               UNSTRING Text-256 DELIMITED BY "=" OR ALL SPACES
                   INTO Token-1, Token-2
               END-UNSTRING
               MOVE Token-1 TO CST-Switch-Name(CST-Sub)    *> Save the switch name
               MOVE SPACES TO CST-Switch-Arg(1:J)
DEBUG D        CALL "DBGDUMP" USING USER-Sw "USER" "Cobc-Switch-Table" Cobc-Switch-Table END-CALL
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       099-Terminate SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "099-Terminate"       END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-Sw "TRACE" "Exit-Code" Exit-Code END-CALL
      *>************************************************************************
      *> Display a message and halt the program -                             **
      *>************************************************************************
           IF Listing-Open = 1  CLOSE COBC-Messages-File END-IF *> Gracefully CLOSE any OPEN files
           IF Source-Open = 1   CLOSE COBC-Output-File   END-IF
           IF Source-Open = 1   CLOSE Source-Code-File   END-IF
           IF FCF-User-Wants-Out *> User hit CANCEL or Esc
               PERFORM 030-Delete-Files
DEBUG D        CALL "DBGSTOP" USING TRACE-Sw "TRACE" END-CALL
               DISPLAY Erase-Screen END-DISPLAY
               STOP RUN
           END-IF
           IF Exit-Code < 0
      *>       *****************************************************************
      *>       ** Negative exit codes display error messages BEFORE the usual **
      *>       ** screen has been initialized.                                **
      *>       *****************************************************************
               ACCEPT CC-Row FROM LINES END-ACCEPT   *> Get screen geometry
               ACCEPT CC-Col FROM COLUMNS END-ACCEPT
               COMPUTE I = (CC-Row / 2) - 1 END-COMPUTE
               EVALUATE Exit-Code
      *>                --------------------------------------------------------------------
               WHEN -1  COMPUTE J = (CC-Col / 2) - 10 END-COMPUTE
                        DISPLAY "NO FILE WAS SPECIFIED" AT LINE I COLUMN J END-DISPLAY
      *>                --------------------------------------------------------------------
               WHEN -2  COMPUTE J = (CC-Col / 2) - 13 END-COMPUTE
                        DISPLAY "SCREEN GEOMETRY MUST BE SET" AT LINE I COLUMN J END-DISPLAY
                        ADD 1 TO I END-ADD
                        DISPLAY "to 28 lines and 106 columns" AT LINE I COLUMN J END-DISPLAY
      *>                --------------------------------------------------------------------
               WHEN -3  SUBTRACT 1 FROM I END-SUBTRACT
                        COMPUTE J = (CC-Col / 2) - 11 END-COMPUTE
                        DISPLAY " CANNOT DETERMINE OS     " AT LINE I COLUMN J END-DISPLAY
                        ADD 1 TO I END-ADD
                        DISPLAY "Set 'OS' in 'gcic.cbl'" AT LINE I COLUMN J END-DISPLAY
                        ADD 1 TO I END-ADD
                        DISPLAY " and recompile gcic   " AT LINE I COLUMN J END-DISPLAY
      *>                --------------------------------------------------------------------
               END-EVALUATE
               CALL "C$SLEEP" USING 6 END-CALL
DEBUG D        CALL "DBGSTOP" USING TRACE-Sw "TRACE" END-CALL
               STOP RUN
           END-IF
           COMPUTE I = LENGTH(Error-Messages-Tbl) / 90 END-COMPUTE
           IF Exit-Code > I
               MOVE 16 TO Exit-Code
           END-IF
           IF Exit-Code > 0
               MOVE Error-Msg(Exit-Code) TO Text-104
               INSPECT Text-104 REPLACING
                   ALL "AAAA" BY EMA-AAAA
                   ALL "BBBB" BY EMA-BBBB
                   ALL "@"    BY EMA-X1X
               OPEN EXTEND COBC-Messages-File; MOVE 1 TO Listing-Open *> Re-open for a moment
               WRITE COBC-Messages-Rec FROM Text-104 END-WRITE
               CLOSE COBC-Messages-File; MOVE 0 TO Listing-Open
           END-IF
           CALL 'LOADER' USING Messages-Filename GCInfo-Arg END-CALL
           EVALUATE TRUE
      *>                        --------------------------------------------------
           WHEN Exit-Code = 05  MOVE Text-104     TO Output-Msg *> Recoverable error in compilation
                                MOVE ERROR-BACK TO Bottom-Line-Back
                                MOVE ERROR-TEXT TO Bottom-Line-Text
                                DISPLAY Switches-Screen END-DISPLAY
                                MOVE 00 TO Exit-Code
DEBUG D                         CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                                EXIT SECTION
      *>                        --------------------------------------------------
           WHEN Exit-Code > 00  DISPLAY TRIM(Text-104) UPON SYSERR END-DISPLAY
                                MOVE CONCATENATE(
                                                 TRIM(Text-104),
                                                 " - Click Mouse to Close"
                                                 )
                                    TO Output-Msg
                                MOVE ERROR-BACK TO Bottom-Line-Back
                                MOVE ERROR-TEXT TO Bottom-Line-Text
                                ACCEPT Switches-Screen TIMEOUT AFTER 20 END-ACCEPT
DEBUG D                         CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
                                STOP RUN
      *>                        --------------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** NORMAL TERMINATION - Is file cleanup wanted by the user?        **
      *>   *********************************************************************
           IF F4-Output-Opt-No > 2           *> If one of the >Source< Output options was picked
               SET FDT-Delete-Temps TO FALSE *> ...Behave as if user specified "-save-temps"
           END-IF
           IF FDT-Delete-Temps
               PERFORM 030-Delete-Files
           ELSE
DEBUG D        CALL "DBGSTOP" USING TRACE-Sw "TRACE" END-CALL
               DISPLAY Erase-Screen END-DISPLAY
               STOP RUN
           END-IF
DEBUG D    CALL "DBGSTOP" USING TRACE-Sw "TRACE" END-CALL
           DISPLAY Erase-Screen END-DISPLAY
           STOP RUN
           .
       100-Initialization SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "100-Initialization" END-CALL
      *>************************************************************************
      *> Perform all program-wide initialization operations                   **
      *>************************************************************************
           MOVE ALL LD-Horiz-Line TO Horiz-Line-102
           MOVE SPACES            TO Entry-Fields
                                     Function-Captions
           SET FCF-User-Wants-Out TO FALSE
           SET FPSSS-Scanned      TO FALSE
           MOVE COPYRIGHT-BACK TO Bottom-Line-Back
           MOVE COPYRIGHT-TEXT TO Bottom-Line-Text
           >>IF LOCKFILE = 1
           CALL "C$GETPID" END-CALL          *> Get this process' PID
           MOVE RETURN-CODE TO PID           *> And save it for later
                               PID-Formatted
           MOVE 0           TO RETURN-CODE   *> Reinitialize RETURN-CODE
           >>END-IF
      *>   *********************************************************************
      *>   ** Eliminate the "end of program" message, ensure full screen-     **
      *>   ** handling is active, and turn on mouse handling.                 **
      *>   *********************************************************************
           COMPUTE COB-MOUSE-FLAGS = COB-ALLOW-LEFT-DOWN
                                   + COB-ALLOW-RIGHT-DOWN
      *                            + COB-AUTO-MOUSE-HANDLING  *> Disable for now - screenio issues w/ four entry fields
           END-COMPUTE
           SET ENVIRONMENT "COB_SCREEN_EXCEPTIONS" TO "Y"
           SET ENVIRONMENT "COB_SCREEN_ESC"        TO "Y"
           SET ENVIRONMENT "COB_EXIT_WAIT"         TO "0"
           SET ENVIRONMENT "COB_MOUSE_FLAGS"       TO COB-MOUSE-FLAGS
      *>   *********************************************************************
      *>   ** Compute the FT-Opt-Qty values for all functions                 **
      *>   *********************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL Function-Tbl(I) = LOW-VALUES
                     AFTER J FROM 1 BY 1 UNTIL Option-Text(J)  = LOW-VALUES
               IF OF-Func-No(J) = I
                   ADD 1 TO FT-Opt-Qty(I) END-ADD
               END-IF
           END-PERFORM
      *>   *********************************************************************
      *>   ** Generate the fully-qualified name of the HTML file              **
      *>   *********************************************************************
           MOVE MODULE-PATH TO Help-File
           PERFORM VARYING I FROM LENGTH(Help-File) BY -1 UNTIL (I = 0) OR (Help-File(I:1) = "/" OR "\")
               CONTINUE
           END-PERFORM
           ADD 1 TO I END-ADD
           MOVE "gcic-readme.html" TO Help-File(I:) *> Replace this pgm's name w/ the HTML file's name
      *>   *********************************************************************
      *>   ** Get GCic Compilation Date/Time                                  **
      *>   *********************************************************************
           MOVE WHEN-COMPILED(1:12) TO GC-Compile-DateTime
           INSPECT GC-Compile-DateTime
               REPLACING ALL "/" BY ":"
               AFTER INITIAL SPACE
      *>   *********************************************************************
      *>   ** Get info on GnuCOBOL on this machine and use that to define     **
      *>   ** some things we'll be needing                                    **
      *>   *********************************************************************
           CALL "GCINFO" USING BY REFERENCE GCInfo-Arg END-CALL
           INSPECT GA-Version REPLACING ALL ".0 " BY "   " *> "3.1.2.0 " --> "3.1.2   ", "3.2.0.0 " --> "3.2.0   "
           INSPECT GA-Version REPLACING ALL ".0 " BY "   " *> "3.2.0   " --> "3.2     "
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "OS-Type-Code" OS-Type-Code
DEBUG D                                       "GA-OS-Type"   GA-OS-Type
DEBUG D    END-CALL
           IF OS-Type-Code = 0
               MOVE GA-OS-Type TO OS-Type-Code
           END-IF
      *>************************************************************************
      *> Adjust option switches if using pre-3.2 GnuCOBOL                     **
      *>************************************************************************
           IF GA-Version-No >= 3 and GA-Release-No >= 2
               CONTINUE *> if 3.2+, leave things alone
           ELSE *> just allow fixed/free/variable source formats
               MOVE "-free"                    TO F10-1-Switch
               MOVE "-fixed"                   TO F10-2-Switch
               MOVE "-fixed -ftext-column=250" TO F10-3-Switch
               MOVE "25"                       TO F10-3-Len
               MOVE 3                          TO F10-Qty-Override
           END-IF
      *>************************************************************************
      *> Set OS-Specific items                                                **
      *>************************************************************************
           EVALUATE OS-Type-Code
      *>               ----------------------------------------------------------------------
           WHEN 1      MOVE "     An EXE (-x)      "                        TO F4-O1-Caption  *> Native Windows
                       MOVE "      A DLL (-m)      "                        TO F4-O2-Caption
                       MOVE "\"                                             TO OS-Dir-Chr
                       MOVE "nul:"                                          TO OS-Null-Device
                       MOVE ":"                                             TO OS-Path-Char
      *>               ----------------------------------------------------------------------
           WHEN 2      MOVE "     An EXE (-x)      "                        TO F4-O1-Caption *> Windows/Cygwin
                       MOVE "      A DLL (-m)      "                        TO F4-O2-Caption
                       MOVE ":"                                             TO OS-Path-Char
                       MOVE "/dev/null"                                     TO OS-Null-Device
                       MOVE "/"                                             TO OS-Dir-Chr
      *>               ----------------------------------------------------------------------
           WHEN 3      MOVE " Executable File (-x) "                        TO F4-O1-Caption *> *NIX
                       MOVE "       An SO (-m)     "                        TO F4-O2-Caption
                       MOVE ":"                                             TO OS-Path-Char
                       MOVE "/dev/null"                                     TO OS-Null-Device
                       MOVE "/"                                             TO OS-Dir-Chr
      *>               ----------------------------------------------------------------------
           WHEN 4      MOVE " Executable File (-x) "                        TO F4-O1-Caption *> MacOS
                       MOVE "     A DYLIB (-m)     "                        TO F4-O2-Caption
                       MOVE "/"                                             TO OS-Dir-Chr
                       MOVE "/dev/null"                                     TO OS-Null-Device
                       MOVE ":"                                             TO OS-Path-Char
      *>               ----------------------------------------------------------------------
           WHEN 5      MOVE "     An EXE (-x)      "                        TO F4-O1-Caption *> Windows/MinGW
                       MOVE "      A DLL (-m)      "                        TO F4-O2-Caption *> or MSYS
                       MOVE "\"                                             TO OS-Dir-Chr    *> or MSYS2
                       MOVE "nul:"                                          TO OS-Null-Device
                       MOVE ";"                                             TO OS-Path-Char
      *>               ----------------------------------------------------------------------
           WHEN OTHER  MOVE -3 TO Exit-Code
                       PERFORM 099-Terminate *> Cannot Determine OS
                       *> Control will NOT return
      *>               ------------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** Determine resize method from OS setting?                        **
      *>   *********************************************************************
           EVALUATE TRUE ALSO TRUE
      *>                                        ------------------------------------------------------------------------------
           WHEN RT-Auto    ALSO OTC-Is-Windows  MOVE -2 TO Resize-Type                 *> MODE cmd BEFORE init
      *>                                        ------------------------------------------------------------------------------
           WHEN RT-Auto    ALSO OTC-Is-MacOS    MULTIPLY 3 BY Resize-Type END-MULTIPLY *> RESIZE cmd BEFORE or AFTER init
      *>                                        ------------------------------------------------------------------------------
           WHEN RT-Auto    ALSO OTC-Is-Cygwin   MULTIPLY 4 BY Resize-Type END-MULTIPLY *> Cygwin ESC seq, BEFORE or AFTER init
      *>                                        ------------------------------------------------------------------------------
           WHEN RT-Auto    ALSO ANY             SET RT-None TO TRUE                    *> Manual resize
      *>                                        ------------------------------------------------------------------------------
           WHEN RT-Invalid ALSO ANY             SET RT-None TO TRUE                    *> Bad value = no resize
      *>                                        ------------------------------------------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** Generate "OS-Resize" string from Resize-Type                    **
      *>   *********************************************************************
           EVALUATE TRUE
      *>                   -----------------------------------------------------------------
           WHEN RT-Mode    MOVE "mode con: cols=106 lines=28"                   TO OS-Resize
      *>                   -----------------------------------------------------------------
           WHEN RT-Resize  MOVE "resize -s 28 106&&stty rows 28&&stty cols 106" TO OS-Resize
      *>                   -----------------------------------------------------------------
           WHEN RT-Cygwin  MOVE CONCATENATE(X"1B","[8;28;106t")                 TO OS-Resize
      *>                   -----------------------------------------------------------------
           WHEN RT-Cmd     MOVE RESIZESEQ                                       TO OS-Resize
      *>                   -----------------------------------------------------------------
           WHEN RT-Curses  CONTINUE
      *>                   -----------------------------------------------------------------
           WHEN RT-Esc     MOVE CONCATENATE(X"1B",RESIZESEQ)                    TO OS-Resize
      *>                   -----------------------------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** Resize BEFORE screen init                                       **
      *>   *********************************************************************
           EVALUATE TRUE
      *>                          -----------------------------------------------
           WHEN RT-Mode-Before    CALL "SYSTEM" USING TRIM(OS-Resize) END-CALL
      *>                          -----------------------------------------------
           WHEN RT-Resize-Before  CALL "SYSTEM" USING TRIM(OS-Resize) END-CALL
      *>                          -----------------------------------------------
           WHEN RT-Cygwin-Before  DISPLAY TRIM(OS-Resize) UPON SYSOUT END-DISPLAY
      *>                          -----------------------------------------------
           WHEN RT-Cmd-Before     CALL "SYSTEM" USING TRIM(OS-Resize) END-CALL
      *>                          -----------------------------------------------
           WHEN RT-Esc-Before     DISPLAY TRIM(OS-Resize) UPON SYSOUT END-DISPLAY
      *>                          -----------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** Screen init                                                     **
      *>   *********************************************************************
           ACCEPT CC-Row FROM LINES   END-ACCEPT
           ACCEPT CC-Col FROM COLUMNS END-ACCEPT
      *>   *********************************************************************
      *>   ** Resize AFTER screen init                                        **
      *>   *********************************************************************
           EVALUATE TRUE
      *>                         ---------------------------------------------------------
           WHEN RT-Resize-After  CALL "SYSTEM" USING TRIM(OS-Resize) END-CALL
      *>                         ---------------------------------------------------------
           WHEN RT-Cygwin-After  DISPLAY TRIM(OS-Resize) AT LINE 0 COLUMN 0 END-DISPLAY
      *>                         ---------------------------------------------------------
           WHEN RT-Cmd-After     CALL "SYSTEM" USING TRIM(OS-Resize) END-CALL
      *>                         ---------------------------------------------------------
           >>IF RESIZE = 6
           WHEN RT-Curses-After  CALL STATIC "resize_term" USING BY VALUE 28, 106 END-CALL
                                 CALL STATIC "refresh"                            END-CALL
           >>END-IF
      *>                         ---------------------------------------------------------
           WHEN RT-Esc-After     DISPLAY TRIM(OS-Resize) AT LINE 0 COLUMN 0 END-DISPLAY
      *>                         ---------------------------------------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** Get screen geometry again                                       **
      *>   *********************************************************************
           ACCEPT CC-Row FROM LINES   END-ACCEPT
           ACCEPT CC-Col FROM COLUMNS END-ACCEPT
           IF CC-Row < 28 OR CC-Col < 106 *> If too few lines and/or columns on screen...
      *>       *****************************************************************
      *>       ** If we didn't/couldn't resize the screen, give up!           **
      *>       *****************************************************************
               MOVE -2 TO Exit-Code
               PERFORM 099-Terminate *> Screen geometry must be set / to 28 lines and 106 columns
      *>       Control will NOT return
           END-IF
      *>   *********************************************************************
      *>   ** Build the banner line                                           **
      *>   *********************************************************************
           MOVE SPACES TO Banner
           STRING
                   " GCic "                     DELIMITED SIZE
                   GCICVER                      DELIMITED SIZE
                   " ("                         DELIMITED SIZE
                   GC-Compile-DateTime          DELIMITED SIZE
                   ") for GnuCOBOL "            DELIMITED SIZE
                   GA-Version                   DELIMITED SPACE
                   " ("                         DELIMITED SIZE
                   GA-Release-Date              DELIMITED SIZE
                   ") Interactive Compilation"  DELIMITED SIZE
               INTO Banner
           END-STRING
      *>   *********************************************************************
      *>   ** Build the copyright line                                        **
      *>   *********************************************************************
           MOVE CONCATENATE(
                            " GCic for ",
                            TRIM(OS-Type(OS-Type-Code)),
                            " Copyright (C) 2009-2022, Gary L. Cutler, GPL",
                            )
             TO Copyright
      *>   *********************************************************************
      *>   ** Process filename (the only command-line argument, unless debug- **
      *>   ** ging features have been enabled)                                **
      *>   *********************************************************************
           DISPLAY 1 UPON ARGUMENT-NUMBER END-DISPLAY
           ACCEPT Source-Filename FROM ARGUMENT-VALUE END-ACCEPT
      *>   *********************************************************************
      *>   ** Split "Source-Filename" into "Prog-Folder" and "Prog-Filename"  **
      *>   *********************************************************************
           IF OTC-Is-Cygwin AND Source-Filename (2:1) = ":"
               MOVE "\" TO OS-Dir-Chr
           END-IF
           MOVE LENGTH(Source-Filename) TO I
           PERFORM UNTIL I = 0 OR SF-Char (I) = OS-Dir-Chr
               SUBTRACT 1 FROM I END-SUBTRACT
           END-PERFORM
           IF I = 0
               MOVE SPACES          TO Prog-Folder
               MOVE Source-Filename TO Prog-Filename
           ELSE
               MOVE "*" TO SF-Char (I)
               UNSTRING Source-Filename DELIMITED BY "*"
                   INTO Prog-Folder
                        Prog-Filename
               END-UNSTRING
               MOVE OS-Dir-Chr TO SF-Char(I)
           END-IF
           IF Prog-Folder = SPACES *> Run from command-line w/o path on filename
               CALL "CBL_GET_CURRENT_DIR"
                   USING BY VALUE     0
                         BY VALUE     256
                         BY REFERENCE Prog-Folder
               END-CALL
           ELSE
               CALL "CBL_CHANGE_DIR"
                   USING TRIM(Prog-Folder)
               END-CALL
           END-IF
           IF OTC-Is-Cygwin AND Source-Filename(2:1) = ":"
               MOVE "/" TO OS-Dir-Chr
           END-IF
      *>   *********************************************************************
      *>   ** Separate extension from Prog-Filename                           **
      *>   *********************************************************************
           MOVE LENGTH(Prog-Filename) TO I
           PERFORM UNTIL I = 0 OR PF-Char (I) = "."
               SUBTRACT 1 FROM I END-SUBTRACT
           END-PERFORM
           IF I = 0
               MOVE Prog-Filename TO Program-Name
           ELSE
               MOVE "*" TO PF-Char (I)
               UNSTRING Prog-Filename DELIMITED BY "*"
                   INTO Program-Name
                        Dummy
               END-UNSTRING
               MOVE "." TO PF-Char (I)
           END-IF
      *>   *********************************************************************
      *>   ** Generate the lock filename and make sure it doesn't exist       **
      *>   *********************************************************************
           >>IF LOCKFILE = 1
           MOVE CONCATENATE(
                            TRIM(Prog-Folder),
                            OS-Dir-Chr,
                            "gcic-lock-",
                            UPPER-CASE(TRIM(Program-Name))
                            )
               TO Lock-Filename
           CALL "CBL_CHECK_FILE_EXIST" USING TRIM(Lock-Filename) Text-256 END-CALL
           IF RETURN-CODE = 0
               MOVE CONCATENATE(
                                TRIM(Program-Name),
                                " is already being compiled")
                   TO Output-Msg-106
               CALL "C$JUSTIFY" USING Output-Msg-106
                                      "CENTER"
               END-CALL
               DISPLAY Output-Msg-106
                   AT LINE 20 COLUMN 1
               END-DISPLAY
               CALL "C$SLEEP" USING 3 END-CALL
               SET FCF-User-Wants-Out TO TRUE
               MOVE 00 TO Exit-Code
               PERFORM 099-Terminate *> No message, just instant halt
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Spawn the lock file monitor process                             **
      *>   *********************************************************************
           EVALUATE TRUE
      *>                        -------------------------------------------------------------------------------------------
           WHEN OTC-Is-Windows  MOVE CONCATENATE("start ""gciclock"" /MIN gciclock ",TRIM(Lock-Filename)," ",PID-Formatted)
                                    TO Cmd
      *>                        -------------------------------------------------------------------------------------------
           WHEN OTC-Is-Cygwin   MOVE CONCATENATE("cygstart --hide gciclock ",TRIM(Lock-Filename)," ",PID-Formatted)
                                    TO Cmd
      *>                        -------------------------------------------------------------------------------------------
           WHEN OTHER           MOVE CONCATENATE("gciclock ",TRIM(Lock-Filename)," ",PID-Formatted," &")
                                    TO Cmd
      *>                        -------------------------------------------------------------------------------------------
           END-EVALUATE
           CALL "SYSTEM" USING TRIM(Cmd) END-CALL
           >>END-IF
      *>   *********************************************************************
      *>   ** Prepare the compilation listing file name                       **
      *>   *********************************************************************
           MOVE CONCATENATE(
                            TRIM(Program-Name),
                            LISTEXT,
                            )
               TO Messages-Filename
           OPEN OUTPUT COBC-Messages-File *> Initialize/Erase the listing
           WRITE COBC-Messages-Rec FROM SPACES END-WRITE
           CLOSE COBC-Messages-File
      *>   *********************************************************************
      *>   ** Determine default COPY Libraries.                               **
      *>   *********************************************************************
           ACCEPT COB-COPY-DIR-Env FROM ENVIRONMENT "COB_COPY_DIR" END-ACCEPT
           MOVE TRIM(Prog-Folder)      TO Prog-Folder-Right
           MOVE TRIM(COB-COPY-DIR-Env) TO GnuCOBOL-COPY-Right
           ACCEPT EF-COPY FROM ENVIRONMENT "COBCPY" END-ACCEPT
      *>   *********************************************************************
      *>   ** Make sure Function-Tbl-Tbl sizing make sense                    **
      *>   *********************************************************************
           IF LENGTH(Function-FILLER) NOT = LENGTH(Function-Redef)
               MOVE LENGTH(Function-Tbl(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(Function-Redef)  / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(Function-FILLER) / I END-COMPUTE
               MOVE 19 TO Exit-Code
               PERFORM 099-Terminate *> Fatal Error: 'Function-Tbl' OCCURS count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Make sure Option-Tbl sizing make sense                          **
      *>   *********************************************************************
           IF LENGTH(Option-FILLER) NOT = LENGTH(Option-Redef)
               MOVE LENGTH(Option-Tbl(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(Option-Redef)  / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(Option-FILLER) / I END-COMPUTE
               MOVE 02 TO Exit-Code
               PERFORM 099-Terminate *> Fatal Error: 'Option-Tbl' OCCURS count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Make sure Button-Tbl sizing make sense                          **
      *>   *********************************************************************
           IF LENGTH(Button-FILLER) NOT = LENGTH(All-Buttons)
               MOVE LENGTH(Button-Tbl(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(All-Buttons)   / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(Button-FILLER) / I END-COMPUTE
               MOVE 03 TO Exit-Code
               PERFORM 099-Terminate *> Fatal Error: 'Buttons' OCCURS count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Make sure Temp-Files-Tbl sizing make sense                      **
      *>   *********************************************************************
           IF LENGTH(Temp-Files-FILLER) NOT = LENGTH(Temp-Files-Tbl)
               MOVE LENGTH(Temp-File(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(Temp-Files-Tbl)    / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(Temp-Files-FILLER) / I END-COMPUTE
               MOVE 04 TO Exit-Code
               PERFORM 099-Terminate *> Fatal Error: 'Temp-Files-Tbl' OCCURS Count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Determine if the "Compiler Output" feature should be forced to  **
      *>   ** be a dynamic library ("A DLL (-m)", on Windows, for example).   **
      *>   *********************************************************************
           PERFORM 020-Is-Prog-A-Subprogram
           PERFORM 025-Scan-PSS
      *>   *********************************************************************
      *>   ** Populate the Option Text Table using the default selections     **
      *>   *********************************************************************
           PERFORM VARYING Function-No FROM 1 BY 1 UNTIL Function-Tbl(Function-No) = LOW-VALUES
               MOVE Function-No                 TO SK-Function
               MOVE FT-Curr-Opt-No(Function-No) TO SK-Opt-No
               PERFORM 010-Set-Button-Caption-And-Color
           END-PERFORM
      *>   *********************************************************************
      *>   ** Build initial line 27 Message                                   **
      *>   *********************************************************************
           MOVE Copyright  TO Output-Msg
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       200-Let-User-Set-Switches SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "200-Let-User-Set-Switches" END-CALL
      *>************************************************************************
      *> Show the user the current switch settings and allow them to be       **
      *> changed.   This is the main point of interaction with the user.      **
      *>************************************************************************
           PERFORM UNTIL EXIT
               IF FSR-Refresh-Needed
                   DISPLAY Switches-Screen END-DISPLAY
                   SET FSR-Refresh-Needed TO FALSE
               END-IF
               MOVE 0 TO Increment-Value
               ACCEPT Switches-Screen WITH UPDATE END-ACCEPT
               MOVE Copyright      TO Output-Msg
DEBUG D        CALL "DBGKWV"
DEBUG D            USING USER-Sw "USER" "COB-CRT-STATUS" COB-CRT-STATUS "Cursor-Coordinates" Cursor-Coordinates
DEBUG D        END-CALL
      *>       *****************************************************************
      *>       ** If we made it this far, the user pressed a key or clicked   **
      *>       ** the mouse.                                                  **
      *>       *****************************************************************
      *>       ** First, determine what the user did (and where they did it)  **
      *>       *****************************************************************
               EVALUATE COB-CRT-STATUS
      *>                                    -------------------------------
               WHEN COB-SCR-LEFT-PRESSED    MOVE +1 TO Increment-Value
                                            PERFORM 015-Identify-Click
      *>                                    -------------------------------
               WHEN COB-SCR-RIGHT-PRESSED   MOVE -1 TO Increment-Value
                                            PERFORM 015-Identify-Click
                                            IF (NOT User-Goofed)
                                            AND (NOT User-Clicked-Function)
                                                SET User-Goofed TO TRUE
                                            END-IF
      *>                                    -------------------------------
               WHEN COB-SCR-LEFT-DBL-CLICK  CALL X"E5" END-CALL
                                            EXIT PERFORM CYCLE
      *>                                    -------------------------------
               WHEN 0000                    SET User-Clicked-OK TO TRUE
      *>                                    -------------------------------
               WHEN COB-SCR-ESC             SET User-Clicked-CANCEL TO TRUE
      *>                                    -------------------------------
               WHEN COB-SCR-PAGE-UP         SET User-Clicked-HELP TO TRUE
      *>                                    -------------------------------
               WHEN COB-SCR-PAGE-DOWN       SET User-Clicked-HELP TO TRUE
      *>                                    -------------------------------
               WHEN OTHER                   SET User-Goofed TO TRUE
      *>                                    -------------------------------
               END-EVALUATE
      *>       *****************************************************************
      *>       ** Now that we know what they did, take the appropriate action **
      *>       *****************************************************************
               EVALUATE TRUE
      *>                                  -------------------------------------------------------------------
               WHEN User-Clicked-Function *> Function-No was set to indicate the function clicked and
                                          *> Increment-Value was set to +1 if the user left-clicked
                                          *> the button and -1 if they right-clicked it
                                          ADD Increment-Value TO FT-Curr-Opt-No(Function-No) END-ADD
                                          EVALUATE TRUE
                                          WHEN FT-Curr-Opt-No(Function-No) > FT-Opt-Qty(Function-No)
                                              MOVE 1 TO FT-Curr-Opt-No(Function-No)
                                          WHEN FT-Curr-Opt-No(Function-No) = 0
                                              MOVE FT-Opt-Qty(Function-No) TO FT-Curr-Opt-No(Function-No)
                                          END-EVALUATE
                                          IF Function-No = 15                         *> If the user clicked F15
                                              IF F15-PrgSpcSwtchs-Opt-No = 2          *> ...And its current option is "Yes"
                                                  PERFORM 025-Scan-PSS                *> ......Then scan for PSS
                                              ELSE                                    *> ...But if it's "No"
                                                  MOVE SPACES TO Cobc-Switch-Table    *> ......Reinitialize switches table
                                                  MOVE 0      TO CST-Sub
                                              END-IF
                                          END-IF
                                          MOVE Function-No                 TO SK-Function
                                          MOVE FT-Curr-Opt-No(Function-No) TO SK-Opt-No
                                          PERFORM 010-Set-Button-Caption-And-Color
      *>                                  -------------------------------------------------------------------
               WHEN User-Clicked-OK       EXIT PERFORM
      *>                                  -------------------------------------------------------------------
               WHEN User-Clicked-CANCEL   SET FCF-User-Wants-Out TO TRUE
                                          PERFORM 099-Terminate *> Control will not return
      *>                                  -------------------------------------------------------------------
               WHEN User-Clicked-HELP     CALL "LOADER" USING Help-File GCInfo-Arg END-CALL
                                          EXIT PERFORM CYCLE
      *>                                  -------------------------------------------------------------------
               WHEN User-Clicked-Field    EXIT PERFORM CYCLE
      *>                                  -------------------------------------------------------------------
               WHEN OTHER                 CALL X"E5" END-CALL
                                          EXIT PERFORM CYCLE
      *>                                  -------------------------------------------------------------------
               END-EVALUATE
           END-PERFORM
      *>   *********************************************************************
      *>   ** If we make it here, the user wants to compile...so...merge the  **
      *>   ** EXECUTION ARGUMENTS into a single item...                       **
      *>   *********************************************************************
           IF EF-ProgramArgs-2 = SPACES
               MOVE EF-ProgramArgs-1 TO EF-ProgramArgs-All
           ELSE
               MOVE CONCATENATE(
                                TRIM(EF-ProgramArgs-1),
                                " ",
                                TRIM(EF-ProgramArgs-2,LEADING)
                                )
                   TO EF-ProgramArgs-All
           END-IF
      *>   *********************************************************************
      *>   ** Dump the input fields (if wanted)                               **
      *>   *********************************************************************
DEBUG D    CALL "DBGDUMP" USING USER-Sw  "USER" "COBCPY COPY Libraries"       EF-Copy            END-CALL
DEBUG D    CALL "DBGDUMP" USING USER-Sw  "USER" "Additional 'cobc' Switches"  EF-Switches        END-CALL
DEBUG D    CALL "DBGDUMP" USING USER-Sw  "USER" "Extra 'cobc' Arguments"      EF-CompilerArgs    END-CALL
DEBUG D    CALL "DBGDUMP" USING USER-Sw  "USER" "Program Execution Arguments" EF-ProgramArgs-All END-CALL
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE"                                                 END-CALL
           .
       300-Run-Compiler SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "300-Run-Compiler" END-CALL
      *>************************************************************************
      *> Run the compiler using the switch settings the user selected.        **
      *>************************************************************************
           MOVE SPACES TO Cmd
                          Cobc-Cmd
           MOVE COPYRIGHT-BACK TO Bottom-Line-Back
           MOVE COPYRIGHT-TEXT TO Bottom-Line-Text
           MOVE " Compiling..." TO Output-Msg
           DISPLAY Switches-Screen END-DISPLAY
           CALL "C$SLEEP" USING 1 END-CALL
      *>   *********************************************************************
      *>   ** In the unlikely event that the user added a LINKAGE SECTION, or **
      *>   ** somewhat more likely event that they changed the PSS, rescan    **
      *>   ** the source                                                      **
      *>   *********************************************************************
           PERFORM 020-Is-Prog-A-Subprogram
      *>   *********************************************************************
      *>   ** If necessary, build a COBCPY environment variable               **
      *>   *********************************************************************
           IF EF-COPY > SPACES
               SET ENVIRONMENT "COBCPY" TO EF-COPY
           END-IF
      *>   *********************************************************************
      *>   ** Build the cobc switches                                         **
      *>   *********************************************************************
           MOVE SPACES TO Cobc-Cmd
                          Cobc-Switches
                          Cobc-Switch-Table
           SET DM-Debugging-Active TO FALSE   *> Assume no "-debug", "-fdebug", or "-fdebuggine-line" switch given
           SET FDT-Delete-Temps    TO TRUE    *> Assume we WILL be deleting all temporary files we create
           MOVE 0 TO CST-Sub                  *> Initialize pointer into Cobc-Switch-Tbl
           IF Listing-Generated-By-Cobc       *> If user wants cobc to produce a portrait listing
           AND F6-Portrait-Listing-Wanted
               MOVE "t" TO Portrait-Opts(2:1) *> ...Change "-T" to "-t"
           ELSE                               *> Otherwise
               MOVE "T" TO Portrait-Opts(2:1) *> ...Reset in case user changed their mind on 2nd (3rd...) attempt
           END-IF
           IF F16-SaveTemps-Opt-No = 2        *> If function #16 calls for saving temporary files
               SET FDT-Delete-Temps TO FALSE  *> ...Make sure GCic doesn't delete them
           END-IF
      *>   *********************************************************************
      *>   ** If user specified "Extra 'cobc' Switches", load them            **
      *>   *********************************************************************
           IF EF-Switches > SPACES
               MOVE EF-Switches TO CST-Switch-Arg
               PERFORM 035-Load-Switches
           END-IF
      *>   *********************************************************************
      *>   ** Finally, load the switches indicated by the function options    **
      *>   *********************************************************************
           PERFORM VARYING Function-No FROM 1 BY 1 UNTIL Function-Tbl(Function-No) = LOW-VALUES
               MOVE Function-No                 TO SK-Function
               MOVE FT-Curr-Opt-No(Function-No) TO SK-Opt-No
               PERFORM 010-Set-Button-Caption-And-Color
               IF Option-Switch(Option-Idx)(1:7) = "-fdebug" OR "-debug "
                   SET DM-Debugging-Active TO TRUE
               END-IF
               IF Option-Switch(Option-Idx)(1:4) = "-std"
                   MOVE Option-Switch(Option-Idx) TO Config-Switch
               END-IF
               IF (Function-No = 7) AND (F6-No-Listing-Wanted OR F6-Exp-Srce-Listing-Wanted)
                   EXIT PERFORM CYCLE
               END-IF
               IF Option-Switch(Option-Idx) NOT = SPACES
                   MOVE Option-Switch(Option-Idx) TO CST-Switch-Arg
                   PERFORM 035-Load-Switches
               END-IF
           END-PERFORM
      *>   *********************************************************************
      *>   ** Sort the switches into DESCENDING sequence of the switch and    **
      *>   ** then eliminate duplicates                                       **
      *>   *********************************************************************
           SORT Cobc-Switch-Tbl
           MOVE 0 TO J
           PERFORM VARYING I FROM 2 BY 1 UNTIL I > MAXSWITCH OR CST-Switch(I) = SPACES
               ADD 1 TO J END-ADD
               IF CST-Switch-Name(J) = CST-Switch-Name(I) *> Duplicate switch?
                   MOVE "Y" TO CST-Dup(I)                 *> ...Yes...mark it as such
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGDUMP" USING USER-Sw "USER" "Final Cobc-Switch-Table" Cobc-Switch-Table END-CALL
      *>   *********************************************************************
      *>   ** Build the full switches list for the command                    **
      *>   *********************************************************************
           MOVE 1 TO J
           STRING TRIM(CST-Switch(1)) DELIMITED SIZE
                  " "                 DELIMITED SIZE
                  INTO Cobc-Switches
                  WITH POINTER J
           END-STRING
           PERFORM VARYING I FROM 2 BY 1 UNTIL I > MAXSWITCH OR CST-Switch(I) = LOW-VALUES
               IF CST-Dup(I) = "Y"
                   EXIT PERFORM CYCLE
               END-IF
               STRING TRIM(CST-Switch(I)) DELIMITED SIZE
                      " "                 DELIMITED SIZE
                      INTO Cobc-Switches
                      WITH POINTER J
               END-STRING
               EVALUATE CST-Switch-Name(I) ALSO CST-Switch-Name(I)(1:12) *> Special processing for certain switches
      *>                                     --------------------------------
               WHEN "-j" ALSO ANY            IF EF-ProgramArgs NOT = SPACES
                                                 STRING " """
                                                         TRIM(EF-ProgramArgs)
                                                         """ "
                                                         DELIMITED SIZE
                                                         INTO Cobc-Switches
                                                         WITH POINTER J
                                                 END-STRING
                                             END-IF
      *>                                     --------------------------------
               WHEN "-save-temps" ALSO ANY   MOVE CONCATENATE(
                                                              TRIM(Prog-Folder),
                                                              OS-Dir-Chr
                                                              )
                                                 TO Temps-Dir
      *>                                     --------------------------------
               WHEN ANY ALSO "-save-temps="  MOVE SPACES TO Token-2
                                             UNSTRING CST-Switch(I)
                                                 DELIMITED BY "-save-temps="
                                                 INTO Token-1 Token-2 Dummy
                                             END-UNSTRING
                                             EVALUATE Token-2(1:1)
      *>                                                 ----------------------------------------
                                             WHEN "'"    STRING Token-2(2:) DELIMITED BY "'"
                                                                OS-Dir-Chr  DELIMITED SIZE
                                                                INTO Temps-Dir
                                                         END-STRING
      *>                                                 ----------------------------------------
                                             WHEN """"   STRING Token-2(2:) DELIMITED BY """"
                                                                OS-Dir-Chr  DELIMITED SIZE
                                                                INTO Temps-Dir
                                                         END-STRING
      *>                                                 ----------------------------------------
                                             WHEN OTHER  STRING Token-2     DELIMITED BY SPACE
                                                                OS-Dir-Chr  DELIMITED SIZE
                                                                INTO Temps-Dir
                                                         END-STRING
      *>                                                 ----------------------------------------
                                             END-EVALUATE
      *>                                     --------------------------------
               END-EVALUATE
           END-PERFORM
      *>   *********************************************************************
      *>   ** Put all the pieces together and build Cobc-Cmd                  **
      *>   *********************************************************************
           MOVE "cobc -v" TO Cobc-Cmd
           MOVE 9         TO I
           STRING TRIM(Cobc-Switches) DELIMITED SIZE
                  " "                 DELIMITED SIZE
                  TRIM(Prog-Filename) DELIMITED SIZE
                  INTO Cobc-Cmd
                  WITH POINTER I
           END-STRING
           IF EF-CompilerArgs > SPACES
               STRING
                      " "
                      TRIM(EF-CompilerArgs)
                      " "
                      DELIMITED SIZE
                      INTO Cobc-Cmd
                      WITH POINTER I
               END-STRING
           END-IF
           STRING " >" TRIM(Messages-Filename)
                  " 2>&1"
                  DELIMITED SIZE
                  INTO Cobc-Cmd
                  WITH POINTER I
           END-STRING
      *>   *********************************************************************
      *>   ** Now execute the "cobc" command                                  **
      *>   *********************************************************************
DEBUG D    CALL "DBGDUMP" USING USER-Sw "USER" "Cobc-Cmd" Cobc-Cmd END-CALL
           CALL "SYSTEM" USING TRIM(Cobc-Cmd) END-CALL
           OPEN EXTEND COBC-Messages-File; MOVE 1 TO Listing-Open
           WRITE COBC-Messages-Rec FROM SPACES END-WRITE
           IF RETURN-CODE = 0
               MOVE COPYRIGHT-BACK TO Bottom-Line-Back
               MOVE COPYRIGHT-TEXT TO Bottom-Line-Text
               SET CS-Compile-Clean TO TRUE
               MOVE " Compilation Was Successful" TO Output-Msg
                                                     COBC-Messages-Rec
               WRITE COBC-Messages-Rec END-WRITE
               CLOSE COBC-Messages-File; MOVE 0 TO Listing-Open
               DISPLAY Switches-Screen END-DISPLAY
               CALL "C$SLEEP" USING 2 END-CALL
           ELSE
               SET CS-Compile-Failed TO TRUE
               MOVE 05 TO Exit-Code
               PERFORM 099-Terminate *> Compilation Failed
               *> Control **** WILL **** return
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       400-Generate-Listing SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "400-Generate-Listing" END-CALL
      *>************************************************************************
      *> Generate a source + xref listing using "LISTER" subroutine.          **
      *>************************************************************************
           IF CS-Compile-Clean AND F6-Listing-Opt-No > 1
               CONTINUE
           ELSE
               EXIT SECTION
           END-IF
           MOVE " Generating listing..." TO Output-Msg
           DISPLAY Switches-Screen END-DISPLAY
           MOVE 0 TO RETURN-CODE
           CALL "C$SLEEP" USING 2 END-CALL
      *>************************************************************************
      *> Create the listing                                                   **
      *>************************************************************************
           MOVE SPACES TO Output-Msg
           IF Listing-Generated-By-GCic
               CALL "LISTER" USING BY CONTENT   Messages-Filename
                                   BY CONTENT   Source-Filename
                                   BY CONTENT   F6-Listing-Opt-No
                                   BY CONTENT   Banner
                                   BY CONTENT   Copyright
                                   BY CONTENT   GCInfo-Arg
                                   BY CONTENT   Temps-Dir
                                   BY REFERENCE Error-Msg-Arg
                                   BY CONTENT   Config-Switch
                                   BY REFERENCE Exit-Code
                                   BY CONTENT   Debugging-Mode
                                   BY CONTENT   F10-SrceFmt-Opt-No
               ON EXCEPTION *> In case LISTER ever becomes a dynamically-loaded routine
                   MOVE 06 TO Exit-Code
                   PERFORM 099-Terminate *> Fatal Error: LISTER module is not available
                   *> Control will not return
               END-CALL
           ELSE
               OPEN EXTEND COBC-Messages-File
               MOVE SPACES TO COBC-Messages-Rec
               WRITE COBC-Messages-Rec AFTER PAGE END-WRITE
               OPEN INPUT COBC-Output-File; MOVE 1 TO COBC-Output-Open
               PERFORM UNTIL EXIT
                   READ COBC-Output-File
                   AT END
                       EXIT PERFORM
                   NOT AT END
                       WRITE COBC-Messages-Rec FROM COBC-Output-Rec END-WRITE
                   END-READ
               END-PERFORM
               MOVE SPACES TO COBC-Messages-Rec
               WRITE COBC-Messages-Rec AFTER PAGE END-WRITE
               CLOSE COBC-Output-File;  MOVE 0 TO COBC-Output-Open
               CLOSE COBC-Messages-File; MOVE 0 TO Listing-Open
           END-IF
           IF Output-Msg = SPACES
               MOVE " Source and Cross-Reference Listing Generated" TO Output-Msg
               DISPLAY Switches-Screen END-DISPLAY
               CALL "C$SLEEP" USING 1 END-CALL
           ELSE *> LISTER should have populated Output-Msg
               SET CS-Compile-Failed TO TRUE
               PERFORM 099-Terminate *> Control will not return
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       500-Submit-Commands SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "400-Generate-Listing" END-CALL
      *>*************************************************************************
      *> Execute the "On Success" commands (If Any)                            **
      *>*************************************************************************
           ACCEPT GCic-Execution-Date FROM DATE YYYYMMDD
           ACCEPT GCic-Execution-Time FROM TIME
           SET ENVIRONMENT "COB_GCIC_TIME" TO GCic-Execution-Date-Time(1:15)
           IF (F17-Success-Ignore) OR (OSC-Sub = 0)
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-IF
           MOVE " Running 'On Success' Commands..." TO Output-Msg
           DISPLAY Switches-Screen END-DISPLAY
           OPEN EXTEND COBC-Messages-File
           MOVE SPACES TO COBC-Messages-Rec
           WRITE COBC-Messages-Rec AFTER PAGE END-WRITE
           CLOSE COBC-Messages-File
DEBUG D    CALL "DBGDUMP" USING USER-Sw "USER" "All 'On Success' Commands" OSC-All-Commands END-CALL
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > OSC-Sub
DEBUG D        CALL "DBGDUMP" USING USER-Sw "USER" "'On Success' Command" OSC-Command(I) END-CALL
               CALL "SYSTEM"  USING TRIM(OSC-Command(I))                                 END-CALL
DEBUG D        MOVE RETURN-CODE TO Return-Code-Display
DEBUG D        CALL "DBGKWV"  USING USER-Sw "USER" "RETURN-CODE" Return-Code-Display     END-CALL
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       END PROGRAM MAIN.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. GCINFO.
      *>****************************************************************
      *> This subroutine identifies the version number and build date **
      *> of the GnuCOBOL software the program is running with.        **
      *>                                                              **
      *> Linkage:                                                     **
      *>                                                              **
      *> CALL "GCINFO" USING BY REFERENCE GCINFO-ARG END-CALL         **
      *>                                                              **
      *> 01  GCInfo-Arg.                                              **
      *>     05 GA-Version                 PIC X(20).                 **
      *>     05 GA-Version-No-X.                                      **
      *>        10 GA-Version-No           PIC 9(8).                  **
      *>     05 GA-Release-No-X.                                      **
      *>        10 GA-Release-No           PIC 9(8).                  **
      *>     05 GA-Update-Major-No-X.                                 **
      *>        10 GA-Update-Major-No      PIC 9(8).                  **
      *>     05 GA-Update-Minor-No-X.                                 **
      *>        10 GA-Update-Minor-No      PIC 9(8).                  **
      *>     05 GA-Release-Date            PIC X(9).                  **
      *>     05 GA-Build-Date              PIC X(9).                  **
      *>     05 GA-Build-Env               PIC X(30).                 **
      *>     05 GA-OS-Type                 PIC 9(1).                  **
      *>        88 GA-OS-Unknown           VALUE 0.                   **
      *>        88 GA-OS-Windows           VALUE 1.                   **
      *>        88 GA-OS-Cygwin            VALUE 2.                   **
      *>        88 GA-OS-SplatNIX          VALUE 3.                   **
      *>        88 GA-OS-MacOS             VALUE 4.                   **
      *>        88 GA-OS-MinGW             VALUE 5.                   **
      *>                                                              **
      *>     CALL "GCINFO"                                            **
      *>         USING BY REFERENCE GCINFO-ARG                        **
      *>     END-CALL                                                 **
      *>                                                              **
      *> This routine parses the output of a "cobc --info" command:   **
      *>                                                              **
      *> cobc (GnuCOBOL) 3.1.2.0                                      **
      *> Copyright (C) 2020 Free Software Foundation, Inc.            **
      *> License GPLv3+: GNU GPL version 3 or later <https://gnu...   **
      *> This is free software; see the source for copying condi...   **
      *> warranty; not even for MERCHANTABILITY or FITNESS FOR A...   **
      *> Written by Keisuke Nishida, Roger While, Ron Norman, Si...   **
      *> Built     Jun 28 2022 10:38:00                               **
      *> Packaged  Dec 23 2020 12:04:58 UTC                           **
      *> C version (MinGW) "6.3.0" or C version (Microsoft) 1600      **
      *>           .                                                  **
      *>           .                                                  **
      *>           .                                                  **
      *> build environment        : i686-pc-mingw32 or...             **
      *>           .                i686-pc-cygwin or...              **
      *>           .                x86_64-pc-linux-gnu or...         **
      *>           .                x86_64-apple-darwin19.6.0         **
      *>           .                                                  **
      *>           .                                                  **
      *>           .                                                  **
      *>                                                              **
      *> If for any reason the desired information cannot be obtained **
      *> the VERSION-TEXT will be returned as SPACES (the contents of **
      *> the remaining fields will be unpredictable).                 **
      *>****************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT Tmp-File             ASSIGN TO "gcic-info.txt" ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD  Tmp-File.
       01  Tmp-Rec                     PIC X(80).
       WORKING-STORAGE SECTION.
       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

DEBUG D01  Pad                         PIC X(33) VALUE SPACES.

       01  Tally-1                     USAGE BINARY-LONG.

       01  Tally-2                     USAGE BINARY-LONG.

       01  Tally-3                     USAGE BINARY-LONG.

       01  Tally-4                     USAGE BINARY-LONG.

       01  Tally-5                     USAGE BINARY-LONG.

       01  Tokens.
           05 Token-1                  PIC X(30).
           05 Token-2                  PIC X(30).
           05 Token-3                  PIC X(30).
           05 Token-4                  PIC X(30).
           05 Token-5                  PIC X(30).

       LINKAGE SECTION.
       01  GCInfo-Arg.                                     *> Arguments to GCINFO subroutine
           05 GA-Version               PIC X(20).          *> i.e. "3.1.2.0"
                                                           *>       | | | |
                                                           *>       | | | +-- Update minor #
                                                           *>       | | +---- Update major #
                                                           *>       | +------ Release #
                                                           *>       +-------- Version #
           05 GA-Version-No-X.
              10 GA-Version-No         PIC 9(8).           *> Numeric Version #
           05 GA-Release-No-X.
              10 GA-Release-No         PIC 9(8).           *> Numeric Release #
           05 GA-Update-Major-No-X.
              10 GA-Update-Major-No    PIC 9(8).           *> Numeric Update Major #
           05 GA-Update-Minor-No-X.
              10 GA-Update-Minor-No    PIC 9(8).           *> Numeric Update Minor #
           05 GA-Release-Date          PIC X(9).           *> GnuCOBOL Release Date (ddMMMyyyy)
           05 GA-Build-Date            PIC X(9).           *> GnuCOBOL Build Date (ddMMMyyyy)
           05 GA-Build-Env             PIC X(30).          *> "x86_64-pc-linux-gnu", "i686-pc-mingw32", ...
           05 GA-OS-Type               PIC 9(1).           *> Deduced from GA-Build-Env
              88 GA-OS-Unknown         VALUE 0.
              88 GA-OS-Windows         VALUE 1.
              88 GA-OS-Cygwin          VALUE 2.
              88 GA-OS-SplatNIX        VALUE 3.
              88 GA-OS-MacOS           VALUE 4.
              88 GA-OS-MinGW           VALUE 5.

       PROCEDURE DIVISION USING GCInfo-Arg                 *> Information to be returned
                                .
      *>************************************************************************
      *>                             PROCESS TREE                             **
      *>************************************************************************
      *>                                                                      **
      *>  GCINFO  000-Main                                                    **
      *>  GCINFO      100-Read-And-Parse-Line                                 **
      *>                                                                      **
      *>************************************************************************
       000-Main SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "GCINFO"   END-CALL
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "000-Main" END-CALL
      *>************************************************************************
      *> Main driver for subprogram                                           **
      *>************************************************************************
           CALL "SYSTEM" USING "cobc --info > gcic-info.txt" END-CALL
           OPEN INPUT Tmp-File
      *>   *********************************************************************
      *>   ** Determine GA-Version                                            **
      *>   *********************************************************************
           PERFORM 100-Read-And-Parse-Line UNTIL Token-1 = "cobc"
           MOVE Token-3 TO GA-Version
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "GA-Version" GA-Version END-CALL
      *>   *********************************************************************
      *>   ** Determine GA-Build-Date                                         **
      *>   *********************************************************************
           PERFORM 100-Read-And-Parse-Line UNTIL Token-1 = "built"
           MOVE Token-3(1:2)             TO GA-Build-Date(1:2)
           MOVE UPPER-CASE(Token-2(1:3)) TO GA-Build-Date(3:3)
           MOVE Token-4(1:4)             TO GA-Build-Date(6:4)
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "GA-Build-Date" GA-Build-Date END-CALL
      *>   *********************************************************************
      *>   ** Determine GA-Release-Date                                       **
      *>   *********************************************************************
           PERFORM 100-Read-And-Parse-Line UNTIL Token-1 = "packaged"
           MOVE Token-3(1:2)             TO GA-Release-Date(1:2)
           MOVE UPPER-CASE(Token-2(1:3)) TO GA-Release-Date(3:3)
           MOVE Token-4(1:4)             TO GA-Release-Date(6:4)
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "GA-Release-Date" GA-Release-Date END-CALL
      *>   *********************************************************************
      *>   ** Break the version into its four parts and validate them         **
      *>   *********************************************************************
           MOVE SPACES TO Tokens
           UNSTRING GA-Version DELIMITED BY "." OR "-" OR SPACE
               INTO Token-1
                    Token-2
                    Token-3
                    Token-4
           END-UNSTRING
      *>   *********************************************************************
      *>   ** Convert the four components of the version to numerics, if      **
      *>   ** possible.  Non-numeric components "dev", for example, will be-  **
      *>   ** come zero.                                                      **
      *>   *********************************************************************
           IF TEST-NUMVAL-F(Token-1) = 0
               MOVE NUMVAL-F(Token-1) TO GA-Version-No
           ELSE
               MOVE Token-1           TO GA-Version-No-X
           END-IF

           IF TEST-NUMVAL-F(Token-2) = 0
               MOVE NUMVAL-F(Token-2) TO GA-Release-No
           ELSE
               MOVE Token-2           TO GA-Release-No-X
           END-IF

           IF TEST-NUMVAL-F(Token-3) = 0
               MOVE NUMVAL-F(Token-3) TO GA-Update-Major-No
           ELSE
               MOVE Token-3           TO GA-Update-Major-No-X
           END-IF

           IF TEST-NUMVAL-F(Token-4) = 0
               MOVE NUMVAL-F(Token-4) TO GA-Update-Minor-No
           ELSE
               MOVE Token-4           TO GA-Update-Minor-No-X
           END-IF
      *>   *********************************************************************
      *>   ** Determine OS-Type-Code                                          **
      *>   *********************************************************************
           SET GA-OS-Unknown TO TRUE
           PERFORM 100-Read-And-Parse-Line UNTIL Token-1 = "c" AND Token-2 = "version"
           MOVE 0 TO Tally-1
                     Tally-2
           INSPECT LOWER-CASE(Tmp-Rec) TALLYING Tally-1 FOR ALL "mingw"     *> May be able to use C info
                                                Tally-2 FOR ALL "microsoft" *> to determine "OS"
           PERFORM 100-Read-And-Parse-Line UNTIL Token-1 = "build"
                                             AND Token-2 = "environment"
           MOVE Token-4 TO GA-Build-Env
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "GA-Build-Env" GA-Build-Env END-CALL
           EVALUATE TRUE
      *>                     -------------------------------------------------------------------------
           WHEN Tally-1 > 0  SET GA-OS-MinGW   TO TRUE
      *>                     -------------------------------------------------------------------------
           WHEN Tally-2 > 0  SET GA-OS-Windows TO TRUE
      *>                     -------------------------------------------------------------------------
           WHEN OTHER        MOVE 0 TO Tally-1
                                       Tally-2
                                       Tally-3
                                       Tally-4
                                       Tally-5
                             INSPECT Tmp-Rec TALLYING Tally-1 FOR ALL "mingw"
                                                      Tally-2 FOR ALL "linux"
                                                      Tally-2 FOR ALL "solaris"
                                                      Tally-3 FOR ALL "cygwin"
                                                      Tally-4 FOR ALL "apple"
                                                      Tally-5 FOR ALL "windows"
                             EVALUATE TRUE
      *>                                       ----------------------------
                             WHEN Tally-1 > 0  SET GA-OS-MinGW    TO TRUE
      *>                                       ----------------------------
                             WHEN Tally-2 > 0  SET GA-OS-SplatNIX TO TRUE
      *>                                       ----------------------------
                             WHEN Tally-3 > 0  SET GA-OS-Cygwin   TO TRUE
      *>                                       ----------------------------
                             WHEN Tally-4 > 0  SET GA-OS-MacOS    TO TRUE
      *>                                       ----------------------------
                             WHEN Tally-5 > 0  SET GA-OS-Windows  TO TRUE
      *>                                       ----------------------------
                             END-EVALUATE
      *>                     -------------------------------------------------------------------------
           END-EVALUATE
DEBUG D    CALL "DBGKWV" USING INFO-Sw "INFO" "GA-OS-Type" GA-OS-Type END-CALL
      *>   *********************************************************************
      *>   ** Clean Up                                                        **
      *>   *********************************************************************
           CLOSE Tmp-File
      *>   *********************************************************************
      *>   ** All Done!                                                       **
      *>   *********************************************************************
DEBUG D    CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
           GOBACK
           .
       100-Read-And-Parse-Line SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "100-Read-And-Parse-Line" END-CALL
      *>************************************************************************
      *> Read a line of "cobc --info" output, convert it to lower case, and   **
      *> extract the first five (5) SPACE-delimited tokens for analysis by    **
      *> 000-Main; an EOF condition means we never found something we were    **
      *> counting on finding.                                                 **
      *>************************************************************************
           MOVE SPACES TO Tokens
           READ Tmp-file
           AT END *> EOF w/o finding what we were looking for
DEBUG D        CALL "DBGTXT" USING INFO-Sw "INFO" "Failure (Hit EOF)" END-CALL
               CLOSE Tmp-File
               MOVE SPACES TO GA-Version *> Signal FAILURE to caller
DEBUG D        CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
               GOBACK
           NOT AT END
               MOVE LOWER-CASE(Tmp-Rec) TO Tmp-Rec
               MOVE SPACES TO Tokens
               UNSTRING Tmp-Rec DELIMITED BY ALL SPACES
                   INTO Token-1
                        Token-2
                        Token-3
                        Token-4
                        Token-5
               END-UNSTRING
DEBUG D        CALL "DBGCOL"
DEBUG D            USING INFO-Sw "INFO" Pad Token-1 Token-2 Token-3 Token-4 Token-5 TRIM(Tmp-Rec)
DEBUG D        END-CALL
           END-READ
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       END PROGRAM GCINFO.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. LISTER.
      *>************************************************************************
      *> This subprogram generates a source and cross-reference listing of a  **
      *> GnuCOBOL program.                                                    **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT COBC-Output-File      ASSIGN TO "gcic-output.txt"  ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Expanded-Src-File     ASSIGN TO Expanded-Src-Fn    ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Formatted-Source-File ASSIGN TO "gcic-source.txt"  ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Listing-File          ASSIGN TO Listing-Fn         ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Sort-Work-File        ASSIGN TO DISK.
           SELECT Symbol-Table-File     ASSIGN TO "gcic-symbols.txt" ORGANIZATION IS LINE SEQUENTIAL.
           SELECT Tmp-File              ASSIGN TO "gcic-list.txt"    ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD  COBC-Output-File.                               *> "-T xxx -ftsymbols" file from cobc
       01  COBC-Output-Rec             PIC X(120).
       01  COR-Source-Listing-Rec.
           05 COR-SL-Seq               PIC 9(6).
           05 COR-SL-Ind               PIC X(1).
           05                          PIC X(1).
           05 COR-SL-Source            PIC X(112).
       01  COR-Symbol-Table-Rec.
           05                          PIC X(6).
           05 COR-ST-Class             PIC X(14).
           05                          PIC X(100).

       FD  Expanded-Src-File.                              *> "cobc" output file containing expanded source
       01  XS-Rec                      PIC X(320).         *> Used to produce xref listing

       FD  Formatted-Source-File.                          *> Formatted source extracted from COBC-Output-File
       01  Formatted-Source-Rec.                           *> Used to produce source listing
           05 FSR-Main-Seq             PIC 9(6).
           05 FSR-COPY-Seq             PIC 9(6).
           05 FSR-Source.
              10 FSR-Chunk             OCCURS 3 TIMES
                                       PIC X(112).

       FD  Listing-File.                                   *> File w/ "cobc" msgs; EXTENDed to get srce/xref
       01  Listing-Rec.                                    *> Wide (Landscape) listing record
           05 LR-Not-Compiled.
              10 LR-Seq-No             PIC Z(5)9.
              10                       PIC X(1).
              10 LR-Line-Main          PIC Z(5)9.
              10 LR-Line-Proc          REDEFINES LR-Line-Main
                                       PIC +(5)9.
              10                       PIC X(1).

           05 LR-Statement             PIC X(128).
       01  Listing-Rec-Xref.                               *> Line #2+ of a landscape xref detail group
           05                          PIC X(6).
           05 LRX-Xref                 PIC X(136).
       01  Listing-Rec-Portrait        PIC X(103).         *> Narrow (Portrait) listing record
       01  Listing-Rec-Portrait-Xref.                      *> Line #2+ of a portrait xref detail group
           05                          PIC X(6).
           05 LRPX-Xref                PIC X(97).

       SD  Sort-Work-File.                                 *> COBOL SORT File; used making xref listing
       01  Sort-Work-Rec.                                  *> Each record represents one entry on xref listing
           05 SWR-Prog-ID              PIC X(30).          *> PROGRAM-ID of program
           05 SWR-Name-UC              PIC X(63).          *> Name of the item being xrefed (UPPERCASE)
           05 SWR-Name                 PIC X(63).          *> Name of the item being xrefed (As Coded In Pgm)
           05 SWR-Line.                                    *> 7-char reference to item
              10 SWR-Line-Num          PIC 9(6).           *> Program line number of xref
              10 SWR-Line-Flag         PIC X(1).           *> Type of xref (reference, defn, update)
           05 SWR-Section              PIC X(4).           *> DATA DIVISION section (Symbol Table only)
           05 SWR-Level                PIC X(2).           *> Level Number (Symbol Table only)
           05 SWR-Class                PIC X(4).           *> Class (Symbol Table only)
           05 SWR-Size                 PIC X(8).           *> Size (Symbol Table only)
           05 SWR-Desc                 PIC X(63).          *> Description (Symbol Table Only)

       FD  Symbol-Table-File.                              *> Symbol table extracted from COBC-Output-File
       01  Symbol-Table-Rec.                               *> Used to produce line 1 of xref groups
           05 STR-Size                 PIC X(5).           *> Size of item (bytes)
           05                          PIC X(1).
           05 STR-Class                PIC X(14).          *> ALPHANUMERIC, NUMERIC, GROUP, CONDITIONAL
           05                          PIC X(1).
           05 STR-Level-No             PIC X(2).           *> COBOL Level Number
           05                          PIC X(3).
           05 STR-Info.
              10 STR-Name              PIC X(30).          *> 1st 30 Characters of Name
              10                       PIC X(1).
              10 STR-Desc              PIC X(63).          *> PICTURE, REDEFINES, USAGE, ...

       FD  Tmp-File.                                       *> Scratch file for "cobc -list-xxxx" output, etc.
       01  Tmp-Rec                     PIC X(80).

       WORKING-STORAGE SECTION.
       78  NDF                         VALUE X"A7".        *> End of File char for parser (Section Sign)

       78  NDI                         VALUE X"D8".        *> End of Image char for parser (Slashed Capital O)

       78  NDS                         VALUE X"95".        *> End of Sentence char for parser (Bullet)

DEBUG D01  20SP      VALUE SPACES      PIC X(20).          *> For padding DBGCOL dumps

DEBUG D01  4SP       VALUE SPACES      PIC X(4).           *> For "Release" dumps

       01  ALL-Verbs.                                      *> All GnuCOBOL verbs
           05 PIC X(32)                VALUE "ACCEPT".
           05 PIC X(32)                VALUE "ADD".
           05 PIC X(32)                VALUE "ALLOCATE".
           05 PIC X(32)                VALUE "ALTER".
           05 PIC X(32)                VALUE "CALL".
           05 PIC X(32)                VALUE "CANCEL".
           05 PIC X(32)                VALUE "CLOSE".
           05 PIC X(32)                VALUE "COMMIT".
           05 PIC X(32)                VALUE "COMPUTE".
           05 PIC X(32)                VALUE "CONTINUE".
           05 PIC X(32)                VALUE "DELETE".
           05 PIC X(32)                VALUE "DISABLE".
           05 PIC X(32)                VALUE "DISPLAY".
           05 PIC X(32)                VALUE "DIVIDE".
           05 PIC X(32)                VALUE "ELSE".
           05 PIC X(32)                VALUE "END".        *> Pseudo-verb to pick up "END PROGRAM"
           05 PIC X(32)                VALUE "ENABLE".
           05 PIC X(32)                VALUE "ENTRY".
           05 PIC X(32)                VALUE "EVALUATE".
           05 PIC X(32)                VALUE "EXHIBIT".
           05 PIC X(32)                VALUE "EXIT".
           05 PIC X(32)                VALUE "FREE".
           05 PIC X(32)                VALUE "GENERATE".
           05 PIC X(32)                VALUE "GET".
           05 PIC X(32)                VALUE "GO".
           05 PIC X(32)                VALUE "GOBACK".
           05 PIC X(32)                VALUE "IF".
           05 PIC X(32)                VALUE "INITIALIZE".
           05 PIC X(32)                VALUE "INITIATE".
           05 PIC X(32)                VALUE "INSPECT".
           05 PIC X(32)                VALUE "JSON".       *> Both GENERATE and PARSE
           05 PIC X(32)                VALUE "MERGE".
           05 PIC X(32)                VALUE "MOVE".
           05 PIC X(32)                VALUE "MULTIPLY".
           05 PIC X(32)                VALUE "OPEN".
           05 PIC X(32)                VALUE "PERFORM".
           05 PIC X(32)                VALUE "READ".
           05 PIC X(32)                VALUE "RECEIVE".
           05 PIC X(32)                VALUE "RELEASE".
           05 PIC X(32)                VALUE "RESET".
           05 PIC X(32)                VALUE "RETURN".
           05 PIC X(32)                VALUE "REWRITE".
           05 PIC X(32)                VALUE "ROLLBACK".
           05 PIC X(32)                VALUE "SEARCH".
           05 PIC X(32)                VALUE "SEND".
           05 PIC X(32)                VALUE "SET".
           05 PIC X(32)                VALUE "SORT".
           05 PIC X(32)                VALUE "START".
           05 PIC X(32)                VALUE "STOP".
           05 PIC X(32)                VALUE "STRING".
           05 PIC X(32)                VALUE "SUBTRACT".
           05 PIC X(32)                VALUE "SUPPRESS".
           05 PIC X(32)                VALUE "TERMINATE".
           05 PIC X(32)                VALUE "TRANSFORM".
           05 PIC X(32)                VALUE "UNLOCK".
           05 PIC X(32)                VALUE "UNSTRING".
           05 PIC X(32)                VALUE "USE".
           05 PIC X(32)                VALUE "WHEN".
           05 PIC X(32)                VALUE "WRITE".
           05 PIC X(32)                VALUE "XML".        *> Only GENERATE
           05 PIC X(32)                VALUE LOW-VALUES.   *> Must be last entry
       01  All-Verbs-Tbl               REDEFINES All-Verbs.
           05 Verb-Name                OCCURS 61 TIMES
                                       PIC X(32).

       01  Buzzwords.                                      *> Reserved words ignored to simplify parsing
           05 PIC X(32)                VALUE "ADDRESS".
           05 PIC X(32)                VALUE "ARE".
           05 PIC X(32)                VALUE "AS".
           05 PIC X(32)                VALUE "AWAY-FROM-ZERO".
           05 PIC X(32)                VALUE "CHARACTERS".
           05 PIC X(32)                VALUE "IN".
           05 PIC X(32)                VALUE "IS".
           05 PIC X(32)                VALUE "KEY".
           05 PIC X(32)                VALUE "MODE".
           05 PIC X(32)                VALUE "NEAREST-AWAY-FROM-ZERO".
           05 PIC X(32)                VALUE "NEAREST-EVEN".
           05 PIC X(32)                VALUE "NEAREST-TOWARD-ZERO".
           05 PIC X(32)                VALUE "NOT".
           05 PIC X(32)                VALUE "OF".
           05 PIC X(32)                VALUE "OPTIONAL".
           05 PIC X(32)                VALUE "PROCEED".
           05 PIC X(32)                VALUE "PROHIBITED".
           05 PIC X(32)                VALUE "ROUNDED".
           05 PIC X(32)                VALUE "SEQUENCE".
           05 PIC X(32)                VALUE "STATUS".
           05 PIC X(32)                VALUE "TOWARD-GREATER".
           05 PIC X(32)                VALUE "TOWARD-LESSER".
           05 PIC X(32)                VALUE "TRUNCATION".
           05 PIC X(32)                VALUE "WITH".
           05 PIC X(32)                VALUE LOW-VALUES.   *> Must be last entry
       01  Buzzwords-Tbl               REDEFINES Buzzwords.
           05 Buzzword                 OCCURS 25 TIMES
                                       PIC X(32).

       01  CDF-Words.
           05 CDF-Word-1               PIC X(16).
           05 CDF-Word-2               PIC X(16).
           05 CDF-Word-3               PIC X(16).
           05 CDF-Word-4               PIC X(16).
           05 CDF-Word-5               PIC X(16).

       01  Chr                         PIC X(1).           *> Character the parser is currently processing
           88 C-Is-Letter              VALUE "a" THRU "z", "A" thru "Z".
           88 C-Is-Digit               VALUE "0" THRU "9".
           88 C-Is-Dash                VALUE "-", "_".

       01  COBC-Switch                 PIC X(20).
           88 CS-Is-List-Reserved      VALUE "-list-reserved".
           88 CS-Is-List-Intrinsics    VALUE "-list-intrinsics".
           88 CS-Is-List-Mnnemonics    VALUE "-list-mnemonics".

       01  Curr-Division               PIC X(1).           *> To keep track of where we are in the source
           88 CD-In-Ident-Div          VALUE "I".
           88 CD-In-Env-Div            VALUE "E".
           88 CD-In-Data-Div           VALUE "D".
           88 CD-In-Proc-Div           VALUE "P".

       01  Curr-FD-Filename            PIC X(63).          *> Keeps parser aware of FD/SD we are working on

       01  Curr-Filename               PIC X(255).         *> Most-recent "#line" filename in expanded source

       01  Curr-Section                PIC X(4).           *> Current DATA DIVISION section

       01  Curr-Token.                                     *> Must match structure of "Prev-Token"
           05 CT-Sub                   PIC 9(3).           *> Char subscript where token occurs
           05 CT-Line                  PIC 9(6).           *> Source line number where token occurs
           05 CT-Type                  PIC X(1).           *> Token type
              88 CT-Is-Buzzword        VALUE "B".          *> Buzzword (reserved word that we totally ignore)
              88 CT-Is-Device          VALUE "D".          *> CONSOLE, STDIN, etc.
              88 CT-Is-NDF             VALUE "Z".          *> end-of-file
              88 CT-Is-NDS             VALUE "S".          *> end-of-statement (period)
              88 CT-Is-Feature         VALUE "F".          *> C01, C02, TOP, ...
              88 CT-Is-LvlNo           VALUE "L".          *> level number (start of data item defn)
              88 CT-Is-Name            VALUE "P".          *> prog/func name (word, hex lit, null-delim lit)
              88 CT-Is-RsvdWd          VALUE "R".          *> general reserved word
              88 CT-Is-Switch          VALUE "W".          *> SWITCH-1, SWITCH-2, ...
              88 CT-Is-UserDefn        VALUE "X".          *> user-defined wd (procedure-name/data-item name)
              88 CT-Is-Verb            VALUE "V".          *> a verb that begins a GnuCOBOL statement
           05 CT-Div-Code              PIC X(1).           *> Division where token occurs
           05 CT-Paren-Level           PIC 9(3).           *> Depth of () nesting
           05 CT-Name                  PIC X(63).          *> Token name (as coded in program)
           05 REDEFINES CT-Name.
              10 PIC 9(2).
                 88 CT-Valid-Level-Num VALUE 01 THRU 49, 66, 77, 78, 88.
              10                       PIC X(61).
           05 CT-Name-UC               PIC X(63).          *> Token name (UPPERCASE)

       01  Curr-Verb                   PIC X(12).          *> Verb of current statement being parse

       01  Dummy-1                     PIC X(1).           *> UNSTRING placeholder

       01  Dummy-2                     PIC X(1).           *> UNSTRING placeholder

       01  Expanded-Src-Fn             PIC X(256).         *> Self-explanatory

       01  COBC-Output-File-Flag       PIC X(1).           *> Are we in the (P)rogram or (S)ymbol-table area?
           88 COBC-OFF-Program         VALUE "P".
           88 COBC-OFF-SymbTbl         VALUE "S".

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  Debugging-Line              PIC X(1).           *> Y/N flag for current-line
           88 DL-Is-Debugging          VALUE "Y",          *> Y: Has " >>D " or "D" in column 7
                                       FALSE "N".

       01  Eject-Flag                  PIC X(1).           *> "Y" = Force eject after next WRITE
           88 EF-END-PROGRAM-Eject     VALUE "Y",
                                       FALSE "N".

       01  Filename                    PIC X(256).         *> Original source filename

       01  Files-And-Statuses.                             *> Relates files in parsed program w/ FILE-STATUS
                                                           *> ...items defined for them
           05 FAST-Sub                 USAGE BINARY-LONG   *> Subscript into table
                                       UNSIGNED
                                       VALUE 0.
           05 FAST-Hold-Name           PIC X(63).          *> Working save area
           05 Files-And-Statuses-Tbl   OCCURS FASTSIZE TIMES.
              10 FAST-Filename         PIC X(63).          *> File-name
              10 FAST-Status           PIC X(63).          *> FILE-STATUS item (if > 1, multiple table entries)

       01  How-Was-Debugging-Set       PIC X(1).           *> Set based on Debugging-Mode on entry
           88 HWDS-By-Switch           VALUE "S".
           88 HWDS-By-SOURCE-COMPUTER  VALUE "C".

       01  I                           PIC 9(4).           *> General-use subscript

       01  J                           PIC 9(4).           *> General-use subscript

       01  Lines-Per-Page-Env          PIC X(256).         *> GCXREF_LINES/GCXREF_LINES_PORT Env var value

       01  Main-Filename               PIC X(255).         *> "#line" filename for main module (xref phase)

       01  Main-Module-Name            PIC X(256).         *> "#line" filename for main module (source phase)

       01  NDS-NDI                     PIC X(2).           *> End-of-sentence+end-of-image sequence

       01  NDS-SPACE VALUE SPACES      PIC X(2).           *> End-of-sentence+space sequence

       01  Nesting-Level               PIC 9(4).           *> Program nesting level; 0001 = top-level program

       01  Number-Flag                 PIC X(1).           *> Used by parser to flag number as integer/nonint
           88 NF-Is-Integer            VALUE "I".
           88 NF-Is-Not-Integer        VALUE "N".

       01  Open-Files.                                     *> Flags set to 1 when corresponding file open
           05 COBC-Output-Open         PIC 9(1).
           05 Expanded-Src-Open        PIC 9(1).
           05 Formatted-Source-Open    PIC 9(1).
           05 Listing-Open             PIC 9(1).
           05 Symbol-Table-Open        PIC 9(1).
           05 Tmp-Open                 PIC 9(1).

       01  Paren-Level                 PIC 9(3).           *> Nested () level tracker

       01  PERIOD-NDI    VALUE ". "    PIC X(2).           *> "." followed by end-of-image sentinal char

       01  Prev-Token.                                     *> Must match structure of "Curr-Token"
           05 PT-Sub                   PIC 9(3).           *> See "Curr-Token" for descriptions
           05 PT-Line                  PIC 9(6).
           05 PT-Type                  PIC X(1).
              88 PT-Is-Buzzword        VALUE "B".
              88 PT-Is-Device          VALUE "D".
              88 PT-Is-NDF             VALUE "Z".
              88 PT-Is-NDS             VALUE "S".
              88 PT-Is-Feature         VALUE "F".
              88 PT-Is-LvlNo           VALUE "L".
              88 PT-Is-Name            VALUE "P".
              88 PT-Is-RsvdWd          VALUE "R".
              88 PT-Is-Switch          VALUE "W".
              88 PT-Is-UpdVerb         VALUE "U".
              88 PT-Is-UserDefn        VALUE "X".
              88 PT-Is-Verb            VALUE "V".
           05 PT-Div-Code              PIC X(1).
           05 PT-Paren-Level           PIC 9(3).
           05 PT-Name                  PIC X(63).
           05 REDEFINES PT-Name.
              10 PIC 9(2).
                 88 PT-Valid-Level-Num VALUE 01 THRU 49, 66, 77, 78, 88.
              10                       PIC X(59).
           05 PT-UC-Name               PIC X(63).

       01  Prog-ID                     PIC X(30).          *> PROGRAM-ID of current program

       01  Rec-No                      USAGE BINARY-CHAR UNSIGNED.

       01  Rec-Parts                   PIC 9(1) COMP.      *> # of parts to a source record (1-3)

       01  Records-And-Files.                              *> Relates files in parsed program with the records
                                                           *> ...defined for them
           05 RAFT-Sub                 USAGE BINARY-LONG   *> Subscript into table
                                       UNSIGNED
                                       VALUE 0.
           05 Records-And-Files-Tbl    OCCURS RAFTSIZE TIMES.
              10 RAFT-Filename         PIC X(63).          *> Filename
              10 RAFT-Recordname       PIC X(63).          *> Record name (Multiple records, multiple entries)

       01  Report-Items.                                   *> All items that appear on the reports
           05 RI-Delim                 PIC X(3).           *> Delimiter between descriptive items on Xref
           05 RI-Display-Page-No       PIC ZZZZZ9.
           05 RI-Display-Prog-ID       PIC X(30).
           05 RI-Formatted-DT          PIC 9999/99/99.
           05 RI-LPP                   USAGE BINARY-LONG.
           05 RI-Lines-Xrefs           USAGE BINARY-LONG.  *> Calculated = LENGTH(RI-Refs) / 136|96
           05 RI-Listing-Ptr           USAGE BINARY-LONG.  *> STRING pointer into Listing-Rec
           05 RI-Listing-Ptr-Save      USAGE BINARY-LONG.  *> Save area for RI-Listing-Ptr
           05 RI-Last-Prog-ID          PIC X(30).          *> The PROGRAM-ID we"ve been working with
           05 RI-Last-Xref-Name        PIC X(63).          *> The user-defined name for report
           05 RI-Last-Xref-Name-UC     PIC X(63).          *> The user-defined name for report (UPPER CASE)
           05 RI-Line-Flags.                               *> Indicators for how many lines of source code
              10 RI-Line-Flag          OCCURS 4 TIMES      *> ...Need to be printed by 020-Generate-Detail-Srce
                                       PIC X(1).
           05 RI-Lines-Left            PIC 9(3).
           05 RI-Not-Referenced        USAGE BINARY-LONG.  *> Column on xref report for "*** NOT REFERENCED ***"
           05 RI-PH-3                  PIC X(142).
           05 RI-PH-3-Source           PIC X(142) VALUE "LineNo Source Statement; LineNo: Statement locn " &
                                                        "in its file; Source: Statement locn in expanded source".
           05 RI-PH-3-Xref-L           PIC X(142) VALUE
              "User-Defined Name; '?'=Defined, '?'=Updated, '?'=Referenced     ".
           05 RI-PH-3-Xref-P           PIC X(103) VALUE
              "User-Defined Name; '?'=Defn, '?'=Upd, '?'=Ref".
           05 RI-PH-4                  PIC X(142).
           05 RI-PH-4-Source           PIC X(142) VALUE
              "====== ====== ============================================================" &
              "====================================================================".
           05 RI-PH-4-Xref-L           PIC X(142) VALUE ALL "=".
           05 RI-PH-4-Xref-P           PIC X(103) VALUE ALL "=".
           05 RI-Page-No               USAGE BINARY-LONG.
           05 RI-Page-No-Text          PIC X(12) JUSTIFIED RIGHT.
           05 RI-Pos-Date              USAGE BINARY-LONG.
           05 RI-Pos-Page-No           USAGE BINARY-LONG.
           05 RI-Pos-ProgID            USAGE BINARY-LONG.
           05 RI-Pos-Title             USAGE BINARY-LONG.
           05 RI-Prog-ID               PIC X(30).
           05 RI-Refs.
              10 RI-Ref-Tbl.                               *> 73440 Bytes (see following analysis)
                 15 RI-Ref             OCCURS 9180 TIMES.  *> 12 (Port/line) x 17 (Land/line) = 204 (div. by both)
                                                           *> 204 x 45 (arbitrary) = 9180 xrefs/data-item
                    20                 PIC X(1).
                    20 RI-Ref-Seq-No   PIC ZZZZZ9.
                    20 RI-Ref-Type     PIC X(1).
              10 RI-Ref-Tbl-L REDEFINES RI-Ref-Tbl.        *> 9180 (xrefs) / 17 (land/line) = 540 lines
                 15 RI-Ref-L           OCCURS 540 TIMES    *> 136 x 550 = 73440 Bytes
                                       PIC X(136).
              10 RI-Ref-Tbl-P REDEFINES RI-Ref-Tbl.        *> 9180 (xrefs) / 12 (land/line) = 765 lines
                 15 RI-Ref-P           OCCURS 765 TIMES
                                       PIC X(96).
           05 RI-Seq-No                USAGE BINARY-LONG.
           05 RI-Source-Image          PIC X(384).
           05 REDEFINES RI-Source-Image.
              10 RI-SI-Long            OCCURS 3 TIMES
                                       PIC X(128).
           05 REDEFINES RI-Source-Image.
              10 RI-SI-Short           OCCURS 4 TIMES
                                       PIC X(89).
              10                       PIC X(28).
           05 RI-Symbol-Table-Class    PIC X(4).           *> ALPH, COND, GRP, NUM
           05 RI-Symbol-Table-Desc     PIC X(52).          *> Data item PIC, USAGE, etc.
           05 RI-Symbol-Table-Level    PIC X(2).           *> Level number
           05 RI-Symbol-Table-Section  PIC X(4).           *> FILE, WORK, LINK, LOCL, REPT, SCRN
           05 RI-Symbol-Table-Size     PIC X(5).           *> Data item size, in bytes
           05 RI-Title                 PIC X(23).
           05 RI-Width                 USAGE BINARY-LONG.
           05 RI-Xref-Item             PIC X(60).
           05 RI-Xref-Name             PIC X(63).
           05 RI-Xref-Name-UC          PIC X(63).
           05 RI-Xref-No               PIC 9(4).

       01  Reserved-Words.
           05 Reserved-Word-Tbl        OCCURS RWTSIZE TIMES
                                       ASCENDING KEY RWT-Word
                                       INDEXED BY RWT-Idx.
              10 RWT-Type-Code         PIC X(1).           *> "B": A buzzword (to be ignored)
                                                           *> "D": A device
                                                           *> "F": A feature
                                                           *> "I": An intrinsic (function)
                                                           *> "M": A device mnemonic
                                                           *> "R": Just a plain 'ol reserved word
                                                           *> "V": A verb
                                                           *> "W": A switch name
              10 RWT-Word              PIC X(32).

       01  Save-490-Idx                USAGE BINARY-LONG   *> For 490-Propagate-Update to save/restore ST-Idx
                                       UNSIGNED.


       01  SELECT-Filename             PIC X(63).          *> The filename from SELECT statement being parsed

       01  Scan-Delim                  PIC X(1).           *> Character that will close string being parsed

      *>************************************************************************
      *> Parsing RECORD KEY, ADD, SUBTRACT, MULTIPLY, and DIVIDE statements,  **
      *> in order to determine which data items are referenced and which are  **
      *> updated (or, in the case of RECORD KEY clauses, INDEXED file split   **
      *> keys) is tricky because the syntax of these five clauses and state-  **
      *> ments can be ambiguous.  Here's an example:                          **
      *>                                                                      **
      *>     ADD AAA BBB CCC TO DDD EEE END-ADD                               **
      *>                    - vs -                                            **
      *>     ADD AAA BBB CCC TO DDD GIVING FFF GGG END-ADD                    **
      *>                                                                      **
      *> In both instances, the data items listed BEFORE the "TO" keyword are **
      *> just referenced - their contents will be summed.  So far, so good.   **
      *>                                                                      **
      *> In the first instance, the sum of AAA, BBB, and CCC will be added to **
      *> DDD and EEE (separately); both DDD and EEE are updated and their     **
      *> entries in the cross-reference listing will have an asterisk append- **
      *> ed to the line number where the statement occurs.                    **
      *>                                                                      **
      *> The second case is a little different.  There can only be a single   **
      *> data item AFTER the "TO" and BEFORE the "GIVING".  That item simply  **
      *> becomes part of the temporary sum AAA + BBB + CCC + DDD (a refer-    **
      *> ence, not an update!); the data items FFF and GGG which occur AFTER  **
      *> the "GIVING" will each receive a copy of the AAA + BBB + CCC + DDD   **
      *> sum - an update deserving of an asterisk in the cross-reference      **
      *> listing.                                                             **
      *>                                                                      **
      *> So, when parsing the 4 arithmetic statements, rather than immediate- **
      *> ly releasing update records to the SORT for each of the data items   **
      *> after the "TO" on an ADD, after the "INTO" on a DIVIDE, after the    **
      *> "BY" on a MULTIPLY, or after the "FROM" on a SUBTRACT, the update    **
      *> records will be pushed onto the following stack.  If a GIVING clause **
      *> appears before LISTER is done parsing the statement, the contents of **
      *> the stack will be popped until the stack is empty.  Each of the pop- **
      *> ped entries will be released to the SORT as a REFERENCE, not an      **
      *> UPDATE.  If, however, LISTER finishes parsing the statement without  **
      *> finding a GIVING, the stack contents will be popped and the records  **
      *> will be released to the SORT as they were pushed - as UPDATES.       **
      *>                                                                      **
      *> Here's a second example:                                             **
      *>                                                                      **
      *>     RECORD KEY IS AAA ALTERNATE RECORD KEY IS BBB                    **
      *>                       - vs -                                         **
      *>     RECORD KEY CCC = DDD EEE ALTERNATE RECORD KEY FFF SOURCE GGG HHH **
      *>                                                                      **
      *> The first example contains nothing but data item references, while   **
      *> the second contains two DEFINITIONS (CCC and FFF) AND four referen-  **
      *> ces (DDD, EEE, GGG and HHH).  Here, we need to push the AAA and CCC  **
      *> entries as DEFINITIONs (again, assuming the troublesome syntax will  **
      *> appear).  Should the =/SOURCE clauses NOT appear by the time the     **
      *> end-of-sentence (period) is encountered, the pushed DEFINITIONs will **
      *> released to the source as REFERENCEs.  If, however, the =/SOURCE     **
      *> clauses DO appear, the pushed entries (CCC and FFF) will be released **
      *> as-is (as the DEFINITIONs they were pushed onto the stack as).  The  **
      *> data-items following the =/SOURCE will be released as REFERENCEs     **
      *> (the default).                                                       **
      *>                                                                      **
      *> Sizing the stack at 500 entries means LISTER can handle that many    **
      *> data-items after the "TO", "INTO", "BY", or ""FROM".                 **
      *>************************************************************************

       01  Search-Line                 PIC 9(6).           *> Line number for propagated updates

       01  Search-Name                 PIC X(30).          *> Uppercase data-item for Symbol Table search key
                                                           *> GnuCOBOL Symbol Table rpt keeps 1st 30 chars

       01  Source-Format-Chg-Flag      PIC X(1).           *> "Y": Current source record changes source format
           88 SFCF-Format-Changed      VALUE "Y",
                                       FALSE "N".

       01  Stack.
           05 Stack-Sub                PIC 9(4).
           05 Stack-Entry              OCCURS STACKSIZE TIMES
                                       PIC X(244).         *> Must be the same size as Sort-Work-Rec

       01  Sym-Parse-Items.                                *> When the Symbol Table recs are parsed, data goes here
           05 SPI-Word-1               PIC X(9).
           05 SPI-Word-2               PIC X(15).
           05 SPI-Word-3               PIC X(30).
           05 SPI-Word-4               PIC X(30).
           05 SPI-Word-5               PIC X(63).

       01  Symbol-Table.
           05 ST-Sub                   PIC 9(4).
           05 ST-Entry                 OCCURS STSIZE TIMES
                                       INDEXED BY ST-Idx.
              10 ST-Prog               PIC X(30).
              10 ST-Level              PIC X(2).
              10 ST-Name               PIC X(30).          *> GnuCOBOL Symbol Table rpt keeps 1st 30 chars
              10 ST-Name-UC            PIC X(30).          *> GnuCOBOL Symbol Table rpt keeps 1st 30 chars

       01  SymTab-Items.                                   *> This is everything we get from the Symbol Table file
           05 SI-Class                 PIC X(4).
           05 SI-Desc                  PIC X(63).
           05 SI-Level                 PIC X(2).
           05 SI-Name                  PIC X(30).
           05 SI-Name-UC               PIC X(30).
           05 SI-Prog-ID               PIC X(30).
           05 SI-Section               PIC X(4).
           05 SI-Size                  PIC X(8).

       01  Tally-1                     USAGE BINARY-LONG   *> For when we need to count stuff
                                       UNSIGNED.

       01  Tally-2                     USAGE BINARY-LONG   *> For when we need to count stuff
                                       UNSIGNED.

       01  Tally-3                     USAGE BINARY-LONG   *> For when we need to count stuff
                                       UNSIGNED.

       01  Temp-10-Chars               PIC X(10).          *> General hold areas for strings
       01  Temp-65-Chars               PIC X(65).
       01  Temp-256-Chars              PIC X(256).
       01  Temp-320-Chars              PIC X(320).

       01  Today-DT                    PIC 9(8).           *> Today's date YYYYMMDD

       01  Token-1                     PIC X(63).          *> 3 General-use parsing token fields

       01  Token-2                     PIC X(12).

       01  Token-3                     PIC X(12).

       01  Which-Program               PIC X(1).           *> Code indicating if recs being read from the...
           88 WP-In-Main-File          VALUE "M".          *> ...expanded source file came from the main...
           88 WP-In-Copybook           VALUE "C".          *> ...source file or from a COPY proc

       01  Word-End-Program.
           05                          PIC X(4)  VALUE "END".
           05                          PIC X(8)  VALUE "PROGRAM".

       01  Word-Func-ID.
           05                          PIC X(11) VALUE "FUNCTION-ID".
           05                          PIC X(2)  VALUE ".".

       01  Word-Pgm-ID.
           05                          PIC X(10) VALUE "PROGRAM-ID".
           05                          PIC X(2)  VALUE ".".

       01  XS                          PIC 9(3).           *> Char ptr into Expanded-Source-Rec

       LINKAGE SECTION.

       01  Banner                      PIC X(104).

       01  Config-Switch               PIC X(30).

       01  Copyright                   PIC X(104).

       01  Debugging-Mode              PIC X(1).           *> Y/N flag for DEBUGGING MODE.
           88 DM-Debugging-Active      VALUE 'Y',
                                       FALSE 'N'.

       01  Error-Msg-Arg.
           05 EMA-AAAA                 PIC 9(4).
           05 EMA-BBBB                 PIC 9(4).
           05 EMA-X1X                  PIC X(1).

       01  Exit-Code                   PIC 9(4).

       01  GCInfo-Arg.                                   *> Arguments to GCINFO subroutine
           05 GA-Version               PIC X(20).          *> i.e. "3.1.2.0"
                                                           *>       | | | |
                                                           *>       | | | +-- Update minor #
                                                           *>       | | +---- Update major #
                                                           *>       | +------ Release #
                                                           *>       +-------- Version #
           05 GA-Version-No-X.
              10 GA-Version-No         PIC 9(8).           *> Numeric Version #
           05 GA-Release-No-X.
              10 GA-Release-No         PIC 9(8).           *> Numeric Release #
           05 GA-Update-Major-No-X.
              10 GA-Update-Major-No    PIC 9(8).           *> Numeric Update Major #
           05 GA-Update-Minor-No-X.
              10 GA-Update-Minor-No    PIC 9(8).           *> Numeric Update Minor #
           05 GA-Release-Date          PIC X(9).           *> GnuCOBOL Release Date (ddMMMyyyy)
           05 GA-Build-Date            PIC X(9).           *> GnuCOBOL Build Date (ddMMMyyyy)
           05 GA-Build-Env             PIC X(30).          *> "x86_64-pc-linux-gnu", "i686-pc-mingw32", ...
           05 GA-OS-Type               PIC 9(1).           *> Deduced from GA-Build-Env
              88 GA-OS-Unknown         VALUE 0.
              88 GA-OS-Windows         VALUE 1.
              88 GA-OS-Cygwin          VALUE 2.
              88 GA-OS-SplatNIX        VALUE 3.
              88 GA-OS-MacOS           VALUE 4.
              88 GA-OS-MinGW           VALUE 5.

       01  Listing-Code                PIC 9(2).
           88 LLC-Want-Landscape       VALUE 2.
           88 LLC-Want-Portrait        VALUE 3.

       01  Listing-Fn                  PIC X(256).

       01  Source-Format               PIC 9(2).
           88 SF-Free                  VALUE 1.
           88 SF-Fixed                 VALUE 2.
           88 SF-Variable              VALUE 3.
           88 SF-COBOL85               VALUE 4.
           88 SF-XOpen                 VALUE 5.
           88 SF-XCard                 VALUE 6.
           88 SF-CRT                   VALUE 7.
           88 SF-Terminal              VALUE 8.
           88 SF-COBOLX                VALUE 9.

       01  Src-Fn                      PIC X(2048).

       01  Temps-Dir                   PIC X(256).

       PROCEDURE DIVISION USING Listing-Fn
                                Src-Fn
                                Listing-Code
                                Banner
                                Copyright
                                GCInfo-Arg
                                Temps-Dir
                                Error-Msg-Arg *> WILL be updated
                                Config-Switch
                                Exit-Code     *> WILL be updated
                                Debugging-Mode
                                Source-Format
                                .
      *>************************************************************************
      *>                             PROCESS TREE                             **
      *>************************************************************************
      *>                                                                      **
      *> LISTER  000-Main                                                     **
      *> LISTER      100-Initialization                                       **
      *> LISTER          099-GOBACK                                           **
      *> LISTER  200-Build-Keyword-Table                                      **
      *> LISTER      205-Load-Reserved-Words                                  **
      *> LISTER          099-GOBACK                                           **
      *> LISTER  300-Produce-Source-Listing                                   **
      *> LISTER      010-Set-Report-Characteristics                           **
      *> LISTER      015-Generate-Blank-Line                                  **
      *> LISTER          025-Generate-Page-Footer                             **
      *> LISTER      020-Generate-Detail-Srce                                 **
      *> LISTER          025-Generate-Page-Footer                             **
      *> LISTER          030-Generate-Page-Header                             **
      *> LISTER      305-Split-COBC-Listing                                   **
      *> LISTER          310-Locate-Prog-ID                                   **
      *> LISTER      315-Check-For-Format-Chg                                 **
      *> LISTER  400-Tokenize-Source                                          **
      *> LISTER      405-Get-Token                                            **
      *> LISTER          099-GOBACK                                           **
      *> LISTER          410-Read                                             **
      *> LISTER          415-Save-Char                                        **
      *> LISTER      420-Parse-IDENTIFICATION-DIVISION                        **
      *> LISTER      425-Parse-ENVIRONMENT-DIVISION                           **
      *> LISTER          450-Release-Definition                               **
      *> LISTER          454-Release-Reference                                **
      *> LISTER          464-Push-Reference                                   **
      *> LISTER              099-GOBACK                                       **
      *> LISTER          468-Pop-Definition                                   **
      *> LISTER          470-Pop-Reference                                    **
      *> LISTER          476-Save-Status                                      **
      *> LISTER              099-GOBACK                                       **
      *> LISTER      430-Parse-DATA-DIVISION                                  **
      *> LISTER          450-Release-Definition                               **
      *> LISTER          454-Release-Reference                                **
      *> LISTER          462-Release-Update                                   **
      *> LISTER          474-Save-Record                                      **
      *> LISTER              099-GOBACK                                       **
      *> LISTER      435-Parse-PROCEDURE-DIVISION                             **
      *> LISTER          450-Release-Definition                               **
      *> LISTER          452-Release-File-Update                              **
      *> LISTER              490-Propagate-Update                             **
      *> LISTER          454-Release-Reference                                **
      *> LISTER          456-Release-Rec-Ref                                  **
      *> LISTER          458-Release-Rec-Update                               **
      *> LISTER              490-Propagate-Update                             **
      *> LISTER          460-Release-Status-Update                            **
      *> LISTER              490-Propagate-Update                             **
      *> LISTER          462-Release-Update                                   **
      *> LISTER              490-Propagate-Update                             **
      *> LISTER          464-Push-Reference                                   **
      *> LISTER              099-GOBACK                                       **
      *> LISTER          466-Push-Update                                      **
      *> LISTER              099-GOBACK                                       **
      *> LISTER          470-Pop-Reference                                    **
      *> LISTER          472-Pop-Update                                       **
      *> LISTER      470-Pop-Reference                                        **
      *> LISTER      472-Pop-Update                                           **
      *> LISTER          490-Propagate-Update                                 **
      *> LISTER      480-Process-Symbol-Table                                 **
      *> LISTER          099-GOBACK                                           **
      *> LISTER  500-Produce-Xref-Listing                                     **
      *> LISTER      010-Set-Report-Characteristics                           **
      *> LISTER      015-Generate-Blank-Line                                  **
      *> LISTER          025-Generate-Page-Footer                             **
      *> LISTER      021-Generate-Detail-Xref                                 **
      *> LISTER          015-Generate-Blank-Line                              **
      *> LISTER          025-Generate-Page-Footer                             **
      *> LISTER          030-Generate-Page-Header                             **
      *> LISTER          035-Start-Xref-Group                                 **
      *> LISTER  099-GOBACK                                                   **
      *>                                                                      **
      *>************************************************************************
       000-Main SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "LISTER"                        END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Listing-Fn    " Listing-Fn     END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Src-Fn        " Src-Fn         END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Listing-Code  " Listing-Code   END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Banner        " Banner         END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Copyright     " Copyright      END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "GCInfo-Arg    " GCInfo-Arg     END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Temps-Dir     " Temps-Dir      END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Error-Msg-Arg " Error-Msg-Arg  END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Config-Switch " Config-Switch  END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Exit-Code     " Exit-Code      END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Debugging-Mode" Debugging-Mode END-CALL
DEBUG D    CALL "DBGKWV"   USING TRACE-SW "TRACE" "Source-Format " Source-Format  END-CALL
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "000-Main"                      END-CALL
      *>************************************************************************
      *> Main Program Driver                                                  **
      *>************************************************************************
           OPEN EXTEND Listing-File; MOVE 1 TO Listing-Open
           PERFORM 100-Initialization
           PERFORM 200-Build-Keyword-Table
           PERFORM 300-Produce-Source-Listing
           SORT Sort-Work-File
               ASCENDING KEY SWR-Prog-ID
                             SWR-Name-UC
                             SWR-Line-Num
               INPUT PROCEDURE  400-Tokenize-Source
               OUTPUT PROCEDURE 500-Produce-Xref-Listing
           PERFORM 099-GOBACK *> Control will not return
           .
       010-Set-Report-Characteristics SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "010-Set-Report-Characteristics" END-CALL
      *>************************************************************************
      *> Set up the various numeric characteristics of the reports that vary  **
      *> depending on the report orientation (landscape vs portrait).         **
      *>************************************************************************
           EVALUATE TRUE
      *>                                     ------------------------------
           WHEN RI-Title = "Source Listing"  MOVE RI-PH-3-Source TO RI-PH-3
                                             MOVE RI-PH-4-Source TO RI-PH-4
      *>                                     ------------------------------
           WHEN LLC-Want-Landscape           MOVE RI-PH-3-Xref-L TO RI-PH-3
                                             MOVE RI-PH-4-Xref-L TO RI-PH-4
      *>                                     ------------------------------
           WHEN OTHER                        MOVE RI-PH-3-Xref-P TO RI-PH-3
                                             MOVE RI-PH-4-Xref-P TO RI-PH-4
      *>                                     ------------------------------
           END-EVALUATE
           IF LLC-Want-Landscape
               MOVE 133            TO RI-Pos-Date
               MOVE 131            TO RI-Pos-Page-No
               MOVE 113            TO RI-Pos-ProgID
               MOVE 70             TO RI-Pos-Title
               MOVE 142            TO RI-Width
           ELSE
               MOVE 94             TO RI-Pos-Date
               MOVE 92             TO RI-Pos-Page-No
               MOVE 74             TO RI-Pos-ProgID
               MOVE 70             TO RI-Pos-Title
               MOVE 103            TO RI-Width
           END-IF
           COMPUTE RI-Lines-Xrefs    = LENGTH(RI-Refs) - (RI-Width - 6) END-COMPUTE
           COMPUTE RI-Not-Referenced = RI-Width - 21 END-COMPUTE
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       015-Generate-Blank-Line SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "015-Generate-Blank-Line" END-CALL
      *>************************************************************************
      *> Generate a blank line on the report to fill up a page.               **
      *>************************************************************************
           IF RI-Lines-Left = 0
DEBUG D        CALL "DBGKWV"  USING TRACE-Sw "TRACE" "RI-Lines-Left" RI-Lines-Left END-CALL
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-IF
           MOVE SPACES TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
           SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
           IF RI-Lines-Left = 0
               PERFORM 025-Generate-Page-Footer
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       020-Generate-Detail-Srce SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "020-Generate-Detail-Srce" END-CALL
      *>************************************************************************
      *> Generates a detail line of the source code listing, also producing   **
      *> page footers and page headers, when necessary.                       **
      *>************************************************************************
      *>   ** First figure out what we need to do                             **
      *>   *********************************************************************
           MOVE ALL 'N' TO RI-Line-Flags
           EVALUATE TRUE ALSO TRUE
      *>                                                             ----------------------------
           WHEN LLC-Want-Landscape ALSO RI-SI-Long(3)  NOT = SPACES  MOVE "LLLN" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN LLC-Want-Landscape ALSO RI-SI-Long(2)  NOT = SPACES  MOVE "LLNN" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN LLC-Want-Landscape ALSO ANY                          MOVE "LNNN" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN ANY                ALSO RI-SI-Short(4) NOT = SPACES  MOVE "SSSS" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN ANY                ALSO RI-SI-Short(3) NOT = SPACES  MOVE "SSSN" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN ANY                ALSO RI-SI-Short(2) NOT = SPACES  MOVE "SSNN" TO RI-Line-Flags
      *>                                                             ----------------------------
           WHEN OTHER                                                MOVE "SNNN" TO RI-Line-Flags
      *>                                                             ----------------------------
           END-EVALUATE
      *>   *********************************************************************
      *>   ** If this is the first line of a new program, force a page eject  **
      *>   ** and reset the Prog-ID                                           **
      *>   *********************************************************************
           IF FSR-Main-Seq = 1
               MOVE SPACES TO Prog-ID
                              RI-Display-Prog-ID
               MOVE 0      TO RI-Lines-Left
           END-IF
      *>   *********************************************************************
      *>   ** If this line is "SOURCE-COMPUTER. xxxx WITH DEBUGGING MODE",    **
      *>   ** set the debugging switch to active                              **
      *>   *********************************************************************
           MOVE 0 TO Tally-1
                     Tally-2
           INSPECT UPPER-CASE(RI-Source-Image)
               TALLYING Tally-1 FOR ALL " SOURCE-COMPUTER."
                        Tally-2 FOR ALL " DEBUGGING "
           IF Tally-1 = 1 AND Tally-2 = 1
               SET DM-Debugging-Active   TO TRUE
               SET HWDS-By-SOURCE-COMPUTER TO TRUE
           END-IF
DEBUG D    CALL "DBGKWV" USING XTOKEN-Sw "XTOKEN" "L-Debugging-Mode" Debugging-Mode
DEBUG D                                           "Debugging-Line"   Debugging-Line
DEBUG D    END-CALL
      *>   *********************************************************************
      *>   ** Produce the 1-4 lines of the source statement                   **
      *>   *********************************************************************
           PERFORM VARYING Rec-No FROM 1 BY 1 UNTIL Rec-No > 4
               IF RI-Line-Flag(Rec-No) NOT = 'N' AND RI-Lines-Left = 0
                   PERFORM 030-Generate-Page-Header
               END-IF
               MOVE SPACES TO Listing-Rec
      *>       *****************************************************************
      *>       ** If this is the first line of the source image, include line **
      *>       ** numbers                                                     **
      *>       *****************************************************************
               IF Rec-No = 1
                   MOVE RI-Seq-No TO LR-Seq-No
                   EVALUATE TRUE
      *>                                 ---------------------------------------
                   WHEN FSR-COPY-Seq > 0 MOVE FSR-COPY-Seq    TO LR-Line-Proc
      *>                                 ---------------------------------------
                   WHEN FSR-Main-Seq > 0 MOVE FSR-Main-Seq    TO LR-Line-Main
      *>                                 ---------------------------------------
                   WHEN OTHER            MOVE ' NOT COMPILED' TO LR-Not-Compiled
      *>                                 ---------------------------------------
                   END-EVALUATE
                   IF (NOT DM-Debugging-Active) AND (DL-Is-Debugging)
                       MOVE ' NOT COMPILED' TO LR-Not-Compiled
                   END-IF
               END-IF
      *>       *****************************************************************
      *>       ** Now print the line                                          **
      *>       *****************************************************************
               EVALUATE RI-Line-Flag(Rec-No)
      *>                --------------------------------------------
               WHEN 'L' MOVE RI-SI-Long(Rec-No) TO LR-Statement
                        WRITE Listing-Rec AFTER 1 END-WRITE
                        MOVE SPACES TO Listing-Rec
                        SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
                        IF RI-Lines-Left = 0
                            PERFORM 025-Generate-Page-Footer
                        END-IF
      *>                --------------------------------------------
               WHEN 'S' MOVE RI-SI-Short(Rec-No) TO LR-Statement
                        WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                        MOVE SPACES TO Listing-Rec
                        SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
                        IF RI-Lines-Left = 0
                            PERFORM 025-Generate-Page-Footer
                        END-IF
      *>                --------------------------------------------
               END-EVALUATE
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       021-Generate-Detail-Xref SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "021-Generate-Detail-Xref" END-CALL
      *>************************************************************************
      *> Generates a detail group of the xref code listing, also producing    **
      *> page footers and page headers, when necessary.                       **
      *>************************************************************************
DEBUG D    CALL "DBGKWV" USING XREF-Sw "XREF" "RI-Xref-No" RI-Xref-No "RI-Lines-Left" RI-Lines-Left END-CALL
           IF RI-Xref-No = 0                     *> If there's nothing to do, do nothing
DEBUG D        CALL "DBGKWV"  USING TRACE-Sw "TRACE" "RI-Xref-No" RI-Xref-No END-CALL
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE"                         END-CALL
               EXIT SECTION
           END-IF
           IF RI-Lines-Left = 0                  *> If at bottom of page, generate a page header
               PERFORM 030-Generate-Page-Header
           END-IF
               PERFORM 035-Start-Xref-Group
           IF LLC-Want-Landscape
               IF RI-Lines-Left = 0 *> If at bottom of page, generate a page header
                   PERFORM 025-Generate-Page-Footer
                   PERFORM 030-Generate-Page-Header
               END-IF
               MOVE SPACES TO RI-Symbol-Table-Section
                              RI-Symbol-Table-Size
                              RI-Symbol-Table-Class
                              RI-Symbol-Table-Level
                              RI-Symbol-Table-Desc
               PERFORM VARYING I FROM 1 BY 1 UNTIL I > RI-Lines-Xrefs OR RI-Ref-L(I) = SPACES
                   MOVE SPACES      TO Listing-Rec-Xref
                   MOVE RI-Ref-L(I) TO LRX-Xref
                   IF RI-Xref-No = 1 AND LRX-Xref(8:1) = DEF
                       MOVE "*** NOT REFERENCED ***" TO Listing-Rec-Xref(RI-Not-Referenced:)
                   END-IF
                   WRITE Listing-Rec-Xref AFTER 1 END-WRITE
                   SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
                   IF RI-Lines-Left = 0 *> If at bottom of page, generate a page header
                       PERFORM 025-Generate-Page-Footer
                       PERFORM 030-Generate-Page-Header
                   END-IF
               END-PERFORM
           ELSE
      *>       *****************************************************************
      *>       ** Generate a PORTRAIT group                                   **
      *>       *****************************************************************
               IF RI-Lines-Left = 0 *> If at bottom of page, generate a page header
                   PERFORM 025-Generate-Page-Footer
                   PERFORM 030-Generate-Page-Header
               END-IF
               MOVE SPACES TO RI-Symbol-Table-Section
                              RI-Symbol-Table-Size
                              RI-Symbol-Table-Class
                              RI-Symbol-Table-Level
                              RI-Symbol-Table-Desc
               PERFORM VARYING I FROM 1 BY 1 UNTIL I > RI-Lines-Xrefs OR RI-Ref-P(I) = SPACES
                   MOVE SPACES      TO Listing-Rec-Portrait-Xref
                   MOVE RI-Ref-P(I) TO LRPX-Xref
                   IF RI-Xref-No = 1 AND LRX-Xref(8:1) = DEF
                       MOVE "*** NOT REFERENCED ***" TO Listing-Rec-Xref(RI-Not-Referenced:)
                   END-IF
                   WRITE Listing-Rec-Portrait-Xref AFTER 1 END-WRITE
                   SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
                   IF RI-Lines-Left = 0 *> If at bottom of page, generate a page header
                       PERFORM 025-Generate-Page-Footer
                       PERFORM 030-Generate-Page-Header
                   END-IF
               END-PERFORM
           END-IF
           PERFORM 015-Generate-Blank-Line
           MOVE SPACES TO RI-Refs
           MOVE 0      TO RI-Xref-No
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       025-Generate-Page-Footer SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "025-Generate-Page-Footer" END-CALL
      *>************************************************************************
      *> Generate the page footer.                                            **
      *>************************************************************************
           MOVE SPACES TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
           MOVE ALL "="         TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
           MOVE Copyright(2:) TO Listing-Rec
           MOVE RI-Page-No-Text TO Listing-Rec(RI-Pos-Page-No:12)
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       030-Generate-Page-Header SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "030-Generate-Page-Header" END-CALL
      *>************************************************************************
      *> Increment the page counter, generate a page header and reset all     **
      *> report items to their "at top of page" values.                       **
      *>************************************************************************
           MOVE X"0C" TO Listing-Rec
           WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
      *>   *********************************************************************
      *>   ** Line 1                                                          **
      *>   *********************************************************************
           ADD  1               TO RI-Page-No END-ADD
           MOVE RI-Page-No      TO RI-Display-Page-No
           MOVE Concatenate("Page: ",TRIM(RI-Display-Page-No))
                                TO RI-Page-No-Text
           MOVE Banner(2:)    TO Listing-Rec
           INSPECT Listing-Rec REPLACING ALL "Interactive Compilation" BY SPACES
           MOVE RI-Title        TO Listing-Rec(RI-Pos-Title:23)
           MOVE RI-Formatted-DT TO Listing-Rec(RI-Pos-Date:10)
           MOVE RI-LPP          TO RI-Lines-Left
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
      *>   *********************************************************************
      *>   ** Line 2                                                          **
      *>   *********************************************************************
           MOVE Src-Fn           TO Listing-Rec
           MOVE RI-Display-Prog-ID TO Listing-Rec(RI-Pos-ProgID:30)
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
      *>   *********************************************************************
      *>   ** Line 3                                                          **
      *>   *********************************************************************
           MOVE RI-PH-3         TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
      *>   *********************************************************************
      *>   ** Line 4                                                          **
      *>   *********************************************************************
           MOVE RI-PH-4         TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
      *>   *********************************************************************
      *>   ** Blank line                                                      **
      *>   *********************************************************************
           MOVE SPACES TO Listing-Rec
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
          .
       035-Start-Xref-Group SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "035-Start-Xref-Group" END-CALL
      *>************************************************************************
      *> Starts the presentation of an xref detail group.                     **
      *>************************************************************************
DEBUG D    CALL "DBGCOL" USING XREF-Sw "XREF" RI-Last-Xref-Name
DEBUG D                                       RI-Symbol-Table-Section
DEBUG D                                       RI-Symbol-Table-Class
DEBUG D                                       RI-Symbol-Table-Level
DEBUG D                                       RI-Symbol-Table-Size
DEBUG D                                       RI-Symbol-Table-Desc
DEBUG D    END-CALL
           MOVE SPACES TO Listing-Rec
           MOVE 1 TO RI-Listing-Ptr
           MOVE "|" TO RI-Delim
      *>   *********************************************************************
      *>   ** Insert name of item being referenced                            **
      *>   *********************************************************************
           STRING TRIM(RI-Last-Xref-Name) DELIMITED SIZE
                  " ..... "               DELIMITED SIZE
                  INTO Listing-Rec
                  WITH POINTER RI-Listing-Ptr
           END-STRING
           MOVE RI-Listing-Ptr TO RI-Listing-Ptr-Save
      *>   *********************************************************************
      *>   ** Insert location where item was defined                          **
      *>   *********************************************************************
           IF RI-Symbol-Table-Section NOT = SPACES
               EVALUATE RI-Symbol-Table-Section
               WHEN "WORK" MOVE "WORKING-STORAGE SECTION"  TO RI-Xref-Item
               WHEN "LINK" MOVE "LINKAGE SECTION"          TO RI-Xref-Item
               WHEN "FILE" MOVE "FILE SECTION"             TO RI-Xref-Item
               WHEN "PD"   MOVE "PROCEDURE DIVISION"       TO RI-Xref-Item
               WHEN "LOCL" MOVE "LOCAL-STORAGE SECTION"    TO RI-Xref-Item
               WHEN "REPT" MOVE "REPORT SECTION"           TO RI-Xref-Item
               WHEN "SCRN" MOVE "SCREEN SECTION"           TO RI-Xref-Item
               WHEN OTHER  MOVE RI-Symbol-Table-Section    TO RI-Xref-Item
               END-EVALUATE
               IF (RI-Listing-Ptr + 2 + LENGTH(TRIM(RI-Xref-Item))) > RI-Width
                   IF LLC-Want-Landscape                                     *> Line is full - write it
                       WRITE Listing-Rec AFTER 1 END-WRITE
                   ELSE
                       WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                   END-IF
                   MOVE SPACES TO Listing-Rec                                *> Re-initialize it
                   MOVE "|" to RI-Delim                                      *> Re-initialize the delimiter
                   MOVE RI-Listing-Ptr-Save TO RI-Listing-Ptr                *> Re-point to col after " ..... "
               END-IF
               STRING RI-Delim           DELIMITED BY "|"
                      TRIM(RI-Xref-Item) DELIMITED SIZE
                      INTO Listing-Rec
                      WITH POINTER RI-Listing-Ptr
               END-STRING
               MOVE ", |" TO RI-Delim
           END-IF
      *>   *********************************************************************
      *>   ** Insert item class                                               **
      *>   *********************************************************************
           IF RI-Symbol-Table-Class NOT = SPACES
               EVALUATE RI-Symbol-Table-Class
               WHEN "ALPH" MOVE "ALPHANUMERIC"        TO RI-Xref-Item
               WHEN "NUM"  MOVE "NUMERIC"             TO RI-Xref-Item
               WHEN "GRP"  MOVE "GROUP"               TO RI-Xref-Item
               WHEN "COND" MOVE "CONDITIONAL"         TO RI-Xref-Item
               WHEN "PROC" MOVE "PROCEDURE"           TO RI-Xref-Item
               WHEN OTHER  MOVE RI-Symbol-Table-Class TO RI-Xref-Item
               END-EVALUATE
               IF (RI-Listing-Ptr + 2 + LENGTH(TRIM(RI-Xref-Item))) > RI-Width
                   IF LLC-Want-Landscape                                     *> Line is full - write it
                       WRITE Listing-Rec AFTER 1 END-WRITE
                   ELSE
                       WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                   END-IF
                   MOVE SPACES TO Listing-Rec                                *> Re-initialize it
                   MOVE "|" to RI-Delim                                      *> Re-initialize the delimiter
                   MOVE RI-Listing-Ptr-Save TO RI-Listing-Ptr                *> Re-point to col after " ..... "
               END-IF
               STRING RI-Delim           DELIMITED BY "|"
                      TRIM(RI-Xref-Item) DELIMITED SIZE
                      INTO Listing-Rec
                      WITH POINTER RI-Listing-Ptr
               END-STRING
               MOVE ", |" TO RI-Delim
           END-IF
      *>   *********************************************************************
      *>   ** Insert level number                                             **
      *>   *********************************************************************
           IF RI-Symbol-Table-Level NOT = SPACES
               MOVE CONCATENATE("Level: ", TRIM(RI-Symbol-Table-Level)) TO RI-Xref-Item
               IF (RI-Listing-Ptr + 2 + LENGTH(TRIM(RI-Xref-Item))) > RI-Width
                   IF LLC-Want-Landscape                                     *> Line is full - write it
                       WRITE Listing-Rec AFTER 1 END-WRITE
                   ELSE
                       WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                   END-IF
                   MOVE SPACES TO Listing-Rec                                *> Re-initialize it
                   MOVE "|" to RI-Delim                                      *> Re-initialize the delimiter
                   MOVE RI-Listing-Ptr-Save TO RI-Listing-Ptr                *> Re-point to col after " ..... "
               END-IF
               STRING RI-Delim           DELIMITED BY "|"
                      TRIM(RI-Xref-Item) DELIMITED SIZE
                      INTO Listing-Rec
                      WITH POINTER RI-Listing-Ptr
               END-STRING
               MOVE ", |" TO RI-Delim
           END-IF
      *>   *********************************************************************
      *>   ** Insert item size                                                **
      *>   *********************************************************************
           IF RI-Symbol-Table-Size NOT = SPACES
               INSPECT RI-Symbol-Table-Size REPLACING LEADING "0" BY SPACE
               IF RI-Symbol-Table-Size = SPACES
                   MOVE "0" TO RI-Symbol-Table-Size
               END-IF
               MOVE CONCATENATE("Bytes: ", TRIM(RI-Symbol-Table-Size)) TO RI-Xref-Item
               IF (RI-Listing-Ptr + 2 + LENGTH(TRIM(RI-Xref-Item))) > RI-Width
                   IF LLC-Want-Landscape                                     *> Line is full - write it
                       WRITE Listing-Rec AFTER 1 END-WRITE
                   ELSE
                       WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                   END-IF
                   MOVE SPACES TO Listing-Rec                                *> Re-initialize it
                   MOVE "|" to RI-Delim                                      *> Re-initialize the delimiter
                   MOVE RI-Listing-Ptr-Save TO RI-Listing-Ptr                *> Re-point to col after " ..... "
               END-IF
               STRING RI-Delim           DELIMITED BY "|"
                      TRIM(RI-Xref-Item) DELIMITED SIZE
                      INTO Listing-Rec
                      WITH POINTER RI-Listing-Ptr
               END-STRING
               MOVE ", |" TO RI-Delim
           END-IF
      *>   *********************************************************************
      *>   ** Insert item description                                         **
      *>   *********************************************************************
           IF RI-Symbol-Table-Desc NOT = SPACES
               MOVE CONCATENATE("Desc: '", TRIM(RI-Symbol-Table-Desc),"'") TO RI-Xref-Item
               IF (RI-Listing-Ptr + 2 + LENGTH(TRIM(RI-Xref-Item))) > RI-Width
                   IF LLC-Want-Landscape                                     *> Line is full - write it
                       WRITE Listing-Rec AFTER 1 END-WRITE
                   ELSE
                       WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
                   END-IF
                   MOVE SPACES TO Listing-Rec                                *> Re-initialize it
                   MOVE "|" to RI-Delim                                      *> Re-initialize the delimiter
                   MOVE RI-Listing-Ptr-Save TO RI-Listing-Ptr                *> Re-point to col after " ..... "
               END-IF
               STRING RI-Delim           DELIMITED BY "|"
                      TRIM(RI-Xref-Item) DELIMITED SIZE
                      INTO Listing-Rec
                      WITH POINTER RI-Listing-Ptr
               END-STRING
               MOVE ", |" TO RI-Delim
           END-IF
           IF LLC-Want-Landscape
               WRITE Listing-Rec AFTER 1 END-WRITE
           ELSE
               WRITE Listing-Rec-Portrait AFTER 1 END-WRITE
           END-IF
           SUBTRACT 1 FROM RI-Lines-Left END-SUBTRACT
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       099-GOBACK SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "099-GOBACK" END-CALL
      *>************************************************************************
      *> Ensure all files are closed and then return to caller (GCic).        **
      *>************************************************************************
           IF Expanded-Src-Open = 1
               CLOSE Expanded-Src-File; MOVE 0 TO Expanded-Src-Open
           END-IF
           IF Listing-Open = 1
               CLOSE Listing-File;      MOVE 0 TO Listing-Open
           END-IF
           IF Symbol-Table-Open = 1
               CLOSE Symbol-Table-File; MOVE 0 TO Symbol-Table-Open
           END-IF
           IF Tmp-Open = 1
               CLOSE Tmp-File;          MOVE 0 TO Tmp-Open
           END-IF
DEBUG D    CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
           GOBACK
           .
       100-Initialization SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "100-Initialization" END-CALL
      *>************************************************************************
      *> Perform all program-wide initialization operations.                  **
      *>************************************************************************
           MOVE DEF TO RI-PH-3-Xref-L(21:1)
                       RI-PH-3-Xref-P(21:1)
           MOVE UPD TO RI-PH-3-Xref-L(34:1)
                       RI-PH-3-Xref-P(31:1)
           MOVE REF TO RI-PH-3-Xref-L(47:1)
                       RI-PH-3-Xref-P(40:1)
           MOVE NDS TO NDS-SPACE(1:1)
                       NDS-NDI(1:1)
           MOVE NDI TO PERIOD-NDI(2:1)
                       NDS-NDI(2:1)
           MOVE 0   TO Nesting-Level
                       Stack-Sub
           MOVE LOW-VALUES TO Records-And-Files
           MOVE LOW-VALUES TO Files-And-Statuses
           MOVE TRIM(Src-Fn,LEADING) TO Src-Fn
           IF DM-Debugging-Active
               SET HWDS-By-Switch TO TRUE
           ELSE
               SET HWDS-By-SOURCE-COMPUTER TO TRUE
           END-IF
      *>   *********************************************************************
      *>   ** Make sure "All-Verbs-Tbl" sizing make sense                     **
      *>   *********************************************************************
           IF LENGTH(ALL-Verbs) NOT = LENGTH(ALL-Verbs-Tbl)
               MOVE LENGTH(Verb-Name(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(ALL-Verbs-Tbl) / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(ALL-Verbs) / I END-COMPUTE
               MOVE 07 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: 'All-Verbs-Tbl' OCCURS count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Make sure "Buzzwords-Tbl" sizing make sense                     **
      *>   *********************************************************************
           IF LENGTH(Buzzwords) NOT = LENGTH(Buzzwords-Tbl)
               MOVE LENGTH(Buzzword(1)) TO I
               COMPUTE EMA-AAAA = LENGTH(Buzzwords-Tbl) / I END-COMPUTE
               COMPUTE EMA-BBBB = LENGTH(Buzzwords) / I END-COMPUTE
               MOVE 08 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: 'Buzzwords-Tbl' OCCURS count is AAAA, should be BBBB
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Locate the last directory delimiter character so that the file- **
      *>   ** name may be extracted                                           **
      *>   *********************************************************************
           PERFORM VARYING I FROM LENGTH(Src-Fn) BY -1 UNTIL Src-Fn(I:1) = "/" OR "\"
               IF I = 1
                   MOVE 0 TO I
                   EXIT PERFORM
               END-IF
           END-PERFORM
           IF I = 0
               MOVE UPPER-CASE(Src-Fn) TO Main-Module-Name *> No dir delim, whole thing is filename
           ELSE
               ADD 1 TO I END-ADD
               MOVE UPPER-CASE(Src-Fn(I:)) TO Main-Module-Name *> Extract filename
           END-IF
      *>   *********************************************************************
      *>   ** Set up page layout parameters based on type of listing request- **
      *>   ** ed (portrait/landscape)                                         **
      *>   *********************************************************************
           IF LLC-Want-Landscape
               ACCEPT Lines-Per-Page-Env FROM ENVIRONMENT "GCXREF_LINES" END-ACCEPT
               IF Lines-Per-Page-Env NOT = SPACES
                   MOVE NUMVAL(Lines-Per-Page-Env) TO RI-LPP
               ELSE
                   MOVE LPP                        TO RI-LPP
               END-IF
           ELSE
               ACCEPT Lines-Per-Page-Env FROM ENVIRONMENT "GCXREF_LINES_PORT" END-ACCEPT
               IF Lines-Per-Page-Env NOT = SPACES
                   MOVE NUMVAL(Lines-Per-Page-Env) TO RI-LPP
               ELSE
                   MOVE LPPP                       TO RI-LPP
               END-IF
           END-IF
      *>   *********************************************************************
      *>   ** Separate the original source filename from the path & extension **
      *>   *********************************************************************
           INSPECT Src-Fn REPLACING ALL "\" BY "/"
           MOVE LENGTH(TRIM(Src-Fn)) TO I
           MOVE 0 TO J
           PERFORM UNTIL Src-Fn(I:1) = "/"
               SUBTRACT 1 FROM I END-SUBTRACT
               ADD      1 TO   J END-ADD
               IF I = 0
                   EXIT PERFORM
               END-IF
           END-PERFORM
           UNSTRING Src-Fn((I + 1):J)
               DELIMITED BY "."
               INTO Filename
                    Dummy-1
           END-UNSTRING
      *>   *********************************************************************
      *>   ** Use the original source filename to build the expanded source   **
      *>   ** filename                                                        **
      *>   *********************************************************************
           IF Temps-Dir = SPACES
               STRING
                      TRIM(Filename)    DELIMITED SIZE
                      ".i"              DELIMITED SIZE
                   INTO Expanded-Src-Fn
               END-STRING
           ELSE
               STRING
                      TRIM(Temps-Dir)   DELIMITED SIZE
                      TRIM(Filename)    DELIMITED SIZE
                      ".i"                       DELIMITED SIZE
                   INTO Expanded-Src-Fn
               END-STRING
           END-IF
      *>   *********************************************************************
      *>   ** Make sure it actually exists.  If not, just return to caller    **
      *>   *********************************************************************
           CALL "CBL_CHECK_FILE_EXIST" USING Expanded-Src-Fn Temp-256-Chars END-CALL
           IF RETURN-CODE NOT = 0 *> Shouldn't happen, but just in case
               MOVE 09 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: LISTER Could Not Open Expanded Source File
               *> Control will not return
           END-IF
      *>   *********************************************************************
      *>   ** Get and format today's date                                     **
      *>   *********************************************************************
           ACCEPT Today-DT FROM DATE YYYYMMDD END-ACCEPT
           MOVE Today-DT TO RI-Formatted-DT
           MOVE SPACES   TO Curr-Verb
           .
       200-Build-Keyword-Table SECTION.
DEBUG D    CALL "DBGTXT" USING TRACE-Sw "TRACE" "200-Build-Keyword-Table" END-CALL
      *>************************************************************************
      *> Use the cobc compiler to revrieve the list of reserved words         **
      *> (-list-reserved), intrinsic functions (-list-intrinsics), and mnemo- **
      *> nics (-list-mnemonics).  Once built and SORTed, mark the verbs in    **
      *> the table as (U)pdate verbs or just plain old (V)erbs.  Finally,     **
      *> mark the (B)uzzwords in the table - these are the reserved words the **
      *> parser will ignore to make the parsing job easier.                   **
      *>************************************************************************
           MOVE LOW-VALUES  TO Reserved-Words
           MOVE 1 TO I
      *>   *************************************************************
      *>   ** Load the Keyword Table from "cobc -list-xxxxxx" output  **
      *>   *************************************************************
           SET CS-Is-List-Reserved   TO TRUE; PERFORM 205-Load-Reserved-Words
           SET CS-Is-List-Intrinsics TO TRUE; PERFORM 205-Load-Reserved-Words
           SET CS-Is-List-Mnnemonics TO TRUE; PERFORM 205-Load-Reserved-Words
           SORT Reserved-Word-Tbl *> Alphabetize for SEARCH ALL
      *>   *************************************************************
      *>   ** Mark the verbs                                          **
      *>   *************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL Verb-Name(I) = LOW-VALUES
               SEARCH ALL Reserved-Word-Tbl
               AT END *> Verb's entry not found in Reserved Word Table
                   CONTINUE *> Write this off as being caused by the config file the user is using
               WHEN RWT-Word(RWT-Idx) = Verb-Name(I)
                   MOVE "V" TO RWT-Type-Code(RWT-Idx)
               END-SEARCH
           END-PERFORM
      *>   *************************************************************
      *>   ** Mark the buzzwords                                      **
      *>   *************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL Buzzword(I) = LOW-VALUES
               SEARCH ALL Reserved-Word-Tbl
               AT END *> Buzzword not found in Reserved Word Table
                   CONTINUE *> Write this off as being caused by the config file the user is using
               WHEN RWT-Word(RWT-Idx) = Buzzword(I)
                   MOVE "B" TO RWT-Type-Code(RWT-Idx)
               END-SEARCH
           END-PERFORM
DEBUG D    IF XWORDS-Sw = 1
DEBUG D        CALL "DBGDUMP" USING XWORDS-Sw "XWORDS" "Reserved Word Table:" Reserved-Words END-CALL
DEBUG D    END-IF
           .
       205-Load-Reserved-Words SECTION.
DEBUG D    CALL "DBGTXT" USING TRACE-Sw "TRACE" "205-Load-Reserved-Words" END-CALL
      *>************************************************************************
      *> This section runs "cobc" to determine a particular class of reserved **
      *> words (passed as COBC-Switch).                                       **
      *>************************************************************************
           CALL "SYSTEM" USING BY CONTENT CONCATENATE(
                                                      "cobc ",
                                                      TRIM(COBC-Switch),
                                                      " "
                                                      TRIM(Config-Switch),
                                                      " > gcic-list.txt"
                                                      )
           END-CALL
           OPEN INPUT Tmp-File
           MOVE 1 TO Tmp-Open
           PERFORM UNTIL EXIT
               READ Tmp-File
      *>       *****************************************************************
      *>       ** Get the next record in the output                           **
      *>       *****************************************************************
               AT END
                   EXIT PERFORM
               NOT AT END
      *>           *************************************************************
      *>           ** We're looking for a record consisting of a new reserved **
      *>           ** word - to do that we reject records starting with spe-  **
      *>           ** cific words or characters                               **
      *>           *************************************************************
                   MOVE SPACES TO CT-Name
                                  Token-2
                                  Token-3
                   UNSTRING Tmp-Rec DELIMITED BY ALL SPACES
                       INTO CT-Name
                            Token-2
                            Token-3
                   END-UNSTRING
                   EVALUATE CT-Name ALSO Tmp-Rec(1:1)
      *>                                      ------------------------------------------------------------
                   WHEN SPACES      ALSO ANY  CONTINUE *> Ignore blank lines
      *>                                      ------------------------------------------------------------
                   WHEN "Reserved"  ALSO ANY  CONTINUE *> Ignore "Reserved Words..." header
      *>                                      ------------------------------------------------------------
                   WHEN "Extra"     ALSO ANY  CONTINUE *> Ignore "Extra (obsolete)..." header
      *>                                      ------------------------------------------------------------
                   WHEN "Internal"  ALSO ANY  CONTINUE *> Ignore "Internal registers..." header
      *>                                      ------------------------------------------------------------
                   WHEN "Intrinsic" ALSO ANY  CONTINUE *> Ignore "Intrinsic Function..." header
      *>                                      ------------------------------------------------------------
                   WHEN "System"    ALSO ANY  CONTINUE *> Ignore "System names" header
      *>                                      ------------------------------------------------------------
                   WHEN ANY         ALSO """" CONTINUE *> Ignore any line starting with apostrophe
      *>                                      ------------------------------------------------------------
                   WHEN OTHER                 *> None of the above?  Must be a new reserved word!
      *>               ********************************************************
      *>               ** Make sure there's room for a new word              **
      *>               ********************************************************
                       IF I > RWTSIZE
                           MOVE 10 TO Exit-Code
                           PERFORM 099-GOBACK *> Fatal Error: 'Reserved-Word-Tbl' is full - Increase RWTSIZE
                           *> Control will not return
                       END-IF
      *>               ********************************************************
      *>               ** There is, so save it and flag it                   **
      *>               ********************************************************
                       MOVE CT-Name TO RWT-Word(I)
                       EVALUATE TRUE
      *>                                                    ----------------------------------
                       WHEN CS-Is-List-Intrinsics           MOVE "I" TO RWT-Type-Code(I)
      *>                                                    ----------------------------------
                       WHEN UPPER-CASE(Token-2) = "DEVICE"  MOVE "D" TO RWT-Type-Code(I)
      *>                                                    ----------------------------------
                       WHEN UPPER-CASE(Token-2) = "FEATURE" MOVE "F" TO RWT-Type-Code(I)
      *>                                                    ----------------------------------
                       WHEN UPPER-CASE(Token-2) = "SWITCH"  MOVE "W" TO RWT-Type-Code(I)
      *>                                                    ----------------------------------
                       WHEN OTHER                           MOVE "R" TO RWT-Type-Code(I)
      *>                                                    ----------------------------------
                       END-EVALUATE
                       ADD 1 TO I END-ADD
                   END-EVALUATE
               END-READ
           END-PERFORM
           CLOSE Tmp-File; MOVE 0 TO Tmp-Open
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       300-Produce-Source-Listing SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "300-Produce-Source-Listing" END-CALL
      *>************************************************************************
      *> Control the process of generating the source listing.                **
      *>************************************************************************
      *>
      *>****************************************************************************************************************
      *> The following is a sample of the landscape (142-character) version of the report                             **
      *>****************************************************************************************************************
      *>                                                                                ...1         1         1
      *>          1         2         3         4         5         6         7         ...2         3         4
      *> 1234567890123456789012345678901234567890123456789012345678901234567890123456789...01234567890123456789012
      *> ------------------------------------------------------------------------------------------------------------
      *> GCic 2.0 (2022/06/11 08:52) - GnuCOBOL 3.2.1 23DEC2020        Source Listing   ...             2022/07/30  ^
      *> C:/Users/Gary/Documents/Programs/GCic/XREFTest.cbl                             ...                         |
      *> LineNo Source Statement; LineNo: Statement locn in its file; Source: Statement ...                         |
      *> ====== ====== =================================================================...======================== |
      *> (blank line)                                                                   ...                         |
      *>      1      1 IDENTIFICATION DIVISION.                                         ...                         |
      *>               xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx overflow line for chars 129-255 xx...xxxxxxxxxxxxxxxx  |
      *>               xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx overflow line for chars 256-320                        |
      *>                       .                                                        ...                      Page
      *> (blank line)                                                                   ...                         |
      *> ===============================================================================...=======================  |
      *> GCic for Windows/MinGW Copyright (C) 2009-2022, Gary L. Cutler, GPL            ...                Page: 1  v
      *> ------------------------------------------------------------------------------------------------------------
      *> 1234567890123456789012345678901234567890123456789012345678901234567890123456789...01234567890123456789012
      *>          1         2         3         4         5         6         7         ...2         3         4
      *>                                                                                ...1         1.        1
      *>
      *>****************************************************************************************************************
      *> The following is a sample of the portrait (103-Char) version of the report
      *>
      *>                                                                                                    1
      *>          1         2         3         4         5         6         7         8         9         0
      *> 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123
      *> ----------------------------------------------------------------------------------------------------------
      *> GCic 2.0 (2022/06/11 08:52) - GnuCOBOL 3.2.1 23DEC2020        Source Listing                 2022/07/30  ^
      *> C:/Users/Gary/Documents/Programs/GCic/XREFTest.cbl                                                       |
      *> LineNo Source Statement; LineNo: Statement locn in its file; Source: Statement locn in expanded source   |
      *> ====== ====== =========================================================================================  |
      *> (blank line)                                                                                             |
      *>      1      1        IDENTIFICATION DIVISION.                                                            |
      *>               xxxxxxxxxxxxxxxxxxxxxxxxxxxx overflow line for chars 90-178 xxxxxxxxxxxxxxxxxxxxxxxxxxxxx  |
      *>               xxxxxxxxxxxxxxxxxxxxxxxxxxxx overflow line for chars 179-267 xxxxxxxxxxxxxxxxxxxxxxxxxxxx  |
      *>               xxxxxxxxxxxxxxxxxxxxxxxxxxxx overflow line for chars 268-320
      *>                       .                                                                                  |
      *>                       .                                                                               Page
      *> (blank line)                                                                                             |
      *> =======================================================================================================  |
      *> GCic for Windows/MinGW Copyright (C) 2009-2022, Gary L. Cutler, GPL                             Page: 1  v
      *> ----------------------------------------------------------------------------------------------------------
      *> 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123
      *>          1         2         3         4         5         6         7         8         9         0
      *>                                                                                                    1
      *>************************************************************************
      *> Control the process of generating the source listing.                **
      *>************************************************************************
           PERFORM 305-Split-COBC-Listing
           OPEN INPUT Formatted-Source-File; MOVE 1 TO Formatted-Source-Open
           MOVE "Source Listing" TO RI-Title
           MOVE 0                TO RI-Seq-No
                                    RI-Lines-Left
           PERFORM 010-Set-Report-Characteristics
           PERFORM UNTIL EXIT
               READ Formatted-Source-File
               AT END
                   PERFORM 015-Generate-Blank-Line UNTIL RI-Lines-Left = 0
                   EXIT PERFORM
               NOT AT END
DEBUG D            CALL "DBGKWV"  USING SOURCE-Sw "SOURCE" "RI-Lines-Left"        RI-Lines-Left        END-CALL
DEBUG D            CALL "DBGDUMP" USING SOURCE-Sw "SOURCE" "Formatted-Source-Rec" Formatted-Source-Rec END-CALL
                   MOVE FSR-Source                         TO RI-Source-Image
                   MOVE 0 TO Tally-1
      *>           *************************************************************
      *>           ** Is this current line of source code a debugging line?   **
      *>           *************************************************************
                   SET DL-Is-Debugging TO FALSE
                   PERFORM 315-Check-For-Format-Chg
                   IF SFCF-Format-Changed
                       CONTINUE                     *> If format JUST changed, no need to look for debug line
                   ELSE
                       EVALUATE TRUE
                       WHEN SF-Free      INSPECT FSR-Source TALLYING Tally-1 FOR ALL " >>D "
                                                                     Tally-1 FOR ALL " >>d "
                                         IF Tally-1 > 0
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-Fixed     IF FSR-Source(7:1) = "D" OR "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-Variable  IF FSR-Source(7:1) = "D" OR "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-COBOL85   IF FSR-Source(7:1) = "D" OR "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-XOpen     IF FSR-Source(1:1) = "D"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-XCard     IF FSR-Source(7:1) = "D" OR "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-CRT       IF FSR-Source(1:1) = "D" or "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-Terminal  IF FSR-Source(1:2) = "\D"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       WHEN SF-COBOLX    IF FSR-Source(1:1) = "D" or "d"
                                             SET DL-Is-Debugging TO TRUE
                                         END-IF
                       END-EVALUATE
                   END-IF
      *>           *************************************************************
      *>           ** Process a carriage-control directive, if that's what    **
      *>           ** the record is                                           **
      *>           *************************************************************
                   MOVE LOWER-CASE(TRIM(FSR-Source(8:65))) TO Temp-65-Chars
                   INSPECT Temp-65-Chars REPLACING ALL "." BY SPACE
                   EVALUATE TRUE
      *>                                                      -------------------------------------------------------
                   WHEN Formatted-Source-Rec(1:6) = "*PROG "  MOVE UPPER-CASE(Formatted-Source-Rec(7:15))
                                                                TO Prog-ID
                                                                   RI-Display-Prog-ID
                                                              CALL "C$JUSTIFY" USING RI-Display-Prog-ID, "R" END-CALL
                                                              ADD 1 TO Nesting-Level END-ADD
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   WHEN Formatted-Source-Rec(1:6) = "*NOPR "  MOVE SPACES TO Prog-ID
                                                                             RI-Display-Prog-ID
                                                              SUBTRACT 1 FROM Nesting-Level END-SUBTRACT
                                                              IF Nesting-Level = 0
                                                                  SET EF-END-PROGRAM-Eject TO TRUE
                                                              END-IF
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   WHEN RI-Source-Image(7:1) = "/"            PERFORM 015-Generate-Blank-Line UNTIL RI-Lines-Left = 0
      *>                                                      -------------------------------------------------------
                   WHEN Temp-65-Chars = "eject"               PERFORM 015-Generate-Blank-Line UNTIL RI-Lines-Left = 0
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   WHEN Temp-65-Chars = "skip1"               PERFORM 015-Generate-Blank-Line
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   WHEN Temp-65-Chars = "skip2"               PERFORM 015-Generate-Blank-Line 2 TIMES
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   WHEN Temp-65-Chars = "skip3"               PERFORM 015-Generate-Blank-Line 3 TIMES
                                                              EXIT PERFORM CYCLE
      *>                                                      -------------------------------------------------------
                   END-EVALUATE
      *>           *************************************************************
      *>           ** Finally, go ahead and print the source line             **
      *>           *************************************************************
                   ADD 1 TO RI-Seq-No END-ADD
                   PERFORM 020-Generate-Detail-Srce
                   IF EF-END-PROGRAM-Eject
                       MOVE 0 TO RI-Lines-Left
                       SET EF-END-PROGRAM-Eject TO FALSE
                   END-IF
               END-READ
           END-PERFORM
           CLOSE Formatted-Source-File; MOVE 0 TO Formatted-Source-Open
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .

       305-Split-COBC-Listing SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "305-Split-COBC-Listing" END-CALL
      *>************************************************************************
      *> Splits the listing file generated by the cobc compiler into a for-   **
      *> matted source file (that will be used to generate the source list-   **
      *> ing) and a symbol table file (that will be used to produce the xref  **
      *> listing).  These files will be deleted when they've been used, un-   **
      *> less the user specifies "-save-temps" as an extra cobc option.       **
      *>************************************************************************
           OPEN INPUT  COBC-Output-File;      MOVE 1 TO COBC-Output-Open
           OPEN OUTPUT Formatted-Source-File; MOVE 1 TO Formatted-Source-Open
           OPEN OUTPUT Symbol-Table-File;     MOVE 1 TO Symbol-Table-Open
           MOVE 0 TO Rec-Parts
           MOVE SPACES TO Formatted-Source-Rec
                          Prog-ID
           SET COBC-OFF-Program TO TRUE *> Start off in "Program" mode
           PERFORM UNTIL EXIT
               READ COBC-Output-File
               AT END
                   IF Formatted-Source-Rec > SPACES           *> If a record is in the buffer
                       WRITE Formatted-Source-Rec END-WRITE   *> ...Write it out
                   END-IF
                   EXIT PERFORM
               NOT AT END
DEBUG D            CALL "DBGDUMP" USING SPLIT-Sw "SPLIT" "COBC Output Rec" COBC-Output-Rec END-CALL
                   EVALUATE TRUE ALSO TRUE ALSO TRUE
                   WHEN COBC-OFF-Program ALSO COR-SL-Seq IS NUMERIC ALSO COR-SL-Ind = " "
      *>               *********************************************************
      *>               ** In a program listing looking at a non-continuation  **
      *>               ** line of source code that DID NOT come from a COPY   **
      *>               ** PROC                                                **
      *>               *********************************************************
                       IF Formatted-Source-Rec > SPACES           *> If a record is in the buffer
                           WRITE Formatted-Source-Rec END-WRITE   *> ...Write it out
                           MOVE SPACES TO Formatted-Source-Rec    *> ...Clear the buffer
                           MOVE 0      TO Rec-Parts
                       END-IF
                       MOVE COR-SL-Seq    TO FSR-Main-Seq         *> Set the two sequence numbers
                       MOVE 0             TO FSR-COPY-Seq
                       ADD  1             TO Rec-Parts END-ADD    *> And populate chunk #1 of the buffer
                       MOVE COR-SL-Source TO FSR-Chunk(1)
      *>               *********************************************************
      *>               ** New program?                                        **
      *>               *********************************************************
                       PERFORM 310-Locate-Prog-ID
                   WHEN COBC-OFF-Program ALSO COR-SL-Seq IS NUMERIC ALSO COR-SL-Ind = "C"
      *>               *********************************************************
      *>               ** In a program listing looking at a non-continuation  **
      *>               ** line of source code that DID come from a COPY PROC  **
      *>               *********************************************************
                       IF Formatted-Source-Rec > SPACES           *> If a record is in the buffer
                           WRITE Formatted-Source-Rec END-WRITE   *> ...Write it out
                           MOVE SPACES TO Formatted-Source-Rec    *> ...Clear the buffer
                           MOVE 0      TO Rec-Parts
                       END-IF
                       MOVE 0             TO FSR-Main-Seq         *> Set the two sequence numbers
                       MOVE COR-SL-Seq    TO FSR-COPY-Seq
                       ADD  1             TO Rec-Parts END-ADD    *> And populate chunk #1 of the buffer
                       MOVE COR-SL-Source TO FSR-Chunk(1)
      *>               *********************************************************
      *>               ** New program?                                        **
      *>               *********************************************************
                       PERFORM 310-Locate-Prog-ID
                   WHEN COBC-OFF-Program ALSO COR-SL-Seq IS NUMERIC ALSO COR-SL-Ind = "X"
      *>               *********************************************************
      *>               ** In a program listing looking at a non-continuation  **
      *>               ** line of source code that was excluded from compila- **
      *>               ** tion                                                **
      *>               *********************************************************
                       IF Formatted-Source-Rec > SPACES           *> If a record is in the buffer
                           WRITE Formatted-Source-Rec END-WRITE   *> ...Write it out
                           MOVE SPACES    TO Formatted-Source-Rec *> ...Clear the buffer
                           MOVE 0         TO Rec-Parts
                       END-IF
                       MOVE 0             TO FSR-Main-Seq         *> Clear the two sequence numbers
                       MOVE 0             TO FSR-COPY-Seq         *> (will show as "NOT COMPILED")
                       ADD  1             TO Rec-Parts END-ADD    *> And populate chunk #1 of the buffer
                       MOVE COR-SL-Source TO FSR-Chunk(1)
      *>               *********************************************************
      *>               ** If it was excluded from compilation we won't look   **
      *>               ** for PROGRAM-ID or FUNCTION-ID                       **
      *>               *********************************************************
                   WHEN COBC-OFF-Program ALSO COR-SL-Seq IS NUMERIC ALSO COR-SL-Ind = "+"
      *>               *********************************************************
      *>               ** In a program listing looking at a continuation line **
      *>               ** of source code that must be added to the buffer     **
      *>               *********************************************************
                       ADD 1 TO Rec-Parts END-ADD
                       MOVE COR-SL-Source TO FSR-Chunk(Rec-Parts)
                       EXIT PERFORM CYCLE
                   WHEN COBC-OFF-Program ALSO COR-Source-Listing-Rec(1:30) = "SIZE  TYPE           LVL  NAME" ALSO ANY
      *>               *********************************************************
      *>               ** In a program listing when we notice a header for    **
      *>               ** the symbol table report                             **
      *>               *********************************************************
                       IF Formatted-Source-Rec > SPACES           *> If a record is in the buffer
                           WRITE Formatted-Source-Rec END-WRITE   *> ...Write it out
                           MOVE SPACES    TO Formatted-Source-Rec *> ...Clear the buffer
                           MOVE 0         TO Rec-Parts
                       END-IF
                       IF Prog-ID NOT = SPACES
                           MOVE "      PROGRAM             ?" TO Symbol-Table-Rec
                           MOVE Prog-ID                       TO Symbol-Table-Rec(27:)
                           WRITE Symbol-Table-Rec END-WRITE
                       END-IF
                       SET COBC-OFF-SymbTbl TO TRUE *> Switch to "Symbol Table" mode
                       EXIT PERFORM CYCLE
                   WHEN COBC-OFF-SymbTbl ALSO COR-Source-Listing-Rec(1:20) = "LINE    PG/LN  A...B" ALSO ANY
      *>               *********************************************************
      *>               ** In a symbol table listing when we notice a header   **
      *>               ** for the program listing report                      **
      *>               *********************************************************
                       SET COBC-OFF-Program TO TRUE
                       MOVE SPACES TO Prog-ID
      *>           *************************************************************
      *>           ** The rest of these are each handling one specific type   **
      *>           ** of symbol table record, which simply gets copied to the **
      *>           ** Symbol Table File from the COBC Output File             **
      *>           *************************************************************
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "WORKING-STORAG" ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "LOCAL-STORAGE " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "LINKAGE SECTIO" ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "REPORT SECTION" ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "SCREEN SECTION" ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "FILE          " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "ALPHANUMERIC  " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "GROUP         " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "NUMERIC       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "CONDITIONAL   " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN COBC-OFF-SymbTbl ALSO COR-ST-Class = "PROGRAM       " ALSO ANY
                       WRITE Symbol-Table-Rec FROM COBC-Output-Rec END-WRITE
                   WHEN OTHER
                       EXIT PERFORM CYCLE
                   END-EVALUATE
               END-READ
           END-PERFORM
           CLOSE COBC-Output-File;      MOVE 0 TO COBC-Output-Open
           CLOSE Formatted-Source-File; MOVE 0 TO Formatted-Source-Open
           CLOSE Symbol-Table-File;     MOVE 0 TO Symbol-Table-Open
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       310-Locate-Prog-ID SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "310-Locate-Prog-ID" END-CALL
      *>************************************************************************
      *> While the COBC-Output-File is being split into the Formatted-Source- **
      *> File and the Symbol-Table-File, we need to drop periodic "*PROG"     **
      *> records into the source file and "PROGRAM" records into the Symbol   **
      *> Table file.  To do this, we need to find the PROGRAM-ID or FUNCTION- **
      *> ID of the program whose cobc-generated listing is currently being    **
      *> processed.  This routine will be invoked after every source code     **
      *> record is handled WHILE IN program mode (see the COBC-OFF-Program    **
      *> and COBC-OFF-SymbTbl condition names).                               **
      *>************************************************************************
           MOVE 0 TO Tally-1
                     Tally-2
                     Tally-3
           MOVE SPACES TO Token-1
                          Token-2
           INSPECT UPPER-CASE(COBC-Output-Rec) TALLYING Tally-1 FOR ALL Word-Pgm-ID
                                                        Tally-2 FOR ALL Word-Func-ID
                                                        Tally-3 FOR ALL Word-End-Program
           EVALUATE TRUE
           WHEN Tally-1 > 0
               INSPECT COBC-Output-Rec REPLACING CHARACTERS BY SPACES BEFORE INITIAL Word-Pgm-ID
               UNSTRING COBC-Output-Rec DELIMITED BY ALL SPACES
                   INTO Token-1 Token-2 Prog-ID Token-3
               END-UNSTRING
               INSPECT Prog-ID REPLACING ALL "." BY " "
               MOVE UPPER-CASE(Prog-ID) TO Prog-ID
               MOVE Formatted-Source-Rec TO Temp-256-Chars *> Save any record we've been building
               MOVE "*PROG " TO Formatted-Source-Rec
               MOVE Prog-ID  TO Formatted-Source-Rec(7:)
               WRITE Formatted-Source-Rec END-WRITE
               MOVE Temp-256-Chars TO Formatted-Source-Rec *> Restore any record we've been building
           WHEN Tally-2 > 0
               INSPECT COBC-Output-Rec REPLACING CHARACTERS BY SPACES BEFORE INITIAL Word-Func-ID
               UNSTRING COBC-Output-Rec DELIMITED BY ALL SPACES
                   INTO Token-1 Token-2 Prog-ID Token-3
               END-UNSTRING
               INSPECT Prog-ID REPLACING ALL "." BY " "
               MOVE UPPER-CASE(Prog-ID) TO Prog-ID
               MOVE Formatted-Source-Rec TO Temp-256-Chars *> Save any record we've been building
               MOVE "*PROG " TO Formatted-Source-Rec
               MOVE Prog-ID  TO Formatted-Source-Rec(7:)
               WRITE Formatted-Source-Rec END-WRITE
               MOVE Temp-256-Chars TO Formatted-Source-Rec *> Restore any record we've been building
           WHEN Tally-3 > 0
               MOVE Formatted-Source-Rec TO Temp-256-Chars *> Save any record we've been building
               MOVE SPACES TO Prog-ID
               MOVE "*NOPR " TO Formatted-Source-Rec
               WRITE Formatted-Source-Rec END-WRITE
               MOVE Temp-256-Chars TO Formatted-Source-Rec *> Restore any record we've been building
           END-EVALUATE
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       315-Check-For-Format-Chg SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "315-Check-For-Format-Chg" END-CALL
      *>************************************************************************
      *> If the current record is ">>SET SOURCEFORMAT..." or ">>SOURCE", pro- **
      *> cess it and set "Source-Format" accordingly.                         **
      *>************************************************************************
           SET SFCF-Format-Changed TO FALSE
           MOVE SPACES TO CDF-Words
           MOVE 0 TO I
           MOVE UPPER-CASE(FSR-Source) TO Temp-320-Chars
           INSPECT Temp-320-Chars TALLYING I FOR CHARACTERS BEFORE INITIAL ">>S"
           IF I NOT < LENGTH OF Temp-320-Chars
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-IF
           UNSTRING FSR-Source DELIMITED BY ALL SPACES
               INTO CDF-Word-1 CDF-Word-2 CDF-Word-3 CDF-Word-4 CDF-Word-5
               WITH POINTER I
           END-UNSTRING
           EVALUATE CDF-Word-1 ALSO CDF-Word-2 ALSO CDF-Word-3
      *>                                                  ----------------------------------------------
           WHEN ">>SET"    ALSO "SOURCEFORMAT" ALSO "AS"  MOVE CDF-Word-4 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN ">>SET"    ALSO "SOURCEFORMAT" ALSO ANY   MOVE CDF-Word-3 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN ">>SOURCE" ALSO "FORMAT"       ALSO "IS"  MOVE CDF-Word-4 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN ">>SOURCE" ALSO "FORMAT"       ALSO ANY   MOVE CDF-Word-3 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN ">>SOURCE" ALSO "IS"           ALSO ANY   MOVE CDF-Word-3 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN ">>SOURCE" ALSO ANY            ALSO ANY   MOVE CDF-Word-2 TO Temp-10-Chars
      *>                                                  ----------------------------------------------
           WHEN OTHER
DEBUG D                                                   CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                                                          EXIT SECTION
      *>                                                  ----------------------------------------------
           END-EVALUATE
           EVALUATE Temp-10-Chars
      *>                    ----------------------------------------------
           WHEN "FREE"      MOVE 1 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "FIXED"     MOVE 2 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "VARIABLE"  MOVE 3 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "COBOL85"   MOVE 4 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "XOPEN"     MOVE 5 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "XCARD"     MOVE 6 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "CRT"       MOVE 7 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "TERMINAL"  MOVE 8 TO Source-Format
      *>                    ----------------------------------------------
           WHEN "COBOLX"    MOVE 9 TO Source-Format
      *>                    ----------------------------------------------
           WHEN OTHER
DEBUG D                     CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                            EXIT SECTION
      *>                    ----------------------------------------------
           END-EVALUATE
           SET SFCF-Format-Changed TO TRUE
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       400-Tokenize-Source SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "400-Tokenize-Source" END-CALL
      *>************************************************************************
      *> Processes the entire "F-Expanded-Src-File", releasing records to the **
      *> SORT that indicate each user-defined name (data-items and procedure- **
      *> names) in the compiled file and where those names are defined, re-   **
      *> ferenced, and updated (as best as can be determined).                **
      *>************************************************************************
           MOVE UPPER-CASE(Filename) TO Prog-ID *> In case there's only one program in the file
           PERFORM 480-Process-Symbol-Table
      *>   *********************************************************************
      *>   ** Prepare to start parsing the expanded source (xxxxxx.i) file    **
      *>   *********************************************************************
           MOVE 0      TO RI-Seq-No
           OPEN INPUT Expanded-Src-File; MOVE 1 TO Expanded-Src-Open
           MOVE SPACES TO XS-Rec
                          Main-Filename
           MOVE 255    TO XS
           MOVE NDI    TO XS-Rec(256:1)
           MOVE 0      TO Paren-Level
           SET CD-In-Ident-Div TO TRUE
      *>   *********************************************************************
      *>   ** Begin parsing and continue until an EOF (NDF) is reached        **
      *>   *********************************************************************
           PERFORM UNTIL CT-Is-NDF
               PERFORM 405-Get-Token
DEBUG D        CALL "DBGCOL"
DEBUG D            USING XTOKEN-Sw "XTOKEN" 20SP CT-Sub CT-Line CT-Type CT-Div-Code CT-Paren-Level CT-Name
DEBUG D        END-CALL
               IF CT-Is-NDS                      *> Just got end-of-sentence
                   IF CD-In-Env-Div              *> ...If this happens in the ENVIRONMENT DIVISION
                       PERFORM 470-Pop-Reference *> ......Any stacked "update" or "defn" -> A reference
                   ELSE                          *> ...Anywhere else?
                       PERFORM 472-Pop-Update    *> ......It becomes an "update"
                   END-IF
                   MOVE SPACES TO Curr-Verb
               END-IF
      *>       *****************************************************************
      *>       ** Keep track of what DIVISION we"re in                        **
      *>       *****************************************************************
               EVALUATE PT-UC-Name    ALSO CT-Name-UC
      *>                                                    --------------------------------
               WHEN     "IDENTIFICATION" ALSO "DIVISION"    SET CD-In-Ident-Div TO TRUE
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In IDENTIFICATION DIVISION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "ENVIRONMENT"    ALSO "DIVISION"    SET CD-In-Env-Div TO TRUE
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In ENVIRONMENT DIVISION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "DATA"           ALSO "DIVISION"    SET CD-In-Data-Div TO TRUE
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In DATA DIVISION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "PROCEDURE"      ALSO "DIVISION"    SET CD-In-Proc-Div TO TRUE
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In PROCEDURE DIVISION" END-CALL
                                                            MOVE "PD  " TO Curr-Section
                                                            MOVE SPACES TO Curr-Verb
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               END-EVALUATE
      *>       *****************************************************************
      *>       ** Keep track of what DATA DIVISION SECTION  we"re in          **
      *>       *****************************************************************
               EVALUATE PT-UC-Name        ALSO CT-Name-UC
      *>                                                    --------------------------------
               WHEN     "FILE"            ALSO "SECTION"    MOVE "FILE" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In FILE SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "WORKING-STORAGE" ALSO "SECTION"    MOVE "WORK" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In WORKING-STORAGE SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "LOCAL-STORAGE"   ALSO "SECTION"    MOVE "LOCL" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In LOCAL-STORAGE SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "LINKAGE"         ALSO "SECTION"    MOVE "LINK" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In LINKAGE SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "REPORT"          ALSO "SECTION"    MOVE "REPT" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In REPORT SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               WHEN     "SCREEN"          ALSO "SECTION"    MOVE "SCRN" TO Curr-Section
DEBUG D                                                     CALL "DBGTXT" USING XPARSE-Sw "XPARSE" "In SCREEN SECTION" END-CALL
                                                            EXIT PERFORM CYCLE
      *>                                                    --------------------------------
               END-EVALUATE
      *>       *****************************************************************
      *>       ** If we just started a new statement, remember it             **
      *>       *****************************************************************
               IF CT-Is-Verb
                   PERFORM 472-Pop-Update
                   MOVE CT-Name-UC TO Curr-Verb
                   EXIT PERFORM CYCLE
               END-IF
      *>       *****************************************************************
      *>       ** Let the appropriate division-specific sub-parser handle the **
      *>       ** current token                                               **
      *>       *****************************************************************
               EVALUATE TRUE
               WHEN CD-In-Ident-Div  PERFORM 420-Parse-IDENTIFICATION-DIVISION
               WHEN CD-In-Env-Div    PERFORM 425-Parse-ENVIRONMENT-DIVISION
               WHEN CD-In-Data-Div   PERFORM 430-Parse-DATA-DIVISION
               WHEN CD-In-Proc-Div   PERFORM 435-Parse-PROCEDURE-DIVISION
               END-EVALUATE
           END-PERFORM
           CLOSE Expanded-Src-File; MOVE 0 TO Expanded-Src-Open
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       405-Get-Token SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "405-Get-Token" END-CALL
      *>************************************************************************
      *> This section is a finite state machine [FSM] that parses a GnuCOBOL  **
      *> program during the process of generating a cross-reference [xref]    **
      *> listing.  As such, it takes MANY liberties with the lexical proces-  **
      *> sing based on the fact that we will not have MADE it to the xref li- **
      *> sting unless we have a 100% guaranteed syntactically-correct program **
      *> to parse.  There is also a little context-sensitivity built in to re **
      *> duce the parsing complexity.                                         **
      *>                                                                      **
      *> Pardon the use of the dreaded "GO TO" statement in this section, but **
      *> it greatly simplified the coding of the FSM.                         **
      *>************************************************************************
           IF NOT CT-Is-UserDefn
      *>       *****************************************************************
      *>       ** If the current token is a reserved word, make it the        **
      *>       ** "previous" token                                            **
      *>       *****************************************************************
               MOVE Curr-Token TO Prev-Token
           END-IF
           INITIALIZE Curr-Token
           .
       405-State-1.
      *>************************************************************************
      *> Token:        Any                                                    **
      *> Expectations: None - we're just starting the token extraction        **
      *> Process:      Skip SPACES until a non-blank character is found.  At  **
      *>               that point, transition to another state to deal with   **
      *>               the token type indicated by that character.  Note that **
      *>               a number of characters that will just get in the way   **
      *>               of this scan will have already been converted to chars **
      *>               that "fit in" - See the comments for "410-Read" for    **
      *>               details.                                               **
      *>************************************************************************
           PERFORM UNTIL EXIT
               ADD 1 TO XS END-ADD
               MOVE XS-Rec(XS:1) TO Chr
DEBUG D        CALL "DBGKWV" USING XFSM-Sw "XFSM/1" "XS" XS "Chr" Chr END-CALL
               EVALUATE TRUE
               WHEN Chr = ","
      *>           *************************************************************
      *>           ** The only division where commas still exist is the DATA  **
      *>           ** DIVISION, where a comma is either part of a PICTURE     **
      *>           ** string or is just "noise".  In either case, we'll just  **
      *>           ** ignore it.                                              **
      *>           *************************************************************
                   EXIT PERFORM CYCLE
               WHEN Chr = SPACE
      *>           *************************************************************
      *>           ** Skip SPACES                                             **
      *>           *************************************************************
                   EXIT PERFORM CYCLE
               WHEN Chr = NDI
      *>           *************************************************************
      *>           **        END OF A SOURCE IMAGE (MARKED BY NDI)            **
      *>           ** On end of source image, read next line & restart state. **
      *>           ** This won't ever be returned to 400-Tokenize-Source.     **
      *>           *************************************************************
                   PERFORM 410-Read
                   EXIT PERFORM CYCLE
               WHEN Chr = NDS
      *>           *************************************************************
      *>           **      END OF A SENTENCE (Originally ".", now NDS)        **
      *>           ** Return an END-OF-SENTENCE token to 400-Tokenize-Source  **
      *>           *************************************************************
                   MOVE ">>> NDS <<<"  TO CT-Name
                                          CT-Name-UC
                   SET  CT-Is-NDS TO TRUE
                   MOVE RI-Seq-No      TO CT-Line
                   MOVE Paren-Level    TO CT-Paren-Level
                   MOVE Curr-Division  TO CT-Div-Code
                   IF PT-UC-Name = "PICTURE"
                       MOVE SPACES TO PT-UC-Name *> No longer looking for a PICTURE string
                   END-IF
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               WHEN (Chr = "X" OR "Z") AND (XS-Rec(XS + 1:1) = "'" OR """")
      *>           *************************************************************
      *>           **  START OF A WORD OR HEXADECIMAL/NULL-DELIMITED LITERAL  **
      *>           ** We only care about these as a possible PROGRAM-ID or    **
      *>           ** FUNCTION-ID, so unless the previous token was one of    **
      *>           ** those, we'll end up ignoring this. For now though, we   **
      *>           ** collect it.                                             **
      *>           *************************************************************
                   PERFORM 415-Save-Char *> Save the character
                   EXIT PERFORM CYCLE    *> And keep collecting chars
               WHEN C-Is-Letter
      *>           *************************************************************
      *>           **            START OF A WORD OR PICTURE STRING            **
      *>           ** Any letter (other than "X" and "Z" followed by quote or **
      *>           ** apostrophe) MUST be the start of a word (user-defined   **
      *>           ** or otherwise) OR must be part of a PICTURE string.      **
      *>           *************************************************************
                   PERFORM 415-Save-Char
                   GO TO 405-State-2
               WHEN C-Is-Digit
      *>           *************************************************************
      *>           **       START OF A LEVEL NUMBER OR A PICTURE STRING       **
      *>           ** Numbers are ignored everywhere but in the DATA DIVISION **
      *>           ** where we ignore them there too unless they are no more  **
      *>           ** than two digits long and are 01-49, 66, 77, 78, or 88.  **
      *>           ** We could ALSO be seeing the start of a PICTURE string.  **
      *>           *************************************************************
                   PERFORM 415-Save-Char
                   IF PT-UC-Name = "PICTURE"
                       GO TO 405-State-2
                   END-IF
                   GO TO 405-State-4
               WHEN Chr = "'" OR """"
      *>           *************************************************************
      *>           **      CONTINUATION OF AN X/Z LITERAL OR START OF AN      **
      *>           **          APOSTROPHE- OR QUOTE-DELIMITED STRING          **
      *>           *************************************************************
                   PERFORM 415-Save-Char
                   MOVE Chr TO Scan-Delim
                   GO TO 405-State-3
               WHEN Chr = "("
      *>           *************************************************************
      *>           **              INCREASING PARENTHESIS LEVEL               **
      *>           ** In this state, if we find a "(" character it can ONLY   **
      *>           ** be part of an expression, reference modifier, PICTURE   **
      *>           ** or subscript, so all we do is increment the parenthesis **
      *>           ** level so that 400-Tokenize-Source can use a level>0 to  **
      *>           ** force a data-item reference to be considered a          **
      *>           ** "Reference".   If it turns out we're parsing a PICTURE  **
      *>           ** string, this incrementation won't matter.               *
      *>           *************************************************************
                   ADD 1 TO Paren-Level END-ADD
                   EXIT PERFORM CYCLE
               WHEN Chr = ")"
      *>           *************************************************************
      *>           **              DECREASING PARENTHESIS LEVEL               **
      *>           ** In this state, if we find a ")" character it can ONLY   **
      *>           ** be part of an expression, reference modifier, PICTURE   **
      *>           ** or subscript, so all we do is increment the parenthesis **
      *>           ** level so that 400-Tokenize-Source can use a level>0 to  **
      *>           ** force a data-item reference to be considered a          **
      *>           ** "Reference".   If it turns out we're parsing a PICTURE  **
      *>           ** string, this decrementation won't matter.               **
      *>           *************************************************************
                   SUBTRACT 1 FROM Paren-Level END-SUBTRACT
                   EXIT PERFORM CYCLE
               WHEN Chr = "="
      *>           *************************************************************
      *>           **                          EQUALS                         **
      *>           ** When an "=" is found, return the reserved word "EQUALS" **
      *>           *************************************************************
                   SET  CT-Is-RsvdWd      TO TRUE
                   MOVE RI-Seq-No         TO CT-Line
                   MOVE Paren-Level       TO CT-Paren-Level
                   MOVE Curr-Division     TO CT-Div-Code
                   MOVE "EQUALS"          TO CT-Name
                                             CT-Name-UC
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               WHEN Chr = NDF
      *>           *************************************************************
      *>           **                       END OF FILE                       **
      *>           ** Return an END-OF-FILE token to 400-Tokenize-Source      **
      *>           *************************************************************
                   MOVE ">>> NDF <<<"  TO CT-Name
                                          CT-Name-UC
                   SET  CT-Is-NDF      TO TRUE
                   MOVE RI-Seq-No      TO CT-Line
                   MOVE Paren-Level    TO CT-Paren-Level
                   MOVE Curr-Division  TO CT-Div-Code
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               WHEN OTHER
      *>           *************************************************************
      *>           **                      ANYTHING ELSE                      **
      *>           ** If state 1 has been written correctly, this shouldn't   **
      *>           ** ever happen, but...just in case                         **
      *>           *************************************************************
                   MOVE 11  TO Exit-Code
                   MOVE Chr TO EMA-X1X
                   PERFORM 099-GOBACK *> Fatal Error: Unexpected character ('@') found in 405-State-1
                   *> Control will not return
               END-EVALUATE
           END-PERFORM
           .
       405-State-2.
      *>************************************************************************
      *> Token:        Keyword, Verb, Update Verb, Buzzword (ignored),        **
      *>               Data-Item, PICTURE string                              **
      *> Expectations: We already have at least one letter, digit, and/or     **
      *>               dash in the token buffer.                              **
      *> Process:      This routine will just keep tacking those characters   **
      *>               on (up to 63 - enforced by 415-Save-Char) until a dif- **
      *>               ferent class of character is found.  At that point the **
      *>               source record pointer will be reset 1 character so     **
      *>               State 1 can refind it the next time 405-Get-Token is   **
      *>               performed.  The exact nature of the word will be de-   **
      *>               termined and returned to 400-Tokenize-Source, except   **
      *>               for buzzwords, which will be ignored by resetting pro- **
      *>               cessing back to State 1.                               **
      *>************************************************************************
           PERFORM UNTIL EXIT
               ADD 1 TO XS END-ADD
               MOVE XS-Rec(XS:1) TO Chr
DEBUG D        CALL "DBGKWV" USING XFSM-Sw "XFSM/2" "XS" XS "Chr" Chr END-CALL
               EVALUATE TRUE ALSO TRUE
               WHEN C-Is-Letter OR C-Is-Digit OR C-Is-Dash ALSO ANY
      *>           *************************************************************
      *>           **            ADD ANOTHER IDENTIFIER CHARACTER             **
      *>           ** Just keep gluing those letters, digits, and dashes onto **
      *>           ** the end of the token we"re building.  If we are parsing **
      *>           ** a PICTURE string, keep the character also.              **
      *>           *************************************************************
                   PERFORM 415-Save-Char
                   EXIT PERFORM CYCLE
               WHEN Chr = "(" ALSO PT-UC-Name = "PICTURE"
                   EXIT PERFORM CYCLE
               WHEN Chr = ")" ALSO PT-UC-Name = "PICTURE"
                   EXIT PERFORM CYCLE
               WHEN Chr = "," ALSO ANY
                   EXIT PERFORM CYCLE
               WHEN OTHER
      *>           *************************************************************
      *>           **         ANY OTHER CHARACTER MARKS THE TOKEN END         **
      *>           ** When we get a different character, back up the source   **
      *>           ** code pointer (let State 1 deal with it) and then break  **
      *>           ** out of the loop.                                        **
      *>           *************************************************************
                   SUBTRACT 1 FROM XS END-SUBTRACT
                   EXIT PERFORM
               END-EVALUATE
           END-PERFORM
      *>   *********************************************************************
      *>   ** Now that we have a full word, let's see if it a reserved word.  **
      *>   ** If not it will be classified as a user-defined word, unless it  **
      *>   ** immediately follows "PICTURE" (then we'll throw it out and      **
      *>   ** start over).  If it IS a reserved word, we'll classify it as a  **
      *>   ** "buzzword" that just gets in the way (those get thrown out      **
      *>   ** too), an "update" verb (that changes one or more data items), a **
      *>   ** non-update verb, or just a keyword.                             **
      *>   *********************************************************************
           MOVE UPPER-CASE(CT-Name) TO CT-Name-UC
           EVALUATE TRUE
           WHEN CT-Name-UC = "PIC" *> Turn "PIC" into "PICTURE"
               MOVE "PICTURE"     TO CT-NAME
                                     CT-Name-UC
           WHEN PT-UC-Name = "PROGRAM-ID" OR "FUNCTION-ID"
               SET  CT-Is-Name    TO TRUE *> A word after either of these is a program/function ID
               MOVE RI-Seq-No   TO CT-Line
               MOVE Paren-Level   TO CT-Paren-Level
               MOVE Curr-Division TO CT-Div-Code
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-EVALUATE
           SEARCH ALL Reserved-Word-Tbl
           AT END
      *>       *****************************************************************
      *>       ** Not a reserved word - return "Identifier" unless we're      **
      *>       ** looking for a PICTURE string, in which case WE FOUND IT,    **
      *>       *****************************************************************
               IF PT-UC-Name = "PICTURE"
                   MOVE SPACES TO PT-UC-Name *> Turn off "PICTURE string" mode
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               END-IF
               SET  CT-Is-UserDefn TO TRUE
               MOVE RI-Seq-No      TO CT-Line
               MOVE Paren-Level    TO CT-Paren-Level
               MOVE Curr-Division  TO CT-Div-Code
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           WHEN RWT-Word (RWT-Idx) = CT-Name-UC
      *>       *****************************************************************
      *>       ** It IS a reserved word!  Now, what to do with it?            **
      *>       *****************************************************************
               MOVE RWT-Type-Code (RWT-Idx) TO CT-Type
               EVALUATE TRUE
               WHEN CT-Is-Buzzword
      *>           *************************************************************
      *>           ** It's a buzzword - throw it out and start over           **
      *>           *************************************************************
                   INITIALIZE Curr-Token
                   GO TO 405-State-1
               WHEN CT-Name-UC = "BY" AND NOT CD-In-Proc-Div
      *>           *************************************************************
      *>           ** "BY" is a buzzword too unless we're in the PROCEDURE    **
      *>           ** DIVISION                                                **
      *>           *************************************************************
                   INITIALIZE Curr-Token
                   GO TO 405-State-1
               WHEN OTHER
      *>           *************************************************************
      *>           ** It's an update verb, non-update verb or a keyword (that **
      *>           ** is defined in the table)                                **
      *>           *************************************************************
                   MOVE RI-Seq-No      TO CT-Line
                   MOVE Paren-Level    TO CT-Paren-Level
                   MOVE Curr-Division  TO CT-Div-Code
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               END-EVALUATE
           END-SEARCH
           .
       405-State-3.
      *>************************************************************************
      *> Token:        Quote- or Apostrophe-Delimited String                  **
      *> Expectations: The current token (thus far) is one of: ", ", X', X",  **
      *>               Z', or Z"                                              **
      *> Process:      Keep scanning and saving characters until the termina- **
      *>               ting character (apostrophe or quote) is found.  At     **
      *>               that point, the token will be discarded unless         **
      *>               "PROGRAM-ID" or "FUNCTION-ID" was found as the prior   **
      *>               token.                                                 **
      *>************************************************************************
           PERFORM UNTIL EXIT
               ADD 1 TO XS END-ADD
               MOVE XS-Rec(XS:1) TO Chr
DEBUG D        CALL "DBGKWV" USING XFSM-Sw "XFSM/3" "XS" XS "Chr" Chr END-CALL
               PERFORM 415-Save-Char
               IF Chr = Scan-Delim
                   EXIT PERFORM
               END-IF
           END-PERFORM
      *>   *********************************************************************
      *>   ** Now that we have the string/hex/null-delimited literal ... do   **
      *>   ** we keep it or discard it?                                       **
      *>   *********************************************************************
DEBUG D    CALL "DBGKWV" USING XFSM-Sw "XFSM/3" "PT-UC-Name" PT-UC-Name END-CALL
           IF PT-UC-Name = "PROGRAM-ID" OR "FUNCTION-ID"
               SET  CT-Is-Name               TO TRUE *> We keep it!
               MOVE RI-Seq-No                TO CT-Line
               MOVE Paren-Level              TO CT-Paren-Level
               MOVE Curr-Division            TO CT-Div-Code
               MOVE CT-Name                  TO CT-Name-UC
               MOVE UPPER-CASE(CT-Name(1:1)) TO CT-Name-UC(1:1)
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           ELSE *> We dump it!
               INITIALIZE Curr-Token
               GO TO 405-State-1
           END-IF
           .
       405-State-4.
      *>************************************************************************
      *> Token:        Possible level number?                                 **
      *> Expectations: A single digit has been found                          **
      *> Process:      If not in the DATA DIVISION or the previous token was  **
      *>               not an NDS, dump the rest of the token and start over. **
      *>************************************************************************
           SET NF-Is-Integer TO TRUE *> Assume the number is an integer
           PERFORM UNTIL EXIT
               ADD 1 TO XS END-ADD
               MOVE XS-Rec(XS:1) TO Chr
DEBUG D        CALL "DBGKWV" USING XFSM-Sw "XFSM/4" "XS" XS "Chr" Chr END-CALL
               EVALUATE TRUE
               WHEN C-Is-Digit
                   PERFORM 415-Save-Char
                   EXIT PERFORM CYCLE
               WHEN Chr = "."
                   PERFORM 415-Save-Char
                   SET NF-Is-Not-Integer TO TRUE
               WHEN C-Is-Dash
                   PERFORM 415-Save-Char
                   GO TO 405-State-2
               WHEN C-Is-Letter
                   PERFORM 415-Save-Char
                   GO TO 405-State-2
               WHEN OTHER
                   SUBTRACT 1 FROM XS END-SUBTRACT
      *>           *************************************************************
      *>           ** We're done ... now reject and start over if it isn't an **
      *>           ** integer or is longer than two digits                    **
      *>           *************************************************************
                   IF NF-Is-Not-Integer
                   OR CT-Sub > 2
                       INITIALIZE Curr-Token
                       GO TO 405-State-1
                   END-IF
      *>           *************************************************************
      *>           ** Also reject and start over if the (now confirmed) one-  **
      *>           ** or two-digit isn't a valid level number                 **
      *>           *************************************************************
                   EVALUATE CT-Sub ALSO TRUE
      *>                                           ---------------------
                   WHEN 1 ALSO CT-Name(1:1) > "0"  CONTINUE
      *>                                           ---------------------
                   WHEN 2 ALSO CT-Valid-Level-Num  CONTINUE
      *>                                           ---------------------
                   WHEN OTHER                      INITIALIZE Curr-Token
                                                   GO TO 405-State-1
      *>                                           ---------------------
                   END-EVALUATE
      *>           *************************************************************
      *>           ** It's a level number!  Return the Lvl# token.            **
      *>           *************************************************************
                   SET  CT-Is-LvlNo         TO TRUE
                   MOVE RI-Seq-No           TO CT-Line
                   MOVE Paren-Level         TO CT-Paren-Level
                   MOVE Curr-Division       TO CT-Div-Code
                   MOVE "LVL#"              TO CT-Name-UC
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               END-EVALUATE
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       410-Read SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "410-Read" END-CALL
      *>************************************************************************
      *> This section reads a record from the compressed source file and pre- **
      *> pares it fou use by the cross-reference listing generation process.  **
      *> It will:                                                             **
      *>                                                                      **
      *> 1. Handle an end-of-file condition by moving a record of all NDFv    **
      *>    characters so that 405-Get-Token may detect and properly handle   **
      *>    the end-of-file.                                                  **
      *>                                                                      **
      *> 2. Detect "#line" control records, using them to determine if the    **
      *>    following source code came from the main file or from a COPYed    **
      *>    proc (see #4).                                                    **
      *>                                                                      **
      *> 3. Detect and skip any other "#" control records.                    **
      *>                                                                      **
      *> 4. If a source image came from the main file, the source line number **
      *>    will be incremented by one; if it came from a COPYed proc, it     **
      *>    won't (see #2).                                                   **
      *>************************************************************************
           MOVE 0 TO XS
           PERFORM UNTIL EXIT
               READ Expanded-Src-File
               AT END
                   MOVE ALL NDF TO XS-Rec
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT SECTION
               NOT AT END
                   EVALUATE TRUE
                   WHEN XS-Rec(1:5) = "#line"
                       MOVE SPACES TO Curr-Filename
                       UNSTRING XS-Rec
                           DELIMITED BY """"
                           INTO Dummy-1
                                Curr-Filename
                                Dummy-2
                       END-UNSTRING
                       EVALUATE TRUE
                       WHEN Main-Filename = SPACES
                           MOVE Curr-Filename TO Main-Filename
                       WHEN Curr-Filename = Main-Filename
                           SUBTRACT 1 FROM RI-Seq-No END-SUBTRACT *> Otherwise line number drifts
                       END-EVALUATE
                       EXIT PERFORM CYCLE
                   WHEN XS-Rec(1:1) = "#"
                       EXIT PERFORM CYCLE
                   WHEN OTHER
      *>               *********************************************************
      *>               ** COBOL source line                                   **
      *>               *********************************************************
                       ADD 1 TO RI-Seq-No END-ADD
                       INSPECT XS-Rec                            *> Yeah, this burns CPU time but the user won't even
                           REPLACING TRAILING SPACES BY ALL NDI  *> notice.  Plus it looks cool in a debug listing.
      *>               *********************************************************
      *>               ** In the IDENTIFICATION DIVISION, eliminate periods,  **
      *>               ** otherwise flag all end-of-sentence periods          **
      *>               *********************************************************
                       IF CD-In-Ident-Div
                           INSPECT XS-Rec REPLACING ALL "." BY SPACE
                       ELSE
                           INSPECT XS-Rec REPLACING ALL PERIOD-NDI BY NDS-NDI
                                                    ALL ". "       BY NDS-SPACE
                       END-IF
      *>               *********************************************************
      *>               ** Change relation operators <= and >= to SPACES       **
      *>               *********************************************************
                       INSPECT XS-REC REPLACING ALL "<=" BY SPACES
                                                ALL ">=" BY SPACES
      *>               *********************************************************
      *>               ** Change all the "noise" characters we don't care     **
      *>               ** about to SPACES                                     **
      *>               *********************************************************
                       INSPECT XS-Rec CONVERTING ":;+<>&" TO SPACES
                       IF NOT CD-In-Data-Div
                           INSPECT XS-Rec CONVERTING ",/" TO SPACES
                       END-IF
      *>               *********************************************************
      *>               ** Change "minus signs" TO SPACES                      **
      *>               *********************************************************
                       INSPECT XS-Rec REPLACING ALL "(-" BY "( "
                                                ALL " -" BY "  "
      *>               *********************************************************
      *>               ** Change "multiplication operators" to SPACES         **
      *>               *********************************************************
                       INSPECT XS-Rec REPLACING ALL " * " BY "   "
      *>               *********************************************************
      *>               ** Change "*", "/", and "$" PICTURE symbols to "X"     **
      *>               *********************************************************
                       IF CD-In-Data-Div
                           INSPECT XS-Rec CONVERTING "*$/" TO "XXX"
                       END-IF
DEBUG D                CALL "DBGDUMP" USING XREAD-Sw "XREAD" "Edited Source Record" XS-Rec END-CALL
DEBUG D                CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                       EXIT SECTION
                   END-EVALUATE
               END-READ
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       415-Save-Char SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "415-Save-Char" END-CALL
      *>************************************************************************
      *> This section saves the current character to the token string that is **
      *> being built.  No more than 63 characters will be saved.              **
      *>************************************************************************
           IF CT-Sub < 63
               ADD  1   TO CT-Sub END-ADD
               MOVE Chr TO CT-Name(CT-Sub:1)
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       420-Parse-IDENTIFICATION-DIVISION SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "420-Parse-IDENTIFICATION-DIVISION" END-CALL
      *>************************************************************************
      *> Special sub-parser that handles the specifics of the IDENTIFICATION  **
      *> DIVISION.                                                            **
      *>************************************************************************
           IF CT-Is-Name
               EVALUATE PT-UC-Name
      *>                              ---------------------------------
               WHEN     "PROGRAM-ID"  MOVE CT-Name-UC TO Prog-ID
      *>                              ---------------------------------
               WHEN     "FUNCTION-ID" MOVE CT-Name-UC TO Prog-ID
      *>                              ---------------------------------
               END-EVALUATE
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       425-Parse-ENVIRONMENT-DIVISION SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "425-Parse-ENVIRONMENT-DIVISION" END-CALL
      *>************************************************************************
      *> Special sub-parser that handles the specifics of the ENVIRONMENT     **
      *> DIVISION.                                                            **
      *>************************************************************************
DEBUG D    CALL "DBGKWV" USING XPARSE-Sw "XPARSE"
DEBUG D                                  "PT-UC-Name" TRIM(PT-UC-Name)
DEBUG D                                  "CT-Name-UC" TRIM(CT-Name-UC)
DEBUG D    END-CALL
           EVALUATE TRUE
           WHEN CT-Is-UserDefn
               EVALUATE PT-UC-Name ALSO TRUE
      *>            PT-UC-Name         TRUE
      *>            -------------      -------------------- --------------------------------
               WHEN ">>> NDS <<<" ALSO ANY                  PERFORM 470-Pop-Reference
      *>                                                    --------------------------------
               WHEN "ALPHABET"    ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "CLASS"       ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "CRT"         ALSO ANY                  PERFORM 454-Release-Reference
      *>                                                    --------------------------------
               WHEN "CURSOR"      ALSO ANY                  PERFORM 454-Release-Reference
      *>                                                    --------------------------------
               WHEN "ON"          ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "OFF"         ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "SYMBOLIC"    ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "TOP"         ALSO ANY                  PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN ANY           ALSO PT-Is-Device         PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN ANY           ALSO PT-Is-Feature        PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN ANY           ALSO PT-Is-Switch         PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "SELECT"      ALSO ANY                  MOVE CT-Name TO SELECT-Filename
                                                            PERFORM 450-Release-Definition
      *>                                                    --------------------------------
               WHEN "FILE"        ALSO ANY                  PERFORM 476-Save-Status
      *>                                                    --------------------------------
               WHEN "SORT"        ALSO ANY                  PERFORM 476-Save-Status
      *>                                                    --------------------------------
               WHEN "RECORD"      ALSO ANY                  PERFORM 470-Pop-Reference
                                                            PERFORM 464-Push-Reference
      *>                                                    --------------------------------
               WHEN "EQUALS"      ALSO ANY                  PERFORM 468-Pop-Definition
                                                            PERFORM 454-Release-Reference
      *>                                                    --------------------------------
               WHEN "SOURCE"      ALSO ANY                  PERFORM 468-Pop-Definition
                                                            PERFORM 454-Release-Reference
      *>                                                    --------------------------------
               WHEN  ANY          ALSO ANY                  PERFORM 454-Release-Reference
      *>                                                    --------------------------------
               END-EVALUATE
           WHEN CT-Is-NDS
               PERFORM 470-Pop-Reference
      *>   WHEN CT-Is-RsvdWd                                May Want this someday
      *>       EVALUATE ??????????
      *>                                                    --------------------------------
      *>       WHEN "??????????"                            desired action(s)
      *>                                                    --------------------------------
      *>       END-EVALUATE
           END-EVALUATE
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       430-Parse-DATA-DIVISION SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "430-Parse-DATA-DIVISION" END-CALL
      *>************************************************************************
      *> Special sub-parser that handles the specifics of the DATA DIVISION.  **
      *>************************************************************************
           IF CT-Is-UserDefn
               EVALUATE PT-UC-Name
      *>                          --------------------------------
               WHEN     "FD"      PERFORM 454-Release-Reference
                                  MOVE CT-Name TO Curr-FD-Filename
      *>                          --------------------------------
               WHEN     "SD"      PERFORM 454-Release-Reference
                                  MOVE CT-Name TO Curr-FD-Filename
      *>                          --------------------------------
               WHEN     "RD"      PERFORM 450-Release-Definition
      *>                          --------------------------------
               WHEN     "LVL#"    PERFORM 450-Release-Definition
                                  PERFORM 474-Save-Record
      *>                          --------------------------------
               WHEN     "INDEXED" PERFORM 450-Release-Definition
      *>                          --------------------------------
               WHEN     "TO"      PERFORM 462-Release-Update
      *>                          --------------------------------
               WHEN     "USING"   PERFORM 462-Release-Update
      *>                          --------------------------------
               WHEN      ANY      PERFORM 454-Release-Reference
      *>                          --------------------------------
               END-EVALUATE
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       435-Parse-PROCEDURE-DIVISION SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "435-Parse-PROCEDURE-DIVISION" END-CALL
      *>************************************************************************
      *> Special sub-parser that handles the specifics of the PROCEDURE       **
      *> DIVISION.                                                            **
      *>************************************************************************
DEBUG D    CALL "DBGKWV" USING XPARSE-Sw "XPARSE"
DEBUG D                                  "PT-UC-Name" TRIM(PT-UC-Name)
DEBUG D                                  "CT-Name-UC" TRIM(CT-Name-UC)
DEBUG D    END-CALL
           IF CT-Is-UserDefn
               EVALUATE Curr-Verb ALSO PT-UC-Name
      *>                                                ---------------------------------
               WHEN     "ACCEPT"     ALSO "ACCEPT"      PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "ADD"        ALSO "TO"          PERFORM 466-Push-Update
      *>                                                ---------------------------------
               WHEN     "ADD"        ALSO "GIVING"      PERFORM 470-Pop-Reference
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "ALLOCATE"   ALSO "ALLOCATE"    PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "ALLOCATE"   ALSO "RETURNING"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "ALTER"      ALSO "ALTER"       PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "CALL"       ALSO "RETURNING"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "CALL"       ALSO "GIVING"      PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "CLOSE"      ALSO "CLOSE"       MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 454-Release-Reference
      *>                                                ---------------------------------
               WHEN     "COMPUTE"    ALSO "COMPUTE"     PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "DELETE"     ALSO "DELETE"      MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 456-Release-Rec-Ref
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "DIVIDE"     ALSO "INTO"        PERFORM 466-Push-Update
      *>                                                ---------------------------------
               WHEN     "DIVIDE"     ALSO "GIVING"      PERFORM 470-Pop-Reference
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "DIVIDE"     ALSO "REMAINDER"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "END"        ALSO "PROGRAM"     CONTINUE
      *>                                                ---------------------------------
               WHEN     "FREE"       ALSO "FREE"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "INITIALIZE" ALSO "INITIALIZE"  PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "INSPECT"    ALSO "INSPECT"     PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "INSPECT"    ALSO "TALLYING"    PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "JSON"       ALSO "GENERATE"    PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "JSON"       ALSO "COUNT"       PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "JSON"       ALSO "INTO"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "MERGE"      ALSO "MERGE"       PERFORM 462-Release-Update
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "MERGE"      ALSO "USING"       PERFORM 454-Release-Reference
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "MERGE"      ALSO "GIVING"      PERFORM 462-Release-Update
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "MOVE"       ALSO "TO"          PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "MULTIPLY"   ALSO "BY"          PERFORM 466-Push-Update
      *>                                                ---------------------------------
               WHEN     "MULTIPLY"   ALSO "GIVING"      PERFORM 470-Pop-Reference
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "OPEN"       ALSO "INPUT"       PERFORM 454-Release-Reference
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "OPEN"       ALSO "EXTEND"      MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "OPEN"       ALSO "OUTPUT"      MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "OPEN"       ALSO "I-O"         MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "PERFORM"    ALSO "VARYING"     PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "PERFORM"    ALSO "AFTER"       PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "READ"       ALSO "READ"        PERFORM 458-Release-Rec-Update
                                                        PERFORM 454-Release-Reference
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "READ"       ALSO "INTO"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "RELEASE"    ALSO "RELEASE"     PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 464-Push-Reference
      *>                                                ---------------------------------
               WHEN     "RELEASE"    ALSO "FROM"        PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 472-Pop-Update
      *>                                                ---------------------------------
               WHEN     "RETURN"     ALSO "RETURN"      PERFORM 458-Release-Rec-Update
                                                        PERFORM 454-Release-Reference
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "RETURN"     ALSO "INTO"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "REWRITE"    ALSO "REWRITE"     PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 464-Push-Reference
      *>                                                ---------------------------------
               WHEN     "REWRITE"    ALSO "FROM"        PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 472-Pop-Update
      *>                                                ---------------------------------
               WHEN     "WRITE"      ALSO "WRITE"       PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 464-Push-Reference
      *>                                                ---------------------------------
               WHEN     "WRITE"      ALSO "FROM"        PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 472-Pop-Update
      *>                                                ---------------------------------
               WHEN     "SET"        ALSO "SET"         PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "SORT"       ALSO "SORT"        PERFORM 462-Release-Update
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "SORT"       ALSO "USING"       PERFORM 454-Release-Reference
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "SORT"       ALSO "GIVING"      PERFORM 462-Release-Update
                                                        MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "START"      ALSO "START"       MOVE CT-Name TO FAST-Hold-Name
                                                        PERFORM 460-Release-Status-Update
      *>                                                ---------------------------------
               WHEN     "STRING"     ALSO "INTO"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "STRING"     ALSO "POINTER"     PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "SUBTRACT"   ALSO "FROM"        PERFORM 466-Push-Update
      *>                                                ---------------------------------
               WHEN     "SUBTRACT"   ALSO "GIVING"      PERFORM 470-Pop-Reference
                                                        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "TRANSFORM"  ALSO "TRANSFORM"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "UNSTRING"   ALSO "INTO"        PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "UNSTRING"   ALSO "DELIMITER"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "UNSTRING"   ALSO "COUNT"       PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "UNSTRING"   ALSO "TALLYING"    PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "WRITE"      ALSO "WRITE"       PERFORM 452-Release-File-Update
                                                        PERFORM 460-Release-Status-Update
                                                        PERFORM 454-Release-Reference
      *>                                                ---------------------------------
               WHEN     "XML"        ALSO "GENERATE"    PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN     "XML"        ALSO "COUNT"       PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN      ANY         ALSO ">>> NDS <<<" PERFORM 450-Release-Definition    *> Paragraph/Section
                                                        MOVE SPACES              TO Sort-Work-Rec
                                                        MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
                                                        MOVE CT-Name-UC          TO SWR-Name-UC
                                                        MOVE CT-Name             TO SWR-Name
                                                        MOVE 00000               TO SWR-Line-Num
                                                        MOVE "PD"                TO SWR-Section
                                                        MOVE "PROC"              TO SWR-Class
DEBUG D                                                 CALL "DBGCOL"
DEBUG D                                                     USING XREF-Sw "XREF" "Released (435):     " 4SP
DEBUG D                                                           SWR-Prog-ID
DEBUG D                                                           SWR-Line
DEBUG D                                                           SWR-Name-UC
DEBUG D                                                 END-CALL
                                                        RELEASE Sort-Work-Rec
      *>                                                ---------------------------------
               WHEN      ANY         ALSO "REFERENCE"   PERFORM 462-Release-Update
      *>                                                ---------------------------------
               WHEN      ANY         ALSO  ANY          PERFORM 454-Release-Reference
      *>                                                ---------------------------------
               END-EVALUATE
           END-IF
DEBUG D    IF PT-UC-Name = "END" AND CT-Name-UC = "PROGRAM"
DEBUG D        CALL "DBGTXT" USING XPARSE-Sw "<End Program>" TRIM(Prog-ID) END-CALL
DEBUG D    END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       450-Release-Definition SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "450-Release-Definition" END-CALL
      *>************************************************************************
      *> Release a "Definition" record to the sort.                           **
      *>************************************************************************
           MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
           MOVE CT-Name-UC          TO SWR-Name-UC
           MOVE CT-Name             TO SWR-Name
           MOVE CT-Line             TO SWR-Line-Num
           MOVE DEF                 TO SWR-Line-Flag
DEBUG D    CALL "DBGCOL" USING XREF-Sw "XREF" "Released (450):     " 4SP SWR-Prog-ID SWR-Line SWR-Name
           RELEASE Sort-Work-Rec
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       452-Release-File-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "452-Release-File-Update" END-CALL
      *>************************************************************************
      *> This routine identifies the file associated with a record and re-    **
      *> leases an UPDATE record for that file.                               **
      *>************************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > RAFTSIZE OR RAFT-Recordname(I) = LOW-VALUES
               IF UPPER-CASE(RAFT-Recordname(I)) = UPPER-CASE(CT-Name)
                   MOVE UPPER-CASE(Prog-ID)  TO SWR-Prog-ID
                   MOVE RAFT-Filename(I)     TO SWR-Name
                                                FAST-Hold-Name
                   MOVE UPPER-CASE(SWR-Name) TO SWR-Name-UC
                                                Search-Name
                   MOVE CT-Line              TO SWR-Line-Num
                                                Search-Line
                   MOVE UPD                  TO SWR-Line-Flag
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Released (452):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
                   RELEASE Sort-Work-Rec
                   PERFORM 490-Propagate-Update
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       454-Release-Reference SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "454-Release-Reference" END-CALL
      *>************************************************************************
      *> Release a "Reference" record to the sort.                            **
      *>************************************************************************
           MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
           MOVE CT-Name-UC          TO SWR-Name-UC
           MOVE CT-Name             TO SWR-Name
           MOVE CT-Line             TO SWR-Line-Num
           MOVE REF                 TO SWR-Line-Flag
DEBUG D    CALL "DBGCOL" USING XREF-Sw "XREF" "Released (454):     " 4SP SWR-Prog-ID SWR-Line SWR-Name
           RELEASE Sort-Work-Rec
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       456-Release-Rec-Ref SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "456-Release-Rec-Ref" END-CALL
      *>************************************************************************
      *> This routine identifies the record(s) associated with a file and     **
      *> releases REFERENCE records for each of them.                         **
      *>************************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > RAFTSIZE OR RAFT-Filename(I) = LOW-VALUES
               IF UPPER-CASE(RAFT-Filename(I)) = CT-Name-UC
                   MOVE UPPER-CASE(Prog-ID)  TO SWR-Prog-ID
                   MOVE RAFT-Recordname(I)   TO SWR-Name
                   MOVE UPPER-CASE(SWR-Name) TO SWR-Name-UC
                   MOVE CT-Line              TO SWR-Line-Num
                   MOVE REF                  TO SWR-Line-Flag
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Released (456):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
                   RELEASE Sort-Work-Rec
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       458-Release-Rec-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "458-Release-Rec-Update" END-CALL
      *>************************************************************************
      *> This routine identifies the record(s) associated with a file and     **
      *> releases UPDATE records for each of them.                            **
      *>************************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > RAFTSIZE OR RAFT-Filename(I) = LOW-VALUES
               IF UPPER-CASE(RAFT-Filename(I)) = CT-Name-UC
                   MOVE UPPER-CASE(Prog-ID)  TO SWR-Prog-ID
                   MOVE RAFT-Recordname(I)   TO SWR-Name
                   MOVE UPPER-CASE(SWR-Name) TO SWR-Name-UC
                                                Search-Name
                   MOVE CT-Line              TO SWR-Line-Num
                                                Search-Line
                   MOVE UPD                  TO SWR-Line-Flag
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Released (458):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
                   RELEASE Sort-Work-Rec
                   PERFORM 490-Propagate-Update
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       460-Release-Status-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "460-Release-Status-Update" END-CALL
      *>************************************************************************
      *> This routine identifies the status item(s) associated with a file    **
      *> and releases UPDATE records for each of them.  Note that it expects  **
      *> FAST-Hold-Name to have been populated with the name of the file.     **
      *> The code that handles the file-oriented I/O statements in 240-Parse- **
      *> PROCEDURE-DIVISION (CLOSE, OPEN, READ, RETURN, START) needs to save  **
      *> "UC-Name" to "FAST-Hold-Name" before PERFORMing this routine.  The   **
      *> code that handles the record-oriented I/O statements in 240-Parse-   **
      *> PROCEDURE-DIVISION (RELEASE, REWRITE, WRITE) doesn't because that    **
      *> will be done automatically when the handlers for those statements    **
      *> PERFORM 452-Release-File-Update.                                     **
      *>************************************************************************
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > FASTSIZE OR FAST-Filename(I) = LOW-VALUES
DEBUG D        CALL "DBGKWV" USING XFAST-Sw "XFAST"
DEBUG D                            "FAST-Filename" UPPER-CASE(TRIM(FAST-Filename(I)))
DEBUG D                            "FAST-Hold-Name" UPPER-CASE(TRIM(FAST-Hold-Name)) END-CALL
               IF UPPER-CASE(FAST-Filename(I)) = UPPER-CASE(FAST-Hold-Name)
                   MOVE UPPER-CASE(Prog-ID)  TO SWR-Prog-ID
                   MOVE FAST-Status(I)       TO SWR-Name
                   MOVE UPPER-CASE(SWR-Name) TO SWR-Name-UC
                                                Search-Name
                   MOVE CT-Line              TO SWR-Line-Num
                                                Search-Line
                   MOVE UPD                  TO SWR-Line-Flag
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Released (460):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
                   RELEASE Sort-Work-Rec
                   PERFORM 490-Propagate-Update
               END-IF
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       462-Release-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "462-Release-Update" END-CALL
      *>************************************************************************
      *> Release an "Update" record to the sort, unless the data item is      **
      *> coded within a subscript, function call, or reference modifier, in   **
      *> which case it will be released as a Reference.                       **
      *>************************************************************************
           MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
           MOVE CT-Name-UC          TO SWR-Name-UC
                                       Search-Name
           MOVE CT-Name             TO SWR-Name
           MOVE PT-Line             TO SWR-Line-Num
                                       Search-Line
           IF CT-Paren-Level > 0
               MOVE REF     TO SWR-Line-Flag
           ELSE
               MOVE UPD     TO SWR-Line-Flag
           END-IF
DEBUG D    CALL "DBGCOL" USING XREF-Sw "XREF" "Released (462):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
           RELEASE Sort-Work-Rec
           IF CT-Paren-Level = 0
               PERFORM 490-Propagate-Update
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       464-Push-Reference SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "464-Push-Reference" END-CALL
      *>************************************************************************
      *> This routine will "push" a REFERENCE record for a data-item onto     **
      *> the Stack.  See the documentation in front of that item's            **
      *> definition for more information.                                     **
      *>************************************************************************
           MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
           MOVE CT-Name-UC          TO SWR-Name-UC
           MOVE CT-Name             TO SWR-Name
           MOVE CT-Line             TO SWR-Line-Num
           MOVE REF                 TO SWR-Line-Flag
           ADD  1                   TO Stack-Sub END-ADD
           IF Stack-Sub > STACKSIZE
               MOVE 12 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: 'Stack' is full - Increase STACKSIZE
               *> Control will not return
           END-IF
DEBUG D    CALL "DBGCOL" USING XREF-Sw "XREF" "Pushed (464):       " Stack-Sub SWR-Prog-ID SWR-Line SWR-Name END-CALL
           MOVE Sort-Work-Rec TO Stack-Entry(Stack-Sub)
           INITIALIZE Sort-Work-Rec
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       466-Push-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "466-Push-Update" END-CALL
      *>************************************************************************
      *> This routine will "push" an UPDATE record for a data-item onto the   **
      *> Stack.  See the documentation in front of that item's definition     **
      *> for more information.                                                **
      *>************************************************************************
           IF CT-Paren-Level > 0 *> Function arg, Reference Mod, or Subscript - always REFERENCE
               MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
               MOVE CT-Name-UC          TO SWR-Name-UC
               MOVE CT-Name             TO SWR-Name
               MOVE CT-Line             TO SWR-Line-Num
               MOVE REF                 TO SWR-Line-Flag
DEBUG D        CALL "DBGCOL" USING XREF-Sw "XREF" "Released (466):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
               RELEASE Sort-Work-Rec
           ELSE
               MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
               MOVE CT-Name-UC          TO SWR-Name-UC
               MOVE CT-Name             TO SWR-Name
               MOVE PT-Line             TO SWR-Line-Num
               MOVE UPD                 TO SWR-Line-Flag
               ADD  1                   TO Stack-Sub END-ADD
               IF Stack-Sub > STACKSIZE
                   MOVE 12 TO Exit-Code
                   PERFORM 099-GOBACK *> Fatal Error: 'Stack' is full - Increase STACKSIZE
                   *> Control will not return
               END-IF
DEBUG D        CALL "DBGCOL"
DEBUG D            USING XREF-Sw "XREF" "Pushed (466):       " Stack-Sub SWR-Prog-ID SWR-Line SWR-Name
DEBUG D        END-CALL
               MOVE Sort-Work-Rec TO Stack-Entry(Stack-Sub)
               INITIALIZE Sort-Work-Rec
           END-IF
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       468-Pop-Definition SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "468-Pop-Definition" END-CALL
      *>************************************************************************
      *> This routine will "pop" a record for a data-item off the Stack       **
      *> and release it to the SORT as a DEFINITION.  See the documentation   **
      *> in front of that item's definition for more information.             **
      *>************************************************************************
           PERFORM UNTIL Stack-Sub = 0
               MOVE Stack-Entry(Stack-Sub) TO Sort-Work-Rec
               MOVE DEF                    TO SWR-Line-Flag
DEBUG D        CALL "DBGCOL"
DEBUG D            USING XREF-Sw "XREF" "Pop/Released (468): " Stack-Sub SWR-Prog-ID SWR-Line SWR-Name
DEBUG D        END-CALL
               SUBTRACT 1 FROM Stack-Sub END-SUBTRACT
               RELEASE Sort-Work-Rec
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       470-Pop-Reference SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "470-Pop-Reference" END-CALL
      *>************************************************************************
      *> This routine will "pop" a record for a data-item off the Stack    **
      *> and release it to the SORT as a REFERENCE.  See the documentation in **
      *> front of that item's definition for more information.                **
      *>************************************************************************
           PERFORM UNTIL Stack-Sub = 0
               MOVE Stack-Entry(Stack-Sub) TO Sort-Work-Rec
               MOVE REF                    TO SWR-Line-Flag
DEBUG D        CALL "DBGCOL"
DEBUG D            USING XREF-Sw "XREF" "Pop/Released (470): " Stack-Sub SWR-Prog-ID SWR-Line SWR-Name
DEBUG D        END-CALL
               SUBTRACT 1 FROM Stack-Sub END-SUBTRACT
               RELEASE Sort-Work-Rec
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       472-Pop-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "472-Pop-Update" END-CALL
      *>************************************************************************
      *> This routine will "pop" a record for a data-item off the Stack       **
      *> and release it to the SORT as an UPDATE.  See the documentation in   **
      *> front of that item's definition for more information.                **
      *>************************************************************************
           PERFORM UNTIL Stack-Sub = 0
               MOVE Stack-Entry(Stack-Sub) TO Sort-Work-Rec
               MOVE UPD                    TO SWR-Line-Flag
               MOVE SWR-Name-UC            TO Search-Name
               MOVE SWR-Line-Num           TO Search-Line
DEBUG D        CALL "DBGCOL"
DEBUG D            USING XREF-Sw "XREF" "Pop/Released (472): " Stack-Sub SWR-Prog-ID SWR-Line SWR-Name
DEBUG D        END-CALL
               SUBTRACT 1 FROM Stack-Sub END-SUBTRACT
               RELEASE Sort-Work-Rec
               PERFORM 490-Propagate-Update
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       474-Save-Record SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "474-Save-Record" END-CALL
      *>************************************************************************
      *> This routine will - if PERFORMed while in the FILE SECTION - save a  **
      *> filename/recordname into the Record And File Table.                  **
      *>************************************************************************
           IF (Curr-Section = "FILE")
           AND (PT-Name = "1" OR "01")
               CONTINUE
           ELSE
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION
           END-IF
           ADD 1 TO RAFT-Sub END-ADD
           IF RAFT-Sub > RAFTSIZE
               MOVE 13 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: 'Record And File Table' is full - Increase RAFTSIZE
               *> Control will not return
           END-IF
           MOVE Curr-FD-Filename TO RAFT-Filename(RAFT-Sub)
           MOVE CT-Name          TO RAFT-Recordname(RAFT-Sub)
DEBUG D    CALL "DBGCOL" USING XRAFT-Sw "XRAFT" 20SP TRIM(Curr-FD-Filename) TRIM(CT-Name)
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       476-Save-Status SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "476-Save-Status" END-CALL
      *>************************************************************************
      *> This routine will - if PERFORMed while in the ENVIRONMENT DIVISION - **
      *> save a filename/ into the Files And Statuses Table (FAST).           **
      *>************************************************************************
           ADD 1 TO FAST-Sub END-ADD
           IF FAST-Sub > FASTSIZE
               MOVE 14 TO Exit-Code
               PERFORM 099-GOBACK *> Fatal Error: 'Files & Statuses Table' is full - Increase FASTSIZE
               *> Control will not return
           END-IF
           MOVE SELECT-Filename TO FAST-Filename(FAST-Sub)
           MOVE CT-Name         TO FAST-Status(FAST-Sub)
DEBUG D    CALL "DBGCOL" USING XFAST-Sw "XFAST" 20SP TRIM(SELECT-Filename) TRIM(CT-Name)
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       480-Process-Symbol-Table SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "480-Process-Symbol-Table" END-CALL
      *>************************************************************************
      *> Read the Symbol Table File and process the symbol table listing,     **
      *> creating a line 000000 sort record for each data item on the report. **
      *> This record will contain the information that appears on the right   **
      *> half of each item's cross-reference report entry.                    **
      *>************************************************************************
           OPEN INPUT Symbol-Table-File; MOVE 1 TO Symbol-Table-Open
           MOVE SPACES TO SymTab-Items
           PERFORM UNTIL EXIT
               READ Symbol-Table-File
               AT END
                   CLOSE Symbol-Table-File; MOVE 0 TO Symbol-Table-Open
DEBUG D            CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
                   EXIT PERFORM
               NOT AT END
      *>           *************************************************************
      *>           ** If a data item has a size > 99999 bytes, it will push   **
      *>           ** all the other items to the right, making it very diffi- **
      *>           ** cult to use fixed fields.  But ... there's UNSTRING...  **
      *>           *************************************************************
                   MOVE 1 TO I
                   UNSTRING Symbol-Table-Rec DELIMITED BY ALL SPACES
                       INTO SPI-Word-1 *> Size or SPACES
                            SPI-Word-2 *> Class or Section-Name
                            SPI-Word-3 *> "SECTION" or Level-Number or Program-ID
                            SPI-Word-4 *> Data-Name
                       WITH POINTER I
                   END-UNSTRING
      *>           *************************************************************
      *>           ** Stopped short of parsing the whole record.  "I" should  **
      *>           ** now be sitting at the first char of the description (if **
      *>           ** there is one), or it's sitting off the end of the       **
      *>           ** record.                                                 **
      *>           *************************************************************
                   IF I < LENGTH OF Symbol-Table-Rec
                       MOVE Symbol-Table-Rec(I:) TO SPI-Word-5 *> "Word" 5 is the whole description
                   END-IF
                   INSPECT SPI-Word-4 REPLACING ALL "," BY SPACE *> Deals with "xxxxxxxxx, REDEFINES yyyyyyyy"
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Parse: " SPI-Word-1
DEBUG D                                                      SPI-Word-2
DEBUG D                                                      SPI-Word-3
DEBUG D                                                      SPI-Word-4
DEBUG D                                                      SPI-Word-5
DEBUG D            END-CALL
                   EVALUATE SPI-Word-2
      *>                                  -----------------------------------------
                   WHEN "ALPHANUMERIC"    MOVE "ALPH"                 TO SI-Class
                                          MOVE SPI-Word-5             TO SI-Desc
                                          MOVE SPI-Word-3             TO SI-Level
                                          MOVE SPI-Word-4             TO SI-Name
                                          MOVE SPI-Word-1             TO SI-Size
      *>                                  -----------------------------------------
                   WHEN "CONDITIONAL"     MOVE "COND"                 TO SI-Class
                                          MOVE SPACES                 TO SI-Desc
                                          MOVE "88"                   TO SI-Level
                                          MOVE SPI-Word-4             TO SI-Name
                                          MOVE SPACES                 TO SI-Size
      *>                                  -----------------------------------------
                   WHEN "FILE"            MOVE "FILE"                 TO SI-Class
                                          MOVE SPACES                 TO SI-Desc
                                          MOVE SPACES                 TO SI-Level
                                          MOVE SPI-Word-3             TO SI-Name
                                          MOVE "FILE"                 TO SI-Section
                                          MOVE SPI-Word-1             TO SI-Size
      *>                                  -----------------------------------------
                   WHEN "GROUP"           MOVE "GRP"                  TO SI-Class
                                          MOVE SPI-Word-5             TO SI-Desc
                                          MOVE SPI-Word-3             TO SI-Level
                                          MOVE SPI-Word-4             TO SI-Name
                                          MOVE SPI-Word-1             TO SI-Size
      *>                                  -----------------------------------------
                   WHEN "LINKAGE"         MOVE "LINK"                 TO SI-Section
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   WHEN "LOCAL-STORAGE"   MOVE "LOCL"                 TO SI-Section
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   WHEN "NUMERIC"         MOVE "NUM"                  TO SI-Class
                                          MOVE SPI-Word-5             TO SI-Desc
                                          MOVE SPI-Word-3             TO SI-Level
                                          MOVE SPI-Word-4             TO SI-Name
                                          MOVE SPI-Word-1             TO SI-Size
      *>                                  -----------------------------------------
                   WHEN "PROGRAM"         MOVE UPPER-CASE(SPI-Word-3) TO SI-Prog-ID
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   WHEN "REPORT"          MOVE "LOCL"                 TO SI-Section
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   WHEN "SCREEN"          MOVE "SCRN"                 TO SI-Section
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   WHEN "WORKING-STORAGE" MOVE "WORK"                 TO SI-Section
                                          EXIT PERFORM CYCLE
      *>                                  -----------------------------------------
                   END-EVALUATE
      *>           *************************************************************
      *>           ** Ignore FILLER elementary items                          **
      *>           *************************************************************
                   MOVE UPPER-CASE(SI-Name) TO SI-Name-UC
                   IF SI-Name-UC = "FILLER"
                       CONTINUE
                   ELSE
      *>               *********************************************************
      *>               ** Build and RELEASE a sort record                     **
      *>               *********************************************************
                       MOVE SPACES     TO Sort-Work-Rec
                       MOVE SI-Prog-ID TO SWR-Prog-ID
                       MOVE SI-Name-UC TO SWR-Name-UC
                       MOVE SI-Name    TO SWR-Name
                       MOVE 000000     TO SWR-Line-Num
                       MOVE SI-Section TO SWR-Section
                       MOVE SI-Level   TO SWR-Level
                       MOVE SI-Class   TO SWR-Class
                       MOVE SI-Size    TO SWR-Size
                       MOVE SI-Desc    TO SWR-Desc
DEBUG D                CALL "DBGCOL" USING XREF-Sw "XREF" "Released (480):     " 4SP SWR-Prog-ID SWR-Line SWR-Name END-CALL
                       RELEASE Sort-Work-Rec
                   END-IF
      *>           *************************************************************
      *>           ** Keep the items we DON'T want in the Symbol Table out!   **
      *>           *************************************************************
                   IF (SI-Level = "66" OR "77" OR "78" OR SPACES)       *> We don't want these levels
                   OR (SI-Name-UC = "FILLER" AND SI-Class NOT = "GRP ") *> Or non-group FILLERs
                       EXIT PERFORM CYCLE
                   END-IF
                   IF ST-Sub < STSIZE
                       ADD 1 TO ST-Sub END-ADD
                   ELSE
                       MOVE 15 TO Exit-Code
                       PERFORM 099-GOBACK *> Fatal Error: 'Symbol Table' is full - Increase STSIZE
                       *> Control will not return
                   END-IF
                   MOVE SI-Prog-ID  TO ST-Prog(ST-Sub)
                   MOVE SI-Level    TO ST-Level(ST-Sub)
                   MOVE SI-Name     TO ST-Name(ST-Sub)
                   MOVE SI-Name-UC  TO ST-Name-UC(ST-Sub)
               END-READ
           END-PERFORM
DEBUG D    PERFORM VARYING I FROM 1 BY 1 UNTIL I > ST-Sub
DEBUG D        CALL "DBGCOL" USING XREF-Sw "XREF" "Symbol Table: " ST-Prog(I)
DEBUG D                                                         ST-Level(I)
DEBUG D                                                         ST-Name(I)
DEBUG D                                                         ST-Name-UC(I)
DEBUG D        END-CALL
DEBUD D    END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       490-Propagate-Update SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "490-Propagate-Update" END-CALL
      *>************************************************************************
      *> UPDATES to data-items that are part of a group item will propagate   **
      *> update cross-references upward to the top of the group hierarchy     **
      *> (the 01-level data item that roots the tree.  Similarly, update      **
      *> cross-references will also propagate DOWNWARD through the subtree    **
      *> "rooted" by the originally-updated item.  This propogation is per-   **
      *> formed by this routine.                                              **
      *>                                                                      **
      *> Before PERFORMing this routine, "Search-Name" must be populated with **
      *> the UPPERCASE data item name to be located in the symbol table and   **
      *> "Search-Line" must be populated with the source line number to ap-   **
      *> pear in the generated XREFTest entries.                              **
      *>************************************************************************
      *> First, we need to see if the data item that just had an UPDATE       **
      *> cross-reference entry released to the SORT is part of  group item.   **
      *> If we find it, that item will be referred to as the TARGET ITEM.     **
      *>************************************************************************
DEBUG D    CALL "DBGKWV" USING XREF-Sw "XREF" "(490) Prog-ID" Prog-ID
DEBUG D                                        "Search-Name" Search-Name
DEBUG D    END-CALL
           SET ST-Idx TO 1
           SEARCH ST-Entry VARYING ST-Idx
           AT END
DEBUG D        CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
               EXIT SECTION                        *> If not part of a group, we're all done here
           WHEN ST-Name-UC(ST-Idx) = Search-Name
            AND ST-Prog(ST-Idx)    = Prog-ID
               SET ST-Sub TO ST-Idx
               MOVE ST-Sub TO Save-490-Idx         *> Save a pointer to the TARGET ITEM
           END-SEARCH
      *>************************************************************************
      *> Found it!  Now work backwards from the TARGET ITEM, looking for an   **
      *> entry with a level number STRICTLY LESS THAN that of the TARGET ITEM.**
      *> That item gets released to the SORT as an UPDATE xref entry, and     **
      *> also becomes the new TARGET ITEM.  This continues until the TARGET   **
      *> ITEM has a level number of 01.                                       **
      *>************************************************************************
           PERFORM WITH TEST BEFORE UNTIL ST-Level(ST-Sub) = "01"
               SUBTRACT 1 FROM ST-Sub END-SUBTRACT
               IF ST-Level(ST-Sub) < ST-Level(ST-Idx)          *> Did we "bump up" a level?
                   MOVE SPACES              TO Sort-Work-Rec    *> Yup...release an "update" for that item
                   MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID      *>
                   MOVE ST-Name(ST-Sub)     TO SWR-Name
                   MOVE ST-Name-UC(ST-Sub)  TO SWR-Name-UC
                   MOVE CT-Line             TO SWR-Line-Num
                   MOVE UPD                 TO SWR-Line-Flag
DEBUG D            CALL "DBGCOL" USING XREF-Sw "XREF" "Released (490a):    "
DEBUG D                                4SP SWR-Prog-ID SWR-Line SWR-Name
DEBUG D            END-CALL
                   RELEASE Sort-Work-Rec
                   SET ST-Idx TO ST-Sub                       *> This is now the new TARGET ITEM
               END-IF
           END-PERFORM
      *>************************************************************************
      *> Now we need to proceed forward through the subtree rooted by the ori-**
      *> ginal TARGET ITEM.  Each item we find with a level number STRICTLY   **
      *> GREATER THAN that of the original TARGET ITEM gets released to the   **
      *> SORT as an UPDATE.  We keep moving forward until we find a blank     **
      *> entry in the symbol table (end of table) or we find an entry with a  **
      *> level number LESS THAN OR EQUAL TO that of the original TARGET ITEM. **
      *> This part of the job does not redefine the TARGET ITEM as it runs.   **
      *>************************************************************************
           SET ST-Idx TO Save-490-Idx                         *> Reposition back to the original TARGET ITEM
           ADD 1 TO Save-490-Idx GIVING ST-Sub END-ADD        *> And start processing with the entry AFTER that
           PERFORM UNTIL ST-Level(ST-Sub) <= ST-Level(ST-Idx) *> A blank next level # IS < a two-digit #
               MOVE SPACES              TO Sort-Work-Rec       *> Release an "update" for that item
               MOVE UPPER-CASE(Prog-ID) TO SWR-Prog-ID
               MOVE ST-Name(ST-Sub)     TO SWR-Name
               MOVE ST-Name-UC(ST-Sub)  TO SWR-Name-UC
               MOVE CT-Line             TO SWR-Line-Num
               MOVE UPD                 TO SWR-Line-Flag
DEBUG D        CALL "DBGCOL" USING XREF-Sw "XREF" "Released (490b):    "
DEBUG D                            4SP SWR-Prog-ID SWR-Line SWR-Name
DEBUG D        END-CALL
               RELEASE Sort-Work-Rec
               ADD 1 TO ST-Sub END-ADD
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .

       500-Produce-Xref-Listing SECTION.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "500-Produce-Xref-Listing" END-CALL
      *>************************************************************************
      *> Produce the cross-reference listing.  This is the OUTPUT PROCEDURE   **
      *> of the SORT.                                                         **
      *>****************************************************************************************************************
      *> The following is a sample of the landscape (135-character) version of the Cross-Reference report             **
      *>****************************************************************************************************************
      *>
      *>                                                                                                  ...       1
      *>          1         2         3         4         5         6         7         8         9       ...       3
      *> 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567...89012345
      *> -------------------------------------------------------------------------------------------------...-----------
      *> GCic 2.0 (2022/06/11 08:52) - GnuCOBOL 3.2.1 23DEC2020        Cross Reference Listing            ...22/07/30  ^
      *> C:/Users/Gary/Documents/Programs/GCic/XREFTest.cbl                                               ...TESTXref  |
      *>                                                                                                  ...          |
      *> User-Defined Name; '^'=Defined, '*'=Updated, ' '=Referenced     Locn Bytes Type L# Description   ...          |
      *> =============================================================== ==== ===== ==== == ==============...========  |
      *>                                                                                                  ...          |
      *> xxxxxxxxxxx.................................................... WORK 00150 Alph 01 X(150), REDEFI...          |
      *>                                                                                                  ...          |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>                                                                                                  ...          |
      *> xxxxxxxxxxxxxxxxx.............................................. WORK 00150 Grp  01 REDEFINES zzzz...          |
      *>                                                                                                  ...          |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>                                                                                                  ...          |
      *> xxxxxxx........................................................ LINK 00004 Num  05 9(8) COMP     ...       Page
      *>                                                                                                  ...          |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x #... ######x  |
      *>                                                                                                  ...          |
      *> =================================================================================================...========  |
      *> GCic for Windows/MinGW Copyright (C) 2009-2022, Gary L. Cutler, GPL                              ...Page:  1  v
      *> -------------------------------------------------------------------------------------------------...-----------
      *>
      *>
      *>****************************************************************************************************************
      *> The following is a sample of the portrait (96-character) version of the Cross-Reference report               **
      *>****************************************************************************************************************
      *>
      *>          1         2         3         4         5         6         7         8         9
      *> 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
      *> ---------------------------------------------------------------------------------------------------
      *> GCic 2.0 (2022/06/11 08:52) - GnuCOBOL 3.2.1 23DEC2020        Cross Reference Listing 2022/07/30  ^
      *> C:/Users/Gary/Documents/Programs/GCic/XREFTest.cbl                                      TESTXref  |
      *> User-Defined Name; '^'=Defn, '*'=Upd, ' '=Ref Locn Bytes Description                              |
      *> ============================================= ==== ===== =======================================  |
      *>                                                                                                   |
      *> xxxxxxxxxxx.................................. WORK 00150 X(150), REDEFINES Error-Messages         |
      *>                                                                                                   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>                                                                                                   |
      *> xxxxxxxxxxxxxxxxx............................ WORK 00150 REDEFINES Error-Messages              Page
      *>                                                                                                   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>                                                                                                   |
      *> xxxxxxx...................................... LINK 00004 9(8) COMP                                |
      *>                                                                                                   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>         ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x ######x   |
      *>                                                                                                   |
      *> ================================================================================================  |
      *> GCic for Windows/MinGW Copyright (C) 2009-2022, Gary L. Cutler, GPL                     Page:  1  v
      *> ---------------------------------------------------------------------------------------------------
      *> 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
      *>          1         2         3         4         5         6         7         8         9
      *>
           MOVE 0      TO RI-Xref-No
                          RI-Lines-Left
           MOVE SPACES TO RI-Refs
                          RI-Last-Prog-ID
                          RI-Last-Xref-Name
                          RI-Last-Xref-Name-UC
           MOVE "Cross-Reference Listing" TO RI-Title
           PERFORM 010-Set-Report-Characteristics
           PERFORM UNTIL EXIT
               RETURN Sort-Work-File
               AT END
                   PERFORM 021-Generate-Detail-Xref
                   PERFORM 015-Generate-Blank-Line UNTIL RI-Lines-Left = 0
                   EXIT PERFORM
               NOT AT END
DEBUG D            CALL "DBGDUMP" USING XREF-Sw "XREF" "SORT Record" Sort-Work-Rec END-CALL
                   MOVE TRIM(SWR-Prog-ID) TO RI-Prog-ID
                                             RI-Display-Prog-ID
                   CALL "C$JUSTIFY" USING RI-Display-Prog-ID, "R" END-CALL
                   MOVE SWR-Name          TO RI-XRef-Name
                   MOVE SWR-Name-UC       TO RI-XRef-Name-UC
DEBUG D            CALL "DBGKWV" USING XREF-Sw "XREF" "RI-Prog-ID"      RI-Prog-ID
DEBUG D                                               "RI-Last-Prog-ID" RI-Last-Prog-ID
DEBUG D            END-CALL
                   IF RI-Prog-ID NOT = RI-Last-Prog-ID
                       PERFORM 021-Generate-Detail-Xref
                       PERFORM 015-Generate-Blank-Line UNTIL RI-Lines-Left = 0
                       MOVE RI-Prog-ID TO RI-Last-Prog-ID
                       MOVE 0      TO ST-Sub
                   END-IF
DEBUG D            CALL "DBGKWV" USING XREF-Sw "XREF" "RI-XRef-Name-UC"      RI-XRef-Name-UC
DEBUG D                                               "RI-Last-Xref-Name-UC" RI-Last-Xref-Name-UC
DEBUG D            END-CALL
                   IF RI-XRef-Name-UC NOT = RI-Last-Xref-Name-UC
                       PERFORM 021-Generate-Detail-Xref
                       MOVE RI-XRef-Name    TO RI-Last-Xref-Name
                       MOVE RI-XRef-Name-UC TO RI-Last-Xref-Name-UC
                   END-IF
                   IF SWR-Line-Num = 00000      *> Symbol table record
                       MOVE SWR-Section TO RI-Symbol-Table-Section
                       MOVE SWR-Level   TO RI-Symbol-Table-Level
                       MOVE SWR-Class   TO RI-Symbol-Table-Class
                       MOVE SWR-Size    TO RI-Symbol-Table-Size
                       MOVE SWR-Desc    TO RI-Symbol-Table-Desc
                   ELSE                         *> Regular xref record
                       IF RI-Xref-No < 8800
                           ADD 1 TO RI-Xref-No END-ADD
                           MOVE SWR-Line-Num  TO RI-Ref-Seq-No(RI-Xref-No)
                           MOVE SWR-Line-Flag TO RI-Ref-Type(RI-Xref-No)
                       END-IF
                   END-IF
               END-RETURN
           END-PERFORM
DEBUG D    CALL "DBGEXIT" USING TRACE-Sw "TRACE" END-CALL
           .
       END PROGRAM LISTER.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. LOADER.
      *>************************************************************************
      *> This subroutine is used to launch the appropriate application for a  **
      *> data file, and have that app load the file.  For example, if CALLed  **
      *> on behalf of file "xyz.txt", it will submit one of the following     **
      *> commands to the OS via "SYSTEM":                                     **
      *>                                                                      **
      *>     Windows/MinGW/Cygwin:  START xyz.txt                             **
      *>     MacOS:                 open -t xyz.txt                           **
      *>     UNIX/Linux:            xdg-open xyz.txt                          **
      *>                                                                      **
      *> Linkage:                                                             **
      *>                                                                      **
      *>     CALL "LOADER" USING filename                                     **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Cmd.
           05                          OCCURS CMDMAXSIZE PIC X(1).

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       LINKAGE SECTION.
       01  File-Name                   PIC X ANY LENGTH.

       01  GCInfo-Arg.                                   *> Arguments to GCINFO subroutine
           05 GA-Version               PIC X(20).          *> i.e. "3.1.2.0"
                                                           *>       | | | |
                                                           *>       | | | +-- Update minor #
                                                           *>       | | +---- Update major #
                                                           *>       | +------ Release #
                                                           *>       +-------- Version #
           05 GA-Version-No-X.
              10 GA-Version-No         PIC 9(8).           *> Numeric Version #
           05 GA-Release-No-X.
              10 GA-Release-No         PIC 9(8).           *> Numeric Release #
           05 GA-Update-Major-No-X.
              10 GA-Update-Major-No    PIC 9(8).           *> Numeric Update Major #
           05 GA-Update-Minor-No-X.
              10 GA-Update-Minor-No    PIC 9(8).           *> Numeric Update Minor #
           05 GA-Release-Date          PIC X(9).           *> GnuCOBOL Release Date (ddMMMyyyy)
           05 GA-Build-Date            PIC X(9).           *> GnuCOBOL Build Date (ddMMMyyyy)
           05 GA-Build-Env             PIC X(30).          *> "x86_64-pc-linux-gnu", "i686-pc-mingw32", ...
           05 GA-OS-Type               PIC 9(1).           *> Deduced from GA-Build-Env
              88 GA-OS-Unknown         VALUE 0.
              88 GA-OS-Windows         VALUE 1.
              88 GA-OS-Cygwin          VALUE 2.
              88 GA-OS-SplatNIX        VALUE 3.
              88 GA-OS-MacOS           VALUE 4.
              88 GA-OS-MinGW           VALUE 5.

       PROCEDURE DIVISION USING File-Name
                                GCInfo-Arg
                                .
       000-Main.
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "LOADER"   END-CALL
DEBUG D    CALL "DBGENTER" USING TRACE-Sw "TRACE" "000-Main" END-CALL
           EVALUATE GA-OS-Type
      *>               ----------------------------------------------------
           WHEN 1      MOVE CONCATENATE("start ",TRIM(File-Name))    TO Cmd
      *>               ----------------------------------------------------
           WHEN 2      MOVE CONCATENATE("cygstart ",TRIM(File-Name)) TO Cmd
      *>               ----------------------------------------------------
           WHEN 3      MOVE CONCATENATE("xdg-open ",TRIM(File-Name)) TO Cmd
      *>               ----------------------------------------------------
           WHEN 4      MOVE CONCATENATE("open -t ",TRIM(File-Name))  TO Cmd
      *>               ----------------------------------------------------
           WHEN 5      MOVE CONCATENATE("start ",TRIM(File-Name))    TO Cmd
      *>               ----------------------------------------------------
           WHEN OTHER
DEBUG D                CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
                       GOBACK
      *>               ----------------------------------------------------
           END-EVALUATE
           CALL "SYSTEM" USING TRIM(Cmd) END-CALL
DEBUG D    CALL "DBGGOBACK" USING TRACE-Sw "TRACE" END-CALL
           GOBACK
           .
       END PROGRAM LOADER.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGCOL.
      *>************************************************************************
      *> This subroutine implements any debugging switch that logs            **
      *> UP TO 6 columns of text                                              **
      *>                                                                      **
      *> Linkage:                                                             **
      *>                                                                      **
      *> CALL "DBGCOL" USING switch "Tag" "Pad" C1 C2 C3 C4 C5 C6             **
      *>                                                                      **
      *> Arguments C2 through C6 are optional.                                **
      *>                                                                      **
      *> The output produced on SYSERR will look like this:                   **
      *>                                                                      **
      *> tag............PAD|C1|C2|C3|C4|C5|C6                                 **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  Header-Item                 PIC X(15).          *> 1st 15 chars of line ("tag............")
       LINKAGE SECTION.
       01  Switch-Arg                  PIC 9(1).           *> Debug switch that controls display/no-display
       01  Tag-Arg                     PIC X ANY LENGTH.   *> "tag" - usually name of debug switch
       01  Pad-Arg                     PIC X ANY LENGTH.   *> Pad of spaces between header and 1st item
       01  C1-Arg                      PIC X ANY LENGTH.   *> One to six items whose contents should be displayed
       01  C2-Arg                      PIC X ANY LENGTH.
       01  C3-Arg                      PIC X ANY LENGTH.
       01  C4-Arg                      PIC X ANY LENGTH.
       01  C5-Arg                      PIC X ANY LENGTH.
       01  C6-Arg                      PIC X ANY LENGTH.
       PROCEDURE DIVISION USING Switch-Arg
                                Tag-Arg
                                Pad-Arg
                                C1-Arg
                                OPTIONAL C2-Arg
                                OPTIONAL C3-Arg
                                OPTIONAL C4-Arg
                                OPTIONAL C5-Arg
                                OPTIONAL C6-Arg.
       000-Main SECTION.
           IF Switch-Arg = 1
               MOVE ALL "." TO Header-Item
               MOVE Tag-Arg TO Header-Item(1:LENGTH(Tag-Arg))
               EVALUATE NUMBER-OF-CALL-PARAMETERS
      *>               ------------------------------------------
               WHEN 4  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               WHEN 5  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                                                   "|" C2-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               WHEN 6  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                                                   "|" C2-Arg
                                                   "|" C3-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               WHEN 7  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                                                   "|" C2-Arg
                                                   "|" C3-Arg
                                                   "|" C4-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               WHEN 8  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                                                   "|" C2-Arg
                                                   "|" C3-Arg
                                                   "|" C4-Arg
                                                   "|" C5-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               WHEN 9  DISPLAY Header-Item Pad-Arg "|" C1-Arg
                                                   "|" C2-Arg
                                                   "|" C3-Arg
                                                   "|" C4-Arg
                                                   "|" C5-Arg
                                                   "|" C6-Arg
                               UPON SYSERR
                       END-DISPLAY
      *>               ------------------------------------------
               END-EVALUATE
           END-IF
           GOBACK
           .
       END PROGRAM DBGCOL.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGDUMP.
      *>************************************************************************
      *> This subroutine generates a hex/char dump of a data item             **
      *>                                                                      **
      *> CALL "DBGDUMP"  USING switch         Switch data name                **
      *>                       "switch"       Switch name                     **
      *>                       "title"        Title                           **
      *>                       data-item      Data item to dump               **
      *> END-CALL                                                             **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       78  NDF                         VALUE X"A7".        *> End of File char for parser (Section Sign)

       78  NDI                         VALUE X"D8".        *> End of Image char for parser (Slashed Capital O)

       78  NDS                         VALUE X"95".        *> End of Sentence char for parser (Bullet)

       01  Buffer-Len                  USAGE BINARY-LONG UNSIGNED.

       01  Byte-Chr.
           05 Byte-Num                 USAGE BINARY-CHAR UNSIGNED.

       01  Hex-Buffer.
           05 HB-Byte                  OCCURS 32 TIMES PIC X(2).
       01  Hex-BufferR                 REDEFINES Hex-Buffer.
           05 HB-Chunk                 OCCURS 4 TIMES PIC X(16).

       01  Hex-FILLER.
           05 PIC X(32) VALUE "000102030405060708090A0B0C0D0E0F".
           05 PIC X(32) VALUE "101112131415161718191A1B1C1D1E1F".
           05 PIC X(32) VALUE "202122232425262728292A2B2C2D2E2F".
           05 PIC X(32) VALUE "303132333435363738393A3B3C3D3E3F".
           05 PIC X(32) VALUE "404142434445464748494A4B4C4D4E4F".
           05 PIC X(32) VALUE "505152535455565758595A5B5C5D5E5F".
           05 PIC X(32) VALUE "606162636465666768696A6B6C6D6E6F".
           05 PIC X(32) VALUE "707172737475767778797A7B7C7D7E7F".
           05 PIC X(32) VALUE "808182838485868788898A8B8C8D8E8F".
           05 PIC X(32) VALUE "909192939495969798999A9B9C9D9E9F".
           05 PIC X(32) VALUE "A0A1A2A3A4A5A6A7A8A9AAABACADAEAF".
           05 PIC X(32) VALUE "B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF".
           05 PIC X(32) VALUE "C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF".
           05 PIC X(32) VALUE "D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF".
           05 PIC X(32) VALUE "E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF".
           05 PIC X(32) VALUE "F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF".
       01  Hex-Digits REDEFINES Hex-FILLER.
           05 Hex-Byte                 OCCURS 256 TIMES PIC X(2).

       01  I                           USAGE BINARY-LONG UNSIGNED.

       01  J                           USAGE BINARY-CHAR UNSIGNED.

       01  K                           USAGE BINARY-CHAR UNSIGNED.

       01  Output-Buffer.
           05 OB-Byte                  PIC Z(5)9.
           05 OB-Skip                  PIC X(2).
           05 OB-Chunk                 OCCURS 4 TIMES PIC X(17).
           05                          PIC X(1).
           05 OB-Chars                 PIC X(32).

       01  Output-Header.
           05 PIC X(8)  VALUE "<Byte>".
           05 PIC X(69) VALUE "<-------------------------- Hexadecimal -------------------------->".
           05 PIC X(32) VALUE "<--------- Character ---------->".

       01  Prefix                      PIC X(15).

       01  Prev-Hex-Buffer             PIC X(64).

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       01  Skip-Flag                   PIC X(2).

       LINKAGE SECTION.

       01  L-Buffer                    PIC X ANY LENGTH.

       01  L-Switch                    PIC 9(1).

       01  L-Switch-Name               PIC X ANY LENGTH.

       01  L-Title                     PIC X ANY LENGTH.

       PROCEDURE DIVISION USING L-Switch,
                                L-Switch-Name,
                                L-Title,
                                L-Buffer.
       000-Main.
           IF L-Switch NOT = 1
               GOBACK
           END-IF
           MOVE ALL "."          TO Prefix
           MOVE L-Switch-Name    TO Prefix(1:LENGTH(L-Switch-Name))
           MOVE LENGTH(L-Buffer) TO Buffer-Len
           DISPLAY Prefix TRIM(L-Title) ":" UPON SYSERR END-DISPLAY
           DISPLAY Prefix Output-Header UPON SYSERR END-DISPLAY
           MOVE SPACES TO Hex-Buffer
                          Output-Buffer
                          Prev-Hex-Buffer
                          Skip-Flag
           MOVE 0 TO J
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > Buffer-Len
               IF J = 0
                   MOVE I TO OB-Byte
               END-IF
               MOVE L-Buffer(I:) TO Byte-Chr
               ADD 1 TO J END-ADD
               MOVE Hex-Byte(Byte-Num + 1) TO HB-Byte(J)
               EVALUATE TRUE
      *>                           -----------------------------
               WHEN Byte-Num < 32  MOVE "."      TO OB-Chars(J:1)
      *>                           -----------------------------
               WHEN Byte-Num < 128 MOVE Byte-Chr TO OB-Chars(J:1)
      *>                           -----------------------------
               WHEN Byte-Chr = NDF MOVE NDF      TO OB-Chars(J:1) *> End-of-file indicater in LISTER (§)
      *>                           -----------------------------
               WHEN Byte-Chr = NDI MOVE NDI      TO OB-Chars(J:1) *> End-of-image indicator in LISTER (slashed O)
      *>                           -----------------------------
               WHEN Byte-Chr = NDS MOVE NDS      TO OB-Chars(J:1) *> End-of-sentence indicator in LISTER (bullet)
      *>                           -----------------------------
               WHEN OTHER          MOVE "."      TO OB-Chars(J:1)
      *>                           -----------------------------
               END-EVALUATE
               IF J = 32
                   PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
                       MOVE HB-Chunk(K) TO OB-Chunk(K)
                   END-PERFORM
                   IF Hex-Buffer = Prev-Hex-Buffer
                       MOVE "*" TO Skip-Flag
                   ELSE
                       MOVE Hex-Buffer TO Prev-Hex-Buffer
                       MOVE Skip-Flag  TO OB-Skip
                       DISPLAY Prefix Output-Buffer UPON SYSERR END-DISPLAY
                       MOVE SPACES TO Skip-Flag
                   END-IF
                   MOVE SPACES TO Hex-Buffer
                                  Output-Buffer
                   MOVE 0 TO J
               END-IF
           END-PERFORM
           IF J > 0
               PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
                   MOVE HB-Chunk(K) TO OB-Chunk(K)
               END-PERFORM
               MOVE Skip-Flag TO OB-Skip
               DISPLAY Prefix Output-Buffer UPON SYSERR END-DISPLAY
           END-IF
           GOBACK
           .
       END PROGRAM DBGDUMP.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGENTER.
      *>************************************************************************
      *> This subroutine announces that control is entering a new procedure.  **
      *>                                                                      **
      *> CALL "DBGENTER" USING TRACE-Sw, "TRACE" "procedure-name" END-CALL    **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  Prefix                      PIC X(15).

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       LINKAGE SECTION.
       01  L-Procedure-Name            PIC X ANY LENGTH.

       01  L-Switch                    PIC 9(1).

       01  L-Switch-Name               PIC X ANY LENGTH.

       PROCEDURE DIVISION USING L-Switch,
                                L-Switch-Name,
                                L-Procedure-Name.
       000-Main.
           IF L-Switch NOT = 1
               GOBACK
           END-IF
           MOVE ALL "." TO Prefix
           MOVE L-Switch-Name TO Prefix(1:LENGTH(L-Switch-Name))
           IF L-Procedure-Name(1:1) IS ALPHABETIC
               MOVE L-Procedure-Name TO PS-Curr-Module
               DISPLAY Prefix "Entering Module " PS-Curr-Module UPON SYSERR END-DISPLAY
           ELSE
               ADD 1 TO PS-Qty END-ADD
               MOVE L-Procedure-Name TO PS-Proc(PS-Qty)
               MOVE PS-Curr-Module   TO PS-Module(PS-Qty)
               DISPLAY Prefix "Entering: " TRIM(L-Procedure-Name) " Of " PS-Curr-Module UPON SYSERR END-DISPLAY
           END-IF
DEBUG D    CALL "DBGDUMP" USING INTERNAL-Sw "INTERNAL" "Procedure-Stack" Procedure-Stack END-CALL
           GOBACK
           .
       END PROGRAM DBGENTER.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGEXIT.
      *>************************************************************************
      *> This subroutine announces that control is leaving a procedure.       **
      *>                                                                      **
      *> CALL "DBGEXIT" USING TRACE-Sw, "TRACE" END-CALL                      **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  I                           USAGE BINARY-CHAR UNSIGNED.

       01  Prefix                      PIC X(15).

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       LINKAGE SECTION.

       01  L-Switch                    PIC 9(1).

       01  L-Switch-Name               PIC X ANY LENGTH.
       PROCEDURE DIVISION USING L-Switch,
                                L-Switch-Name.
       000-Main.
           IF L-Switch NOT = 1
               GOBACK
           END-IF
           MOVE ALL "." TO Prefix
           MOVE L-Switch-Name TO Prefix(1:LENGTH(L-Switch-Name))
           COMPUTE I = PS-Qty - 1 END-COMPUTE
           DISPLAY Prefix "Exiting: " TRIM(PS-Proc(PS-Qty)) " Of " TRIM(PS-Module(PS-Qty))
                   ", Returning To: " TRIM(PS-Proc(I)) " Of " PS-Module(I)
                   UPON SYSERR
           END-DISPLAY
           MOVE LOW-VALUES TO PS-Entry(PS-Qty)
           MOVE I TO PS-Qty
DEBUG D    CALL "DBGDUMP" USING INTERNAL-Sw "INTERNAL" "Procedure-Stack" Procedure-Stack END-CALL
           GOBACK
           .
       END PROGRAM DBGEXIT.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGGOBACK.
      *>************************************************************************
      *> This subroutine announces that control is leaving a subroutine.      **
      *>                                                                      **
      *> CALL "DBGGOBACK" USING TRACE-Sw, "TRACE" END-CALL                    **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  I                           USAGE BINARY-CHAR UNSIGNED.

       01  Prefix                      PIC X(15).

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       LINKAGE SECTION.

       01  L-Switch                    PIC 9(1).

       01  L-Switch-Name               PIC X ANY LENGTH.

       PROCEDURE DIVISION USING L-Switch,
                                L-Switch-Name.
       000-Main.
           IF L-Switch NOT = 1
               GOBACK
           END-IF
           MOVE ALL "." TO Prefix
           MOVE L-Switch-Name TO Prefix(1:LENGTH(L-Switch-Name))
           MOVE PS-Qty TO I
           SUBTRACT 1 FROM PS-Qty END-SUBTRACT
           PERFORM UNTIL (PS-Module(PS-Qty) NOT = PS-Curr-Module) OR (PS-Qty = 0)
               DISPLAY Prefix "Canceling Return To " TRIM(PS-Proc(PS-Qty)) " Of " TRIM(PS-Module(PS-Qty))
                   UPON SYSERR
               END-DISPLAY
               MOVE LOW-VALUES TO PS-Entry(PS-Qty)
               SUBTRACT 1 FROM PS-Qty END-SUBTRACT
           END-PERFORM
           DISPLAY Prefix "Exiting "         TRIM(PS-Module(I))    " From " TRIM(PS-Proc(I))
                          ", Returning To: " TRIM(PS-Proc(PS-Qty)) " Of "   TRIM(PS-Module(PS-Qty))
                          UPON SYSERR
           END-DISPLAY
           MOVE PS-Module(PS-Qty) TO PS-Curr-Module
           MOVE LOW-VALUES TO PS-Entry(I)
DEBUG D    CALL "DBGDUMP" USING INTERNAL-Sw "INTERNAL" "Procedure-Stack" Procedure-Stack END-CALL
           GOBACK
           .
       END PROGRAM DBGGOBACK.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGKWV.
      *>****************************************************************
      *> This subroutine implements any debugging switch that logs    **
      *> "keyword=value" items (like INFO), UP TO THREE               **
      *>                                                              **
      *> Linkage:                                                     **
      *>                                                              **
      *>     CALL "DBGKWV" USING switch "Tag"                         **
      *>                         "kw1" v1 [["kw2" v2] "kw3" v3]       **
      *>                                                              **
      *> The output produced on SYSERR will look like this:           **
      *>                                                              **
      *>     tag............kw1 = v1 kw2 = v2 kw3 = v3                **
      *>                                                              **
      *> Note that the "value" item MUST be USAGE DISPLAY.  Only the  **
      *> first 20 characters of the "kw" items will be displayed.     **
      *>****************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  Header-Item                 PIC X(15).          *> 1st 15 chars of line ("tag............")
       01  Keyword1                    PIC X(20).          *> kw1 name
       01  Keyword2                    PIC X(20).          *> kw2 name
       01  Keyword3                    PIC X(20).          *> kw3 name
       LINKAGE SECTION.
       01  Switch-Arg                  PIC 9(1).           *> Debug switch that controls display/no-display
       01  Tag-Arg                     PIC X ANY LENGTH.   *> "tag" - usually name of debug switch
       01  KW1-Arg                     PIC X ANY LENGTH.   *> Keyword string
       01  Value1-Item                 PIC X ANY LENGTH.   *> Value
       01  KW2-Arg                     PIC X ANY LENGTH.   *> Keyword string
       01  Value2-Item                 PIC X ANY LENGTH.   *> Value
       01  KW3-Arg                     PIC X ANY LENGTH.   *> Keyword string
       01  Value3-Item                 PIC X ANY LENGTH.   *> Value
       PROCEDURE DIVISION USING Switch-Arg
                                Tag-Arg
                                KW1-Arg
                                Value1-Item
                                OPTIONAL KW2-Arg
                                OPTIONAL Value2-Item
                                OPTIONAL KW3-Arg
                                OPTIONAL Value3-Item.
       000-Main SECTION.
           IF Switch-Arg = 1
               MOVE ALL "." TO Header-Item
               MOVE Tag-Arg TO Header-Item(1:LENGTH(Tag-Arg))
               EVALUATE NUMBER-OF-CALL-PARAMETERS
      *>               ----------------------------------------
               WHEN 4  MOVE KW1-Arg  TO Keyword1
                       DISPLAY Header-Item
                               TRIM(Keyword1) " = """ TRIM(Value1-Item,TRAILING) """ "
                               UPON SYSERR
                       END-DISPLAY
      *>               ----------------------------------------
               WHEN 6  MOVE KW1-Arg  TO Keyword1
                       MOVE KW2-Arg  TO Keyword2
                       DISPLAY Header-Item
                               TRIM(Keyword1) " = """ TRIM(Value1-Item,TRAILING) """ "
                               TRIM(Keyword2) " = """ TRIM(Value2-Item,TRAILING) """ "
                               UPON SYSERR
                       END-DISPLAY
      *>               ----------------------------------------
               WHEN 8  MOVE KW1-Arg  TO Keyword1
                       MOVE KW2-Arg  TO Keyword2
                       MOVE KW3-Arg  TO Keyword3
                       DISPLAY Header-Item
                               TRIM(Keyword1) " = """ TRIM(Value1-Item,TRAILING) """ "
                               TRIM(Keyword2) " = """ TRIM(Value2-Item,TRAILING) """ "
                               TRIM(Keyword3) " = """ TRIM(Value3-Item,TRAILING) """ "
                               UPON SYSERR
                       END-DISPLAY
      *>               ----------------------------------------
               END-EVALUATE
           END-IF
           GOBACK
           .
       END PROGRAM DBGKWV.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGSTOP.
      *>************************************************************************
      *> This subroutine announces that the program is halting.               **
      *>                                                                      **
      *> CALL "DBGSTOP" USING TRACE-Sw, "TRACE" END-CALL                      **
      *>                                                                      **
      *>************************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Debug-Switches EXTERNAL.
           05 INFO-Sw                  PIC 9(1).
           05 INTERNAL-Sw              PIC 9(1).
           05 SOURCE-Sw                PIC 9(1).
           05 SPLIT-Sw                 PIC 9(1).
           05 SUB-Sw                   PIC 9(1).
           05 TRACE-Sw                 PIC 9(1).
           05 USER-Sw                  PIC 9(1).
           05 X-OPTIONS.
              10 XFAST-Sw              PIC 9(1).
              10 XFSM-Sw               PIC 9(1).
              10 XPARSE-Sw             PIC 9(1).
              10 XRAFT-Sw              PIC 9(1).
              10 XREAD-Sw              PIC 9(1).
              10 XREF-Sw               PIC 9(1).
              10 XTOKEN-Sw             PIC 9(1).
              10 XWORDS-Sw             PIC 9(1).

       01  I                           USAGE BINARY-CHAR UNSIGNED.

       01  Prefix                      PIC X(15).

       01  Procedure-Stack EXTERNAL.
           05 PS-Qty                   USAGE BINARY-CHAR UNSIGNED.
           05 PS-Curr-Module           PIC X(15).
           05 PS-Entry                 OCCURS PSTACKSIZE TIMES.
              10 PS-Proc.
                 15 PS-Proc-1          PIC X(1).
                 15                    PIC X(62).
              10 PS-Module             PIC X(15).

       LINKAGE SECTION.

       01  L-Switch                    PIC 9(1).

       01  L-Switch-Name               PIC X ANY LENGTH.

       PROCEDURE DIVISION USING L-Switch,
                                L-Switch-Name.
       000-Main.
           IF L-Switch NOT = 1
               GOBACK
           END-IF
           MOVE ALL "." TO Prefix
           MOVE L-Switch-Name TO Prefix(1:LENGTH(L-Switch-Name))
           MOVE PS-Qty TO I
           SUBTRACT 1 FROM PS-Qty END-SUBTRACT
           PERFORM UNTIL PS-Qty = 0
               DISPLAY Prefix "Canceling Return To " TRIM(PS-Proc(PS-Qty)) " Of " TRIM(PS-Module(PS-Qty))
                   UPON SYSERR
               END-DISPLAY
               MOVE LOW-VALUES TO PS-Entry(PS-Qty)
               SUBTRACT 1 FROM PS-Qty END-SUBTRACT
           END-PERFORM
           DISPLAY Prefix "Halting Program In: " TRIM(PS-Proc(I)) " Of " TRIM(PS-Module(I))
                          UPON SYSERR
           END-DISPLAY
           MOVE LOW-VALUES TO PS-Entry(I)
DEBUG D    CALL "DBGDUMP" USING INTERNAL-Sw "INTERNAL" "Procedure-Stack" Procedure-Stack END-CALL
           GOBACK
           .
       END PROGRAM DBGSTOP.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DBGTXT.
      *>****************************************************************
      *> This subroutine implements any debugging switch that just    **
      *> logs static text (like TRACE)                                **
      *>                                                              **
      *> Linkage:                                                     **
      *>                                                              **
      *> CALL "DBGTXT" USING switch "Tag" "Text-Item"                 **
      *>                                                              **
      *> The output produced on SYSERR will look like this:           **
      *>                                                              **
      *> tag............text-item                                     **
      *>                                                              **
      *>****************************************************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  Header-Item                 PIC X(15).          *> 1st 15 chars of line ("tag............")
       LINKAGE SECTION.
       01  Switch-Arg                  PIC 9(1).           *> Debug switch that controls display/no-display
       01  Tag-Arg                     PIC X ANY LENGTH.   *> "tag" - usually name of debug switch
       01  Text-Item-Arg               PIC X ANY LENGTH.   *> The "Text" to display
       PROCEDURE DIVISION USING Switch-Arg
                                Tag-Arg
                                Text-Item-Arg.
       000-Main SECTION.
           IF Switch-Arg = 1
               MOVE ALL "." TO Header-Item
               MOVE Tag-Arg TO Header-Item(1:LENGTH(Tag-Arg))
               DISPLAY Header-Item Text-Item-Arg UPON SYSERR END-DISPLAY
           END-IF
           GOBACK
           .
       END PROGRAM DBGTXT.

