>>SOURCE FORMAT IS FREE
*> cobol-rounded-mode-ties.cob - twelve tie and near-tie values stored
*>   into a two-decimal receiver under every ROUNDED MODE, plus plain
*>   ROUNDED and no ROUNDED at all, one row per value
*> Dialect: GnuCOBOL 3.x, free format; ROUNDED MODE is COBOL 2002 syntax.
*>          The lesson shows it compiled once per dialect:
*>          cobc -x cobol-rounded-mode-ties.cob
*>          cobc -x -std=ibm cobol-rounded-mode-ties.cob
*>          cobc -x -std=mf cobol-rounded-mode-ties.cob
*> Status : compiled and run with GnuCOBOL 3.2 on 2026-10-30
*> Inputs : none (the twelve values are VALUE clauses)
*> Outputs: a heading line and twelve result lines on standard output,
*>          then two lines on PROHIBITED. A cell shows "SIZE" when the
*>          statement took its ON SIZE ERROR branch (the receiver is
*>          reset to zero before every statement).
*> Run    : ./cobol-rounded-mode-ties
*>          (Windows: cobol-rounded-mode-ties.exe)

IDENTIFICATION DIVISION.
PROGRAM-ID. ROUNDED-TIES.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-Values-Init.
   05 FILLER         PIC S9V9(4)  VALUE  2.3450.
   05 FILLER         PIC S9V9(4)  VALUE  2.3550.
   05 FILLER         PIC S9V9(4)  VALUE -2.3450.
   05 FILLER         PIC S9V9(4)  VALUE -2.3550.
   05 FILLER         PIC S9V9(4)  VALUE  2.3449.
   05 FILLER         PIC S9V9(4)  VALUE  2.3451.
   05 FILLER         PIC S9V9(4)  VALUE -2.3449.
   05 FILLER         PIC S9V9(4)  VALUE -2.3451.
   05 FILLER         PIC S9V9(4)  VALUE  0.0050.
   05 FILLER         PIC S9V9(4)  VALUE -0.0050.
   05 FILLER         PIC S9V9(4)  VALUE  2.3400.
   05 FILLER         PIC S9V9(4)  VALUE  9.9950.
01 WS-Values REDEFINES WS-Values-Init.
   05 WS-Value       PIC S9V9(4)  OCCURS 12 TIMES.

01 WS-I              PIC 99.
01 WS-Out            PIC S9V99.
01 WS-Edit-In        PIC -9.9999.
01 WS-Edit-Out       PIC -9.99.
01 WS-Cell           PIC X(6).
01 WS-Line           PIC X(120).
01 WS-Ptr            PIC 999.
01 WS-Two-Places     PIC S9V99    VALUE 2.34.

PROCEDURE DIVISION.
MAIN-PARAGRAPH.
    DISPLAY "value    none   ROUND  AWAY   N-AWAY N-EVEN N-TOW  PROHIB "
            "T-GRT  T-LSR  TRUNC"
    PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 12
        MOVE SPACES TO WS-Line
        MOVE 1 TO WS-Ptr
        MOVE WS-Value (WS-I) TO WS-Edit-In
        STRING WS-Edit-In " " DELIMITED BY SIZE
            INTO WS-Line WITH POINTER WS-Ptr
        END-STRING

        MOVE 0 TO WS-Out
        COMPUTE WS-Out = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS AWAY-FROM-ZERO = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS NEAREST-AWAY-FROM-ZERO
                = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS NEAREST-EVEN = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS NEAREST-TOWARD-ZERO
                = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS PROHIBITED = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS TOWARD-GREATER = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS TOWARD-LESSER = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        MOVE 0 TO WS-Out
        COMPUTE WS-Out ROUNDED MODE IS TRUNCATION = WS-Value (WS-I)
            ON SIZE ERROR PERFORM SIZE-CELL
            NOT ON SIZE ERROR PERFORM VALUE-CELL
        END-COMPUTE

        DISPLAY FUNCTION TRIM (WS-Line TRAILING)
    END-PERFORM

*>  PROHIBITED again: the same value from an item with two decimal
*>  places, then 2.3400 with no ON SIZE ERROR phrase at all.
    MOVE 0 TO WS-Out
    COMPUTE WS-Out ROUNDED MODE IS PROHIBITED = WS-Two-Places
        ON SIZE ERROR DISPLAY "PROHIBITED, 2.34 from S9V99    : SIZE"
        NOT ON SIZE ERROR
            MOVE WS-Out TO WS-Edit-Out
            DISPLAY "PROHIBITED, 2.34 from S9V99    : " WS-Edit-Out
    END-COMPUTE
    MOVE 0 TO WS-Out
    COMPUTE WS-Out ROUNDED MODE IS PROHIBITED = WS-Value (11)
    MOVE WS-Out TO WS-Edit-Out
    DISPLAY "PROHIBITED, 2.3400, no clause  : " WS-Edit-Out
    STOP RUN.

VALUE-CELL.
    MOVE WS-Out TO WS-Edit-Out
    MOVE WS-Edit-Out TO WS-Cell
    STRING WS-Cell " " DELIMITED BY SIZE
        INTO WS-Line WITH POINTER WS-Ptr
    END-STRING.

SIZE-CELL.
    MOVE "SIZE" TO WS-Cell
    STRING WS-Cell " " DELIMITED BY SIZE
        INTO WS-Line WITH POINTER WS-Ptr
    END-STRING.