*> ===============================================================
*> MAIN PROGRAM - demo of range(3, 8)
*> ===============================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. RANGEDEMO.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> Parameters passed to the subprogram
01 WS-START PIC S9(9) COMP VALUE 3.
01 WS-END PIC S9(9) COMP VALUE 8.
01 WS-STEP PIC S9(9) COMP VALUE 1.
*> Result table: WS-COUNT holds the number of valid elements
01 WS-RESULT.
05 WS-COUNT PIC 9(4) COMP VALUE 0.
05 WS-ITEM PIC S9(9) COMP
OCCURS 1 TO 1000 TIMES
DEPENDING ON WS-COUNT.
01 WS-RC PIC S9(4) COMP VALUE 0.
01 WS-I PIC 9(4) COMP.
01 WS-IDX-OUT PIC Z(3)9.
01 WS-VAL-OUT PIC -(9)9.
PROCEDURE DIVISION.
MAIN-PARA.
CALL "RANGEARR" USING WS-START WS-END WS-STEP
WS-RESULT WS-RC
END-CALL
*> Always check the return code
EVALUATE WS-RC
WHEN 0
PERFORM PRINT-ARRAY
WHEN 1
DISPLAY "Error: step must not be zero"
WHEN 2
DISPLAY "Error: range exceeds table capacity (1000)"
WHEN OTHER
DISPLAY "Unknown error: " WS-RC
END-EVALUATE
STOP RUN.
*> Mimics PHP's print_r() output
PRINT-ARRAY.
DISPLAY "Array"
DISPLAY "("
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-COUNT
COMPUTE WS-IDX-OUT = WS-I - 1 *> 0-based like PHP
MOVE WS-ITEM(WS-I) TO WS-VAL-OUT
DISPLAY " [" FUNCTION TRIM(WS-IDX-OUT) "] => "
FUNCTION TRIM(WS-VAL-OUT)
END-PERFORM
DISPLAY ")".
END PROGRAM RANGEDEMO.
*> ===============================================================
*> SUBPROGRAM RANGEARR - fills a table with start..end (inclusive)
*>
*> LS-START : first value
*> LS-END : last value (may be lower than start -> descending)
*> LS-STEP : step size, magnitude only (direction is inferred)
*> LS-RESULT: output table (count + items)
*> LS-RC : 0 = OK, 1 = step is zero, 2 = too many elements
*> ===============================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. RANGEARR.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-MAX-ITEMS PIC 9(4) COMP VALUE 1000.
01 WS-STEP-ABS PIC 9(9) COMP.
01 WS-DIRECTION PIC S9 COMP. *> +1 or -1
01 WS-SPAN PIC 9(9) COMP.
01 WS-N PIC 9(9) COMP. *> number of elements
01 WS-I PIC 9(9) COMP.
LINKAGE SECTION.
01 LS-START PIC S9(9) COMP.
01 LS-END PIC S9(9) COMP.
01 LS-STEP PIC S9(9) COMP.
01 LS-RESULT.
05 LS-COUNT PIC 9(4) COMP.
05 LS-ITEM PIC S9(9) COMP
OCCURS 1 TO 1000 TIMES
DEPENDING ON LS-COUNT.
01 LS-RC PIC S9(4) COMP.
PROCEDURE DIVISION USING LS-START LS-END LS-STEP
LS-RESULT LS-RC.
MAIN-PARA.
MOVE 0 TO LS-RC
MOVE 0 TO LS-COUNT
*> 1. Validate input
IF LS-STEP = 0
MOVE 1 TO LS-RC
GOBACK
END-IF
*> 2. Work out direction and number of elements
MOVE FUNCTION ABS(LS-STEP) TO WS-STEP-ABS
IF LS-END >= LS-START
MOVE 1 TO WS-DIRECTION
COMPUTE WS-SPAN = LS-END - LS-START
ELSE
MOVE -1 TO WS-DIRECTION
COMPUTE WS-SPAN = LS-START - LS-END
END-IF
*> Integer division truncates, so this gives floor(span/step) + 1
COMPUTE WS-N = (WS-SPAN / WS-STEP-ABS) + 1
*> 3. Guard against overflowing the table
IF WS-N > WS-MAX-ITEMS
MOVE 2 TO LS-RC
GOBACK
END-IF
*> 4. Set the logical size FIRST, then fill the table
MOVE WS-N TO LS-COUNT
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-N
COMPUTE LS-ITEM(WS-I) =
LS-START + (WS-DIRECTION * (WS-I - 1) * WS-STEP-ABS)
END-PERFORM
GOBACK.
END PROGRAM RANGEARR.
*> run:
*>
*> Array
*> (
*> [0] => 3
*> [1] => 4
*> [2] => 5
*> [3] => 6
*> [4] => 7
*> [5] => 8
*> )
