tinycobol/test.code/t20/test20e.cob

202 lines
3.8 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. TEST20e.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* SPECIAL-NAMES.
* DECIMAL-POINT IS PERIOD.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEST-FILE-IN1 ASSIGN TO WS-FILENAME-IN1
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD TEST-FILE-IN1.
* LABEL RECORDS ARE STANDARD.
01 TEST-RECORD-IN1 PIC X(10).
* 01 TEST-RECORD-IN1.
* 05 FILLER PIC X(10).
WORKING-STORAGE SECTION.
01 WS-FILENAME-IN1 PIC X(11) VALUE "TCfile3.txt".
01 WS-IDX PIC 9(3).
01 WS-IDX1 PIC Z(4)9.
01 WS-IDX2 PIC Z(4)9.
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
01 EOF-SW1 PIC X(1) VALUE 'N'.
01 WS-REC-COUNTER-IN1 PIC 9(5) VALUE 0.
* File: TEST-FILE-IN1
01 WS-TABLE1-ENTRIES.
05 WS-TABLE1-ENTRY1 OCCURS 3 TIMES
INDEXED BY IDX2.
07 WS-TABLE1-ENTRY OCCURS 56 TIMES
DESCENDING KEY IS WS-TABLE1-IDX
INDEXED BY IDX1.
10 WS-TABLE1-IDX PIC X(3).
10 WS-TABLE1-DATA PIC X(7).
PROCEDURE DIVISION.
A-000.
PERFORM A-050.
SET IDX2 TO 1.
PERFORM A-075 UNTIL IDX2 > 3
SET IDX2 TO 1.
PERFORM A-085 UNTIL IDX2 > 3
MOVE RETURN-CODE TO WS-RCODE.
DISPLAY "WS-RCODE=" WS-RCODE.
STOP RUN.
A-050.
SET IDX1 TO 1.
SET IDX2 TO 1.
OPEN INPUT TEST-FILE-IN1.
PERFORM A-910.
DISPLAY "TEST-RECORD-IN1 =" TEST-RECORD-IN1 ":".
DISPLAY "WS-TABLE1-ENTRY (1, 1)=" WS-TABLE1-ENTRY (1, 1) ":".
* DISPLAY "WS-TABLE1-ENTRY (10, 1)=" WS-TABLE1-ENTRY (10, 1) ":".
PERFORM A-910 UNTIL EOF-SW1 = 'Y'.
CLOSE TEST-FILE-IN1.
DISPLAY "Records read for file " WS-FILENAME-IN1 " is " WS-REC-COUNTER-IN1.
A-075.
DISPLAY "ENTER A-075".
MOVE 1 TO WS-IDX.
PERFORM A-100.
MOVE 503 TO WS-IDX.
PERFORM A-100.
MOVE 2 TO WS-IDX.
PERFORM A-100.
MOVE 479 TO WS-IDX.
PERFORM A-100.
SET IDX2 UP BY 1.
DISPLAY "EXIT A-075".
A-085.
DISPLAY "ENTER A-085".
MOVE 1 TO WS-IDX.
PERFORM A-200.
MOVE 503 TO WS-IDX.
PERFORM A-200.
MOVE 2 TO WS-IDX.
PERFORM A-200.
MOVE 479 TO WS-IDX.
PERFORM A-200.
SET IDX2 UP BY 1.
DISPLAY "EXIT A-085".
A-100.
DISPLAY "ENTER A-100".
SET IDX1 TO 1.
SEARCH WS-TABLE1-ENTRY
AT END PERFORM A-400
WHEN WS-IDX = WS-TABLE1-IDX (IDX2, IDX1)
PERFORM A-300.
* NEXT SENTENCE.
A-200.
DISPLAY "ENTER A-200".
SEARCH ALL WS-TABLE1-ENTRY
AT END PERFORM A-400
* WHEN WS-IDX = WS-TABLE1-IDX (IDX2, IDX1)
* WHEN WS-IDX IS = WS-TABLE1-IDX (IDX2, IDX1)
WHEN WS-IDX IS EQUAL TO WS-TABLE1-IDX (IDX2, IDX1)
* WHEN WS-IDX IS EQUAL WS-TABLE1-IDX (IDX2, IDX1)
PERFORM A-300.
* NEXT SENTENCE.
DISPLAY "EXIT A-200".
A-300.
DISPLAY "ENTER A-300".
DISPLAY "Data WS-IDX =" WS-IDX " found in table WS-TABLE1".
MOVE IDX1 TO WS-IDX1.
MOVE IDX2 TO WS-IDX2.
* DISPLAY "IDX1=" WS-IDX1 ", IDX2=" WS-IDX2 ":".
* DISPLAY "WS-TABLE1-IDX =" WS-TABLE1-IDX (IDX2, IDX1) ":".
* DISPLAY "WS-TABLE1-DATA =" WS-TABLE1-DATA (IDX2, IDX1) ":".
DISPLAY "WS-TABLE1-ENTRY (" WS-IDX1 ", " WS-IDX2 ") =" WS-TABLE1-ENTRY (IDX2, IDX1) ":".
DISPLAY "EXIT A-300".
A-400.
DISPLAY "ENTER A-400".
DISPLAY "Data WS-IDX =" WS-IDX " not found in table WS-TABLE1".
MOVE IDX1 TO WS-IDX1.
MOVE IDX2 TO WS-IDX2.
DISPLAY "Max Indexes IDX1 =" WS-IDX1 ", IDX2=" WS-IDX2.
DISPLAY "EXIT A-400".
A-910.
* DISPLAY "ENTER A-910".
READ TEST-FILE-IN1
AT END MOVE 'Y' TO EOF-SW1.
IF EOF-SW1 = 'N'
PERFORM A-920
ADD 1 TO WS-REC-COUNTER-IN1.
* DISPLAY "EXIT A-910".
A-920.
* DISPLAY "ENTER A-920".
MOVE TEST-RECORD-IN1 TO WS-TABLE1-ENTRY (IDX2, IDX1).
* MOVE IDX2 TO WS-TABLE1-DATA2 (IDX2, IDX1).
* MOVE IDX1 TO WS-IDX1.
* MOVE IDX2 TO WS-IDX2.
* DISPLAY "WS-TABLE1-ENTRY (" WS-IDX1 ", " WS-IDX2 ") =" WS-TABLE1-ENTRY (IDX2, IDX1) ":".
SET IDX2 UP BY 1.
IF IDX2 > 3
SET IDX2 TO 1
SET IDX1 UP BY 1.
* DISPLAY "EXIT A-920".