It being some years since I studied COBOL full-time (1983-85), I've forgotten more than ever knew. That being the case can some merciful soul tell me why the code at the end gives the following execution output, especially the duplication of
PLAY-YACHT-CHECK WITH 6
THERE ARE 5 X 6 IN 66666
1000-BUBBLE-SORT
[console]
cobc -xj YACHT.CBL
66666
1000-BUBBLE-SORT
66666
PLAY-YACHT-CHECK WITH 1
PLAY-YACHT-CHECK WITH 2
PLAY-YACHT-CHECK WITH 3
PLAY-YACHT-CHECK WITH 4
PLAY-YACHT-CHECK WITH 5
PLAY-YACHT-CHECK WITH 6
THERE ARE 5 X 6 IN 66666
PLAY-YACHT-CHECK WITH 6
THERE ARE 5 X 6 IN 66666
1000-BUBBLE-SORT
[console]
[code]
IDENTIFICATION DIVISION.
PROGRAM-ID. YACHT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CATEGORY PIC X(12).
01 WS-DICE PIC 9(5).
88 LITTLE-STRAIGHT VALUES 1 2 3 4 5.
88 BIG-STRAIGHT VALUES 2 3 4 5 6.
01 WS-DICE-ARRAY REDEFINES WS-DICE.
03 WS-DICE-DIE PIC 9 OCCURS 5 TIMES INDEXED BY DICE-INDEX.
01 WS-TEMP PIC 9.
01 WS-CHANGED-FLAG pic X.
88 HAS_CHANGED value 'Y'.
88 NOT_CHANGED value 'N'.
01 WS-COUNTER PIC 9 USAGE BINARY.
01 WS-RESULT PIC 99.
01 WS-DOTS PIC 9.
PROCEDURE DIVISION.
000-SETUP.
MOVE 0 TO WS-RESULT.
MOVE 66666 TO WS-DICE.
MOVE 'yacht' TO WS-CATEGORY.
PERFORM 200-PLAY-DICE.
DISPLAY "WS-RESULT " WS-RESULT.
GOBACK.
000-SETUP-EXIT.
EXIT.
200-PLAY-DICE.
DISPLAY WS-DICE.
PERFORM 1000-BUBBLE-SORT.
DISPLAY WS-DICE.
EVALUATE WS-CATEGORY
WHEN 'yacht'
PERFORM 210-SCORE-YACHT-ROLL
END-EVALUATE.
200-PLAY-DICE-EXIT.
EXIT.
210-SCORE-YACHT-ROLL.
MOVE 1 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
MOVE 2 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
MOVE 3 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
MOVE 4 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
MOVE 5 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
MOVE 6 TO WS-DOTS.
PERFORM 220-PLAY-YACHT-CHECK.
IF HAS_CHANGED
GO TO 210-SCORE-YACHT-ROLL-EXIT
END-IF.
210-SCORE-YACHT-ROLL-EXIT.
EXIT.
220-PLAY-YACHT-CHECK.
DISPLAY "PLAY-YACHT-CHECK WITH " WS-DOTS.
SET NOT_CHANGED TO TRUE.
MOVE 0 TO WS-COUNTER.
INSPECT WS-DICE
TALLYING WS-COUNTER FOR ALL WS-DOTS.
IF WS-COUNTER = 5
DISPLAY "THERE ARE " WS-COUNTER " X "
WS-DOTS " IN " WS-DICE
MOVE 50 TO WS-RESULT
SET HAS_CHANGED TO TRUE
ELSE
MOVE 0 TO WS-RESULT
END-IF.
220-PLAY-YACHT-CHECK-EXIT.
EXIT.
1000-BUBBLE-SORT.
DISPLAY "1000-BUBBLE-SORT".
MOVE 5 TO WS-COUNTER.
PERFORM WITH TEST AFTER UNTIL NOT_CHANGED
SET NOT_CHANGED TO TRUE
SUBTRACT 1 FROM WS-COUNTER
PERFORM VARYING DICE-INDEX
FROM 1
BY 1
UNTIL DICE-INDEX > WS-COUNTER
IF WS-DICE-DIE (DICE-INDEX) > WS-DICE-DIE (DICE-INDEX + 1)
MOVE WS-DICE-DIE (DICE-INDEX) TO WS-TEMP
MOVE WS-DICE-DIE (DICE-INDEX + 1)
TO WS-DICE-DIE (DICE-INDEX)
MOVE WS-TEMP TO WS-DICE-DIE (DICE-INDEX + 1)
SET HAS_CHANGED TO TRUE
END-IF
END-PERFORM
END-PERFORM.
1000-BUBBLE-SORT-EXIT.
EXIT.
[/code]
Thanks in advance,
Bruce
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)