hanoi.cbl

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    TheTowersOfHanoi.
000300 AUTHOR.        Amit Singh <http://hanoi.kernelthread.com>.
000400
000500 ENVIRONMENT DIVISION.
000600
000700 CONFIGURATION SECTION.
000800 SOURCE-COMPUTER. ALMOST-PORTABLE.
000900 OBJECT-COMPUTER. ALMOST-PORTABLE.
001000
001100 DATA DIVISION.
001200
001300 WORKING-STORAGE SECTION.
001400
001500 01  STACK-SPACE.
001600     02  ESP            PIC S9(3) COMP.
001700     02  STACK-FRAME    OCCURS 1024.
001800         03  S-N        PIC 9(2).
001900         03  S-FROM     PIC X(2).
002000         03  S-USING    PIC X(2).
002100         03  S-TO       PIC X(2).
002200         03  S-PROC     PIC 9(1).
002300
002400 01  CURRENT-FRAME.
002500     02  CN        PIC 9(2)    VALUE 3.
002600     02  CFROM     PIC X(2)    VALUE "1".
002700     02  CUSING    PIC X(2)    VALUE "2".
002800     02  CTO       PIC X(2)    VALUE "3".
002900     02  CPROC     PIC 9(1)    VALUE 0.
003000
003100 01  TMP-FRAME.
003200     02  TN        PIC 9(2)    VALUE 3.
003300     02  TFROM     PIC X(2)    VALUE "1".
003400     02  TUSING    PIC X(2)    VALUE "2".
003500     02  TTO       PIC X(2)    VALUE "3".
003600     02  TPROC     PIC 9(1)    VALUE 0.
003700
003800 PROCEDURE DIVISION.
003900 BEGIN-PROGRAM.
003910     PERFORM GET-DISKS
004000     MOVE 1 TO ESP
004100     MOVE CURRENT-FRAME TO STACK-FRAME (ESP)
004150     PERFORM DO-HANOI
004200           UNTIL ESP = ZERO
004300     .
004500     STOP RUN
004600     .
004700
004800 DO-HANOI.
004900     MOVE STACK-FRAME (ESP) TO CURRENT-FRAME
005000     SUBTRACT 1 FROM ESP
005100     IF CPROC = 0
005200         IF CN = 1
005300             PERFORM MOVE-DISK
005400         ELSE
005500             MOVE CN TO TN
005600             MOVE CFROM TO TFROM
005700             MOVE CUSING TO TUSING
005800             MOVE CTO TO TTO
005900             MOVE 1 TO TPROC
006000             ADD 1 TO ESP
006100             MOVE TMP-FRAME TO STACK-FRAME (ESP)
006200             MOVE CN TO TN
006300             SUBTRACT 1 FROM TN
006400             MOVE CFROM TO TFROM
006500             MOVE CTO TO TUSING
006600             MOVE CUSING TO TTO
006700             MOVE 0 TO TPROC
006800             ADD 1 TO ESP
006900             MOVE TMP-FRAME TO STACK-FRAME (ESP)
006950         END-IF
007000     ELSE
007100         PERFORM MOVE-DISK
007200         MOVE 0 TO TPROC
007300         MOVE CTO TO TTO
007400         MOVE CFROM TO TUSING
007500         MOVE CUSING TO TFROM
007600         MOVE CN TO TN
007700         SUBTRACT 1 FROM TN
007800         ADD 1 TO ESP
007900         MOVE TMP-FRAME TO STACK-FRAME (ESP)
008000     END-IF
008100     .
008200 MOVE-DISK.
008300             DISPLAY CFROM
008400                     "--> "
008500                     CTO
008600 .
008700 GET-DISKS.
008800     DISPLAY "How many disks to solve for? " NO ADVANCING
008900     ACCEPT CN
009000     IF CN < 1 OR CN > 10
009100         DISPLAY "Invalid number of disks (1 <= N <= 10)."
009200         EXIT PROGRAM
009300     END-IF
009400
009500 .