Microsoft COBOL v3.00A

Microsoft COBOL v300A/E.CBL

@@ -0,0 +1,61 @@
+         IDENTIFICATION DIVISION.
+         PROGRAM-ID.  E.
+      *  REMARKS. generate digits of e
+         ENVIRONMENT DIVISION.
+         CONFIGURATION SECTION.
+         DATA DIVISION.
+         WORKING-STORAGE SECTION.
+         01 ARRAYS.
+             02 A PIC 9(04) COMP OCCURS 200 TIMES.
+         01 X PIC 9(04) COMP VALUE 0.
+         01 TMOD PIC 9(04) COMP VALUE 0.
+         01 TM PIC 9(04) COMP VALUE 0.
+         01 TD PIC 9(04) COMP VALUE 0.
+         01 N PIC 9(04) COMP VALUE 0.
+         01 HV PIC 9(04) COMP VALUE 0.
+         01 NXX PIC 99.
+         01 NX PIC 9.
+
+         PROCEDURE DIVISION.
+         MAIN.
+             DISPLAY 'computing e'.
+             PERFORM INITA-ROUTINE.
+             PERFORM INITA-ROUTINE-B.
+             PERFORM INITA-ROUTINE-C.
+             PERFORM OUTER-LOOP.
+             DISPLAY 'done'.
+             STOP RUN.
+
+         INITA-ROUTINE.
+             MOVE 200 TO HV.
+             MOVE 0 TO X.
+             MOVE 199 TO N.
+
+         INITA-ROUTINE-B.
+             MOVE 1 TO A( N + 1 ).
+             SUBTRACT 1 FROM N.
+             IF N > 0 GO TO INITA-ROUTINE-B.
+
+         INITA-ROUTINE-C.
+             MOVE 2 TO A( 2 ).
+             MOVE 0 TO A( 1 ).
+          
+         OUTER-LOOP.
+             SUBTRACT 1 FROM HV.
+             MOVE HV TO N.
+             PERFORM INNER-LOOP.
+             IF HV > 9 GO TO OUTER-LOOP.
+
+         INNER-LOOP.
+             DIVIDE X BY N GIVING TD.
+             COMPUTE TMOD = ( X - ( TD * N ) )
+             IF 0 = X MOVE 0 TO TMOD.
+             MOVE TMOD TO A( N + 1 ).
+             MULTIPLY 10 BY A( N ) GIVING TM.
+             COMPUTE X = TM + TD.
+             SUBTRACT 1 FROM N.
+             IF N > 0 GO TO INNER-LOOP.
+             MOVE X TO NXX.
+             MOVE X TO NX.
+             IF X < 10 DISPLAY NX ELSE DISPLAY NXX.
+

Microsoft COBOL v300A/SIEVE.CBL

@@ -0,0 +1,51 @@
+         IDENTIFICATION DIVISION.
+         PROGRAM-ID.  SIEVE.
+      *  REMARKS. BYTE magazine benchmark.
+         ENVIRONMENT DIVISION.
+         CONFIGURATION SECTION.
+         DATA DIVISION.
+         WORKING-STORAGE SECTION.
+         01 MISC.
+             03 I PIC 9(4) COMP.
+             03 PRIME PIC 9(5) COMP.
+             03 K PIC 9(4) COMP.
+             03 TOTAL-PRIME-COUNT PIC 9(4) COMP.
+         02 SIEVETABLE.
+             04 FLAGS PIC 9 COMP OCCURS 8191 TIMES.
+         01 NUM-DISP PIC 9999.
+
+         PROCEDURE DIVISION.
+         MAIN.
+             PERFORM ITER-ROUTINE 10 TIMES.
+             MOVE TOTAL-PRIME-COUNT TO NUM-DISP.
+             DISPLAY NUM-DISP ' primes'.
+             STOP RUN.
+
+         ITER-ROUTINE.
+             MOVE ZEROES TO TOTAL-PRIME-COUNT.
+             PERFORM TFR VARYING I FROM 1 BY 1 UNTIL I = 8191.
+             PERFORM DCP THRU DCE VARYING I FROM 0 BY 1 UNTIL I = 8190.
+
+         TFR.
+             MOVE 1 TO FLAGS(I).
+             
+         DCP.
+             IF FLAGS( I + 1 ) = 0
+                 GO TO DCE.
+             COMPUTE PRIME = I + I + 3.
+             COMPUTE K = I + PRIME.
+
+         FIRST1.
+             IF K > 8190 GO TO NEXT1.
+             MOVE 0 TO FLAGS( K + 1 ).
+             COMPUTE K = PRIME + K.
+             GO TO FIRST1.
+
+         NEXT1.
+             ADD 1 TO TOTAL-PRIME-COUNT.
+      *       MOVE PRIME TO NUM-DISP.
+      *       DISPLAY 'FOUND PRIME = ' NUM-DISP.
+
+         DCE.
+             EXIT.
+

Microsoft COBOL v300A/TTT.CBL

@@ -0,0 +1,168 @@
+         IDENTIFICATION DIVISION.
+         PROGRAM-ID.  TTT.
+      *  REMARKS. prove tic-tac-toe is not winnable against a good foe.
+         ENVIRONMENT DIVISION.
+         CONFIGURATION SECTION.
+         DATA DIVISION.
+         WORKING-STORAGE SECTION.
+         01 BOARD.
+             05 B PIC 9(04) COMP OCCURS 9 TIMES.
+             05 VALST PIC 9(04) COMP OCCURS 10 TIMES.
+             05 ALPHAST PIC 9(04) COMP OCCURS 10 TIMES.
+             05 BETAST PIC 9(04) COMP OCCURS 10 TIMES.
+             05 XST PIC 9(04) COMP OCCURS 10 TIMES.
+             05 PMST PIC 9(04) COMP OCCURS 10 TIMES.
+         01 MOVECOUNT PIC 9(04) COMP VALUE 0.
+         01 DEPTH PIC 9(04) COMP VALUE 0.
+         01 NUM-DISP PIC 9999.
+         01 ITER PIC 9(04) COMP VALUE 0.
+         01 WI PIC 9(04) COMP VALUE 0.
+         01 VAL PIC 9(04) COMP VALUE 0.
+         01 T PIC 9(04) COMP VALUE 0.
+         01 D PIC 9(04) COMP VALUE 0.
+         01 M PIC 9(04) COMP VALUE 0.
+         01 X PIC 9(04) COMP VALUE 0.
+         01 PM PIC 9(04) COMP VALUE 0.
+         01 SC PIC 9(04) COMP VALUE 0.
+         01 Z PIC 9(04) COMP VALUE 0.
+         01 ALPHA PIC 9(04) COMP VALUE 0.
+         01 BETA PIC 9(04) COMP VALUE 0.
+         01 FIRSTMOVE PIC 9(04) COMP VALUE 0.
+
+         PROCEDURE DIVISION.
+         MAIN.
+             DISPLAY 'hello from cobol'.
+             MOVE 1 TO ITER.
+         INITBOARD.
+             MOVE 0 TO B( ITER ).
+             ADD 1 TO ITER.
+             IF ITER < 10 GO TO INITBOARD.
+
+             MOVE 0 TO ITER.
+         NEXTITER.
+             MOVE 0 TO MOVECOUNT.
+             MOVE 1 TO FIRSTMOVE.
+             PERFORM RUNMM.
+             MOVE 2 TO FIRSTMOVE.
+             PERFORM RUNMM.
+             MOVE 5 TO FIRSTMOVE.
+             PERFORM RUNMM.
+             ADD 1 TO ITER.
+             IF ITER < 10 GO TO NEXTITER.
+
+             DISPLAY 'final move count and winner: '.
+             MOVE MOVECOUNT TO NUM-DISP.
+             DISPLAY NUM-DISP.
+             MOVE SC TO NUM-DISP.
+             DISPLAY NUM-DISP.
+
+             STOP RUN.
+
+         RUNMM.
+             MOVE 1 TO B( FIRSTMOVE ).
+             MOVE FIRSTMOVE TO X
+             MOVE 2 TO ALPHA
+             MOVE 9 TO BETA
+             PERFORM MINMAX.
+             MOVE 0 TO B( FIRSTMOVE ).
+
+         WINNER.
+             MOVE 0 TO WI.
+             MOVE B( 1 ) TO T.
+             IF 0 NOT = T AND T=B(2) AND T=B(3) MOVE T TO WI
+             ELSE IF 0 NOT= T AND  T=B(4) AND T=B(7) MOVE T TO WI.
+
+             IF 0 = WI
+               MOVE B(2) TO T
+               IF 0 NOT= T AND T=B(5) AND T=B(8) MOVE T TO WI
+               ELSE
+                 MOVE B(3) TO T
+                 IF 0 NOT= T AND T=B(6) AND T=B(9) MOVE T TO WI
+                 ELSE
+                   MOVE B(4) TO T
+                   IF 0 NOT= T AND T=B(5) AND T=B(6) MOVE T TO WI
+                   ELSE
+                     MOVE B(7) TO T
+                     IF 0 NOT= T AND T=B(8) AND T=B(9) MOVE T TO WI
+                     ELSE
+                       MOVE B(5) TO T
+                       IF 0 NOT= T AND T=B(1) AND T=B(9) MOVE T TO WI
+                       ELSE
+                         IF 0 NOT= T AND T=B(3) AND T=B(7) MOVE T TO WI.
+
+         SHOWPOS.
+             MOVE B(Z) TO NUM-DISP.
+             DISPLAY NUM-DISP.
+
+         SHOWBOARD.
+             DISPLAY 'board: '.
+             PERFORM SHOWPOS VARYING Z FROM 1 BY 1 UNTIL Z>9.
+
+         INITVALPM.
+             DIVIDE DEPTH BY 2 GIVING D.
+             MULTIPLY D BY 2 GIVING M.
+
+             IF DEPTH NOT = M
+                 MOVE 2 TO VAL
+                 MOVE 1 TO PM
+             ELSE
+                 MOVE 9 TO VAL
+                 MOVE 2 TO PM.
+
+         MINMAX.
+             ADD 1 TO MOVECOUNT.
+             MOVE 0 TO VAL.
+
+             IF DEPTH > 3
+                 PERFORM WINNER
+                 IF WI NOT = 0
+                     IF WI = 1 MOVE 6 TO VAL ELSE MOVE 4 TO VAL
+                 ELSE IF DEPTH = 8 MOVE 5 TO VAL.
+
+             IF 0 = VAL
+                 PERFORM INITVALPM
+
+                 ADD 1 TO DEPTH
+                 PERFORM MAKEMOVE VARYING X FROM 1 BY 1 UNTIL (X>9)
+                 SUBTRACT 1 FROM DEPTH.
+
+             MOVE VAL TO SC.
+
+         UPDATEODD.
+                 IF SC = 6 MOVE 10 TO X.
+                 IF SC > VAL MOVE SC TO VAL.
+                 IF VAL NOT < BETA MOVE 10 TO X.
+                 IF VAL > ALPHA MOVE VAL TO ALPHA.
+
+         UPDATEEVEN.
+                 IF SC = 4 MOVE 10 TO X.
+                 IF SC < VAL MOVE SC TO VAL.
+                 IF VAL NOT > ALPHA MOVE 10 TO X.
+                 IF VAL < BETA MOVE VAL TO BETA.
+
+         UPDATESTATE.
+                 IF PM = 1 PERFORM UPDATEODD
+                 ELSE PERFORM UPDATEEVEN.
+  
+         MAKEMOVE.
+             IF B( X ) = 0
+                 MOVE PM TO B( X )
+
+                 MOVE VAL TO VALST( DEPTH )
+                 MOVE X TO XST( DEPTH )
+                 MOVE PM TO PMST( DEPTH )
+                 MOVE ALPHA TO ALPHAST( DEPTH )
+                 MOVE BETA TO BETAST( DEPTH )
+
+                 PERFORM MINMAX
+
+                 MOVE BETAST( DEPTH ) TO BETA
+                 MOVE ALPHAST( DEPTH ) TO ALPHA
+                 MOVE PMST( DEPTH ) TO PM
+                 MOVE XST( DEPTH ) TO X
+                 MOVE VALST( DEPTH ) TO VAL
+
+                 MOVE 0 TO B( X )
+
+                 PERFORM UPDATESTATE.
+

Microsoft COBOL v300A/m.bat

@@ -0,0 +1,9 @@
+del %1.obj
+del %1.exe
+
+ntvdm -r:. -h -c -d cobol %1,%1,%1,%1
+
+ntvdm -h -i -c -r:. link %1,,%1,lcobol.lib,nul.def
+
+ntvdm -c %1
+