FORTRAN IV-PLUS V02-51E 13:47:15 12-APR-80 PAGE 1 BG.FTN /TR:BLOCKS/WR 0001 INTEGER BOARD(26),ROLL(2),MOVE(2,4),BOARD1(26) 00001 0002 INTEGER BOARD2(26),SCORE(6),BOARD3(26),TEST(2) 00002 0003 BYTE IBUF(20) 00003 0004 REAL A 00004 0005 T1=SECNDS(0.0) 00005 0006 IF(.NOT.(T1.GT.46800.0.AND.T1.LT.59400.0)) GO TO 32758 00006 0007 WRITE(1,*) 00007 1'Time wasted playing computer games can never be recovered!' 00008 0008 32758 IF(.NOT.(T1.LT.43200.0.AND.T1.GT.30600.0)) GO TO 32757 00008 0009 WRITE(1,*) 00009 1'Time wasted playing computer games can never be recovered!' 00010 0010 32757 I1=T1/2000 00010 0011 I2=SQRT(T1)/10 00011 0012 DO 32756 I=1,(I1/10)+10 00012 0013 ID=RAN(I1,I2) 00012 0014 32756 CONTINUE 00012 0015 9 CALL INIT(BOARD) 00015 0016 CALL PRINTB(BOARD) 00016 0017 WRITE(1,*) 'DO YOU NEED INSTRUCTIONS? ' 00017 0018 READ(1,99)NCHRS,(IBUF(I),I=1,NCHRS) 00018 0019 99 FORMAT(Q,20A1) 00019 0020 IF(IBUF(1).EQ.'N'.OR.IBUF(1).EQ.'n')GOTO 80 00020 0021 WRITE(1,*) 00021 +' THIS IS THE PLAYING BOARD, IT LOOKS DIFFERENT' 00022 0022 WRITE(1,*) 00022 +'FROM THE NORMAL BOARD BECAUSE YOUR OPPONETS SIDE HAS' 00023 0023 WRITE(1,*) 00023 +'BEEN ROTATED AND PLACED TO THE LEFT OF YOUR SIDE. A' 00024 0024 WRITE(1,*) 00024 +'PLUS SIGN REPRESENTS A POINT ON THE BOARD. THERE ARE' 00025 0025 WRITE(1,*) 00025 +'TWO POINTS BY THEMSELVES ON THE LEFT AND RIGHT.' 00026 0026 WRITE(1,*) 00026 +'THESE ARE OCCUPIED BY MEN AFTER THEY HAVE BEEN HIT.' 00027 0027 WRITE(1,*) 00027 +'THE COMPUTER PLAYS RED (SYMBOLIZED AS -R-) AND MOVES' 00028 0028 WRITE(1,*) 00028 +'FROM RIGHT TO LEFT. THE PLAYER USES THE WHITE MEN' 00029 0029 WRITE(1,*) 00029 +'( -W- ) AND MOVES FROM LEFT TO RIGHT.' 00030 0030 WRITE(1,*) 00030 +' THE NUMBERS BELOW THE POINTS ARE USED WHEN' 00031 0031 WRITE(1,*) 00031 +'MOVING YOUR MEN. THE POINTS ARE NUMBERED FROM 1 TO' 00032 0032 WRITE(1,*) 00032 +'26, YOU MUST MENTALLY ADD THE TENS DIGIT, THERE' 00033 0033 WRITE(1,*) 00033 +'WASN T ROOM TO PRINT IT. MOVE ARE MADE BY SPECIFYING' 00034 0034 WRITE(1,*) 00034 +'THE -FROM- POINT AND THE ROLL OF THE DIE. THE' 00035 0035 WRITE(1,*) 00035 +'NUMBERS ARE SEPARATED BY COMMAS. TO MAKE THE -LOVERS' 00036 0036 WRITE(1,*) 00036 +'LEAP- MOVE ON AN OPENING ROLL OF 6 5, YOU WOULD TYPE' 00037 0037 WRITE(1,*) 00037 +'2,6,8,5. THE COMPUTER WOULD THEN MAKE THAT MOVE FOR' 00038 FORTRAN IV-PLUS V02-51E 13:47:15 12-APR-80 PAGE 2 BG.FTN /TR:BLOCKS/WR 0038 WRITE(1,*) 00038 +'YOU.' 00039 0039 80 CONTINUE 00039 0040 WRITE(1,*)' ' 00040 0041 CALL GETROL(ROLL,I1,I2) 00041 0042 WRITE(1,89) ROLL(1) 00042 0043 89 FORMAT(1X, 'I ROLLED A', I2) 00043 0044 WRITE(1,88) ROLL(2) 00044 0045 88 FORMAT(1X, 'YOU ROLLED A', I2) 00045 0046 IF(ROLL(1)-ROLL(2)) 81,82,83 00046 0047 81 CONTINUE 00047 0048 WRITE(1,*)'YOU GO FIRST' 00048 0049 CALL PRINTB(BOARD) 00049 0050 GO TO 55 00050 0051 82 CONTINUE 00051 0052 WRITE(1,*)'DOUBLES, ROLL AGAIN.' 00052 0053 GO TO 80 00053 0054 83 CONTINUE 00054 0055 WRITE(1,*)'I GO FIRST' 00055 0056 GO TO 4 00056 0057 1 CALL GETROL(ROLL,I1,I2) 00057 0058 4 ISW=0 00058 0059 JSW=0 00059 0060 KSW=0 00060 0061 ISCORE=1000 00061 0062 WRITE(1,2) ROLL 00062 0063 2 FORMAT(1X, 'I ROLL',2I2,'.') 00063 0064 3 CONTINUE 00064 0065 MOVE(1,1)=0 00065 0066 MOVE(2,1)=-ROLL(1) 00066 0067 MOVE(1,2)=0 00067 0068 MOVE(2,2)=-ROLL(2) 00068 0069 10 CONTINUE 00069 0070 CALL MAKNXT(BOARD,BOARD1,MOVE(1,1)) 00070 0071 IF(MOVE(1,1).EQ.-1) GO TO 100 00071 0072 20 CONTINUE 00072 0073 CALL MAKNXT(BOARD1,BOARD2,MOVE(1,2)) 00073 0074 IF(MOVE(1,2).EQ.-1) GO TO 30 00074 0075 CALL EVAL(BOARD2,SCORE) 00075 0076 JSW=1 00076 0077 IF(SCORE(6).GT.ISCORE) GO TO 20 00077 0078 ISCORE=SCORE(6) 00078 0079 DO 32755 I=1,26 00079 0080 BOARD3(I)=BOARD2(I) 00079 0081 32755 CONTINUE 00079 0082 GO TO 20 00082 0083 30 CONTINUE 00083 0084 MOVE(1,2)=0 00084 0085 GO TO 10 00085 0086 50 CONTINUE 00086 0087 IF(JSW.NE.0) GO TO 52 00087 0088 ISCORE=1000 00088 0089 DO 70 J=2,26 00089 0090 MOVE(1,1)=J 00090 0091 MOVE(1,2)=J 00091 0092 I=1 00092 FORTRAN IV-PLUS V02-51E 13:47:15 12-APR-80 PAGE 3 BG.FTN /TR:BLOCKS/WR 0093 IF(MOVCHK(BOARD,MOVE(1,I)).NE.0) GO TO 71 00093 0094 I=2 00094 0095 IF(MOVCHK(BOARD,MOVE(1,I)).EQ.0) GO TO 70 00095 0096 71 CONTINUE 00096 0097 JSW=1 00097 0098 CALL MAKMOV(BOARD,BOARD2,MOVE(1,I)) 00098 0099 CALL EVAL(BOARD2,SCORE) 00099 0100 IF(SCORE(6).GT.ISCORE) GO TO 70 00100 0101 ISCORE=SCORE(6) 00101 0102 DO 32754 I=1,26 00102 0103 BOARD3(I)=BOARD2(I) 00102 0104 32754 CONTINUE 00102 0105 70 CONTINUE 00105 0106 IF(JSW.NE.0) GO TO 52 00106 0107 WRITE(1,*)'I CANNOT MOVE' 00107 0108 GO TO 53 00108 0109 52 CONTINUE 00109 0110 DO 32753 I=1,26 00110 0111 BOARD(I)=BOARD3(I) 00110 0112 32753 CONTINUE 00110 0113 IF(KSW.NE.0) GO TO 56 00113 0114 KSW=1 00114 0115 IF(ROLL(1).NE.ROLL(2)) GO TO 56 00115 0116 JSW=0 00116 0117 GO TO 3 00117 0118 56 CONTINUE 00118 0119 KSW=0 00119 0120 CALL PRINTB(BOARD) 00120 0121 CALL EVAL(BOARD,SCORE) 00121 0122 IF(SCORE(2).EQ.0) GO TO 54 00122 0123 GO TO 53 00123 0124 54 WRITE(1,*)'I WIN, THANKS FOR THE GAME' 00124 0125 CALL EXIT 00125 0126 GO TO 9 00126 0127 53 CONTINUE 00127 0128 CALL GETROL(ROLL,I1,I2) 00128 0129 55 CONTINUE 00129 0130 CALL INPMOV(BOARD,ROLL) 00130 0131 CALL PRINTB(BOARD) 00131 0132 CALL EVAL(BOARD,SCORE) 00132 0133 IF(SCORE(1).EQ.0) GO TO 65 00133 0134 GO TO 1 00134 0135 65 WRITE(1,*)'YOU WIN, THANKS' 00135 0136 CALL EXIT 00136 0137 GO TO 9 00137 0138 100 CONTINUE 00138 0139 IF(ISW.EQ.1) GO TO 50 00139 0140 MOVE(1,1)=0 00140 0141 MOVE(2,1)=-ROLL(2) 00141 0142 MOVE(1,2)=0 00142 0143 MOVE(2,2)=-ROLL(1) 00143 0144 ISW=1 00144 0145 GO TO 10 00145 0146 END 00146 FORTRAN IV-PLUS V02-51E 13:47:15 12-APR-80 PAGE 4 BG.FTN /TR:BLOCKS/WR PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 003164 826 RW,I,CON,LCL $PDATA 002146 563 RW,D,CON,LCL $IDATA 000210 68 RW,D,CON,LCL $VARS 000444 146 RW,D,CON,LCL $TEMPS 000002 1 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 006210 1604 FORTRAN IV-PLUS V02-51E 13:47:31 12-APR-80 PAGE 5 BG.FTN /TR:BLOCKS/WR 0001 INTEGER FUNCTION MOVCHK(BOARD,MOVE) 00001 0002 INTEGER IOURS,OFFBRD 00002 0003 INTEGER BOARD(26),MOVE(2),IBRDF,IBRDT 00003 0004 MOVCHK=0 00004 0005 MOVEP=MOVE(1) 00005 0006 MOVER=MOVE(2) 00006 0007 MOVET=MOVEP+MOVER 00007 0008 IBRDF=BOARD(MOVEP) 00008 0009 IBRDT=BOARD(MOVET) 00009 0010 IOURS=0 00010 0011 IF(MOVE(2).LT.0) IOURS=1 00011 0012 OFFBRD=26 00012 0013 IF(IOURS.EQ.0) OFFBRD=1 00013 0014 IF(BOARD(OFFBRD).NE.0.AND.MOVEP.NE.OFFBRD) RETURN 00014 0015 IF(IBRDF.EQ.0) RETURN 00015 0016 IF(ISHFT(IBRDF,-4).NE.IOURS) RETURN 00016 0017 IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100 00017 0018 IF(IBRDT.EQ.0) GO TO 10 00018 0019 IF(ISHFT(IBRDT,-4).EQ.IOURS) GOTO 10 00019 0020 IF(IAND(IBRDT,15).LT.2) GOTO 10 00020 0021 RETURN 00021 0022 10 CONTINUE 00022 0023 MOVCHK=1 00023 0024 RETURN 00024 0025 100 CONTINUE 00025 0026 DO 105 I=1,19 00026 0027 I1=I 00027 0028 IF(IOURS.NE.0) I1=27-I 00028 0029 IF(BOARD(I1).EQ.0) GOTO 105 00029 0030 IF(ISHFT(BOARD(I1),-4).EQ.IOURS) RETURN 00030 0031 105 CONTINUE 00031 0032 IF(MOVET.EQ.26.OR.MOVET.EQ.1) GO TO 110 00032 0033 GO TO (120,130),IOURS+1 00033 0034 WRITE(1,*)'IOURS - ILLEGAL VALUE' 00034 0035 RETURN 00035 0036 120 CONTINUE 00036 0037 MOVEP1=MOVEP-1 00037 0038 IF(MOVEP1.LE.20) GO TO 126 00038 0039 DO 125 I=20,MOVEP1 00039 0040 IF(BOARD(I).EQ.0) GO TO 125 00040 0041 IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN 00041 0042 125 CONTINUE 00042 0043 126 MOVCHK=1 00043 0044 RETURN 00044 0045 130 CONTINUE 00045 0046 MOVEP1=MOVEP+1 00046 0047 IF(MOVEP1.GE.7) GO TO 136 00047 0048 DO 32758 I=MOVEP1,7 00048 0049 IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN 00049 0050 32758 CONTINUE 00050 0051 136 MOVCHK=1 00051 0052 RETURN 00052 0053 110 CONTINUE 00053 0054 MOVCHK=1 00054 0055 RETURN 00055 0056 END 00056 FORTRAN IV-PLUS V02-51E 13:47:31 12-APR-80 PAGE 6 BG.FTN /TR:BLOCKS/WR PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 001172 317 RW,I,CON,LCL $PDATA 000040 16 RW,D,CON,LCL $IDATA 000050 20 RW,D,CON,LCL $VARS 000024 10 RW,D,CON,LCL $TEMPS 000002 1 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 001330 364 NO FPP INSTRUCTIONS GENERATED FORTRAN IV-PLUS V02-51E 13:47:37 12-APR-80 PAGE 7 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE NXTMOV(BOARD,MOVE) 00001 0002 INTEGER ROLL,POINT,BOARD(26),MOVE(2) 00002 0003 POINT=MOVE(1) 00003 0004 ROLL=MOVE(2) 00004 0005 IF(POINT.EQ.0) GO TO 100 00005 0006 IOURS=0 00006 0007 IF(ROLL.LT.0) IOURS=1 00007 0008 POINT=POINT+1 00008 0009 DO 10 I=POINT,26 00009 0010 IF(BOARD(I).EQ.0) GO TO 10 00010 0011 IF(ISHFT(BOARD(I),-4).NE.IOURS) GO TO 10 00011 0012 POINT=I 00012 0013 GO TO 200 00013 0014 10 CONTINUE 00014 0015 POINT=-1 00015 0016 GO TO 200 00016 0017 100 CONTINUE 00017 0018 IOURS=0 00018 0019 IF(ROLL.LT.0) IOURS=1 00019 0020 DO 110 I=1,26 00020 0021 IF(BOARD(I).EQ.0) GO TO 110 00021 0022 IF(ISHFT(BOARD(I),-4).NE.IOURS) GOTO 110 00022 0023 POINT=I 00023 0024 GO TO 200 00024 0025 110 CONTINUE 00025 0026 POINT=-1 00026 0027 200 CONTINUE 00027 0028 MOVE(1)=POINT 00028 0029 MOVE(2)=ROLL 00029 0030 RETURN 00030 0031 END 00031 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000454 150 RW,I,CON,LCL $PDATA 000004 2 RW,D,CON,LCL $IDATA 000032 13 RW,D,CON,LCL $VARS 000010 4 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 000522 169 NO FPP INSTRUCTIONS GENERATED FORTRAN IV-PLUS V02-51E 13:47:40 12-APR-80 PAGE 8 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE GETROL(ROLL,I1,I2) 00001 0002 INTEGER ROLL(2) 00002 0003 ROLL(1)=INT(6.0*RAN(I1,I2))+1 00003 0004 ROLL(2)=INT(6.0*RAN(I1,I2))+1 00004 0005 RETURN 00005 0006 END 00006 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000214 70 RW,I,CON,LCL $IDATA 000020 8 RW,D,CON,LCL $TEMPS 000002 1 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 000236 79 FORTRAN IV-PLUS V02-51E 13:47:41 12-APR-80 PAGE 9 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE MAKMOV(OLDBRD,NEWBRD,MOVE) 00001 0002 INTEGER OLDBRD(26),NEWBRD(26),MOVE(2) 00002 0003 DO 10 I=1,26 00003 0004 10 NEWBRD(I)=OLDBRD(I) 00004 0005 MOVEP=MOVE(1) 00005 0006 MOVER=MOVE(2) 00006 0007 MOVET=MOVEP+MOVER 00007 0008 IBRDF=OLDBRD(MOVEP) 00008 0009 IBRDT=OLDBRD(MOVET) 00009 0010 IOURS=ISHFT(IBRDF,-4) 00010 0011 IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100 00011 0012 IF(ISHFT(IBRDF,-4).EQ.IOURS) GO TO 20 00012 0013 WRITE(1,*)'ERROR, MOVING OPPS MAN' 00013 0014 RETURN 00014 0015 20 CONTINUE 00015 0016 IF(ISHFT(IBRDT,-4).NE.IOURS.AND.IBRDT.NE.0) GO TO 200 00016 0017 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00017 0018 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00018 0019 ITEMP=ISHFT(IOURS,4) 00019 0020 NEWBRD(MOVET)=(ITEMP.OR.NEWBRD(MOVET)+1) 00020 0021 RETURN 00021 0022 200 CONTINUE 00022 0023 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00023 0024 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00024 0025 NEWBRD(MOVET)=ISHFT(IOURS,4)+1 00025 0026 OFFBRD=26-IOURS*25 00026 0027 NEWBRD(OFFBRD)=(ISHFT(1-IOURS,4).OR.NEWBRD(OFFBRD)+1) 00027 0028 RETURN 00028 0029 100 CONTINUE 00029 0030 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00030 0031 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00031 0032 RETURN 00032 0033 END 00033 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000742 241 RW,I,CON,LCL $PDATA 000040 16 RW,D,CON,LCL $IDATA 000066 27 RW,D,CON,LCL $VARS 000024 10 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 001114 294 FORTRAN IV-PLUS V02-51E 13:47:46 12-APR-80 PAGE 10 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE PRINTB(BOARD) 00001 0002 INTEGER BOARD(26),PRNTBF(26) 00002 0003 INTEGER ABLANK, AR, AW 00003 0004 DATA ABLANK/' '/, AR/'R'/, AW/'W'/ 00004 0005 DO 10 I=1,15 00005 0006 COUNT=16-I 00006 0007 PFLAG=0 00007 0008 DO 20 J=1,26 00008 0009 PRNTBF(J)=ABLANK 00009 0010 IF(IAND(BOARD(J),15).LT.COUNT) GO TO 20 00010 0011 PRNTBF(J)=AR 00011 0012 IF(ISHFT(BOARD(J),-4).EQ.0) PRNTBF(J)=AW 00012 0013 PFLAG=1 00013 0014 20 CONTINUE 00014 0015 IF(PFLAG.EQ.0) GO TO 10 00015 0016 WRITE(1,30) PRNTBF 00016 0017 30 FORMAT(2X,A1,2X,6A2,1X,6A2,2X,6A2,1X,6A2,1X,A1) 00017 0018 10 CONTINUE 00018 0019 WRITE(1,*) 00019 $'^ + + + + + + + + + + + + + + + + + + + + + + + + ^' 00020 0020 WRITE(1,*) 00020 $'1 2 3 4 5 6 7 8 9 | 11| 13 | 15| 17| 19 | 21| 23| 25 |' 00021 0021 WRITE(1,*) 00021 $' 10 12 14 16 18 20 22 24 26' 00022 0022 RETURN 00022 0023 END 00023 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000450 148 RW,I,CON,LCL $PDATA 000264 90 RW,D,CON,LCL $IDATA 000062 25 RW,D,CON,LCL $VARS 000106 35 RW,D,CON,LCL $TEMPS 000002 1 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 001126 299 FORTRAN IV-PLUS V02-51E 13:47:49 12-APR-80 PAGE 11 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE INIT(BOARD) 00001 0002 INTEGER BOARD(26) 00002 0003 RED=16 00003 0004 WHITE=0 00004 0005 DO 10 I=1,26 00005 0006 10 BOARD(I)=0 00006 0007 BOARD(2)=WHITE+2 00007 0008 BOARD(7)=RED+5 00008 0009 BOARD(9)= RED+3 00009 0010 BOARD(13)=WHITE+5 00010 0011 BOARD(14)=RED+5 00011 0012 BOARD(18)=WHITE+3 00012 0013 BOARD(20)=WHITE+5 00013 0014 BOARD(25)=RED+2 00014 0015 RETURN 00015 0016 END 00016 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000242 81 RW,I,CON,LCL $IDATA 000012 5 RW,D,CON,LCL $VARS 000012 5 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 000266 91 FORTRAN IV-PLUS V02-51E 13:47:51 12-APR-80 PAGE 12 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE INPMOV(BOARD,ROLL) 00001 0002 INTEGER ROLL(2),MOVE(2,4),BOARD(26),BOARD1(26),BOARD2(26) 00002 0003 INTEGER TEST(2) 00003 0004 MOVSW=0 00004 0005 WRITE(1,3) ROLL 00005 0006 3 FORMAT(1X, 'YOU ROLL',2I2,'.') 00006 0007 WRITE(1,300) 00007 0008 300 FORMAT(' Your move?>',$) 00008 0009 GO TO 4 00009 0010 61 WRITE(1,1) 00010 0011 1 FORMAT(1X, 'Try again>'$) 00011 0012 4 READ(1,2,END=99,ERR=61) MOVE 00012 0013 2 FORMAT(8I6) 00013 0014 IF(BOARD(1).EQ.0) GO TO 67 00014 0015 TEST(1)=1 00015 0016 TEST(2)=ROLL(1) 00016 0017 IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67 00017 0018 TEST(2)=ROLL(2) 00018 0019 IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67 00019 0020 WRITE(1,*)'YOU HAVE NO MOVE' 00020 0021 RETURN 00021 0022 67 CONTINUE 00022 0023 IF(MOVE(1,1).EQ.0) RETURN 00023 0024 IF(MOVE(1,2).NE.0) GO TO 64 00024 0025 IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61 00025 0026 CALL MAKMOV(BOARD,BOARD,MOVE(1,1)) 00026 0027 GOTO 68 00027 0028 64 IF(MOVE(2,1).EQ.ROLL(1).AND.MOVE(2,2).EQ.ROLL(2)) GO TO 62 00028 0029 IF(MOVE(2,1).EQ.ROLL(2).AND.MOVE(2,2).EQ.ROLL(1)) GO TO 62 00029 0030 GO TO 61 00030 0031 62 IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61 00031 0032 CALL MAKMOV(BOARD,BOARD1,MOVE(1,1)) 00032 0033 IF(MOVCHK(BOARD1,MOVE(1,2)).EQ.0) GO TO 61 00033 0034 CALL MAKMOV(BOARD1,BOARD,MOVE(1,2)) 00034 0035 68 IF(ROLL(1).EQ.ROLL(2).AND.MOVSW.EQ.0) GO TO 80 00035 0036 RETURN 00036 0037 80 CONTINUE 00037 0038 WRITE(1,*)'INPUT NEXT MOVE' 00038 0039 MOVSW=1 00039 0040 GO TO 4 00040 0041 99 WRITE(1,*)'Nice Playing With You.' 00041 0042 STOP 00042 0043 END 00043 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 001052 277 RW,I,CON,LCL $PDATA 000072 29 RW,D,CON,LCL $IDATA 000174 62 RW,D,CON,LCL $VARS 000176 63 RW,D,CON,LCL $TEMPS 000002 1 RW,D,CON,LCL FORTRAN IV-PLUS V02-51E 13:47:51 12-APR-80 PAGE 13 BG.FTN /TR:BLOCKS/WR TOTAL SPACE ALLOCATED = 001540 432 NO FPP INSTRUCTIONS GENERATED FORTRAN IV-PLUS V02-51E 13:47:55 12-APR-80 PAGE 14 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE MAKNXT(BOARD,NEWBRD,MOVE) 00001 0002 INTEGER BOARD(26),NEWBRD(26),MOVE(2) 00002 0003 10 CALL NXTMOV(BOARD,MOVE) 00003 0004 IF(MOVE(1).EQ.-1) RETURN 00004 0005 IF(MOVCHK(BOARD,MOVE).EQ.0) GO TO 10 00005 0006 CALL MAKMOV(BOARD,NEWBRD,MOVE) 00006 0007 RETURN 00007 0008 END 00008 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 000252 85 RW,I,CON,LCL $IDATA 000054 22 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 000326 107 NO FPP INSTRUCTIONS GENERATED FORTRAN IV-PLUS V02-51E 13:47:57 12-APR-80 PAGE 15 BG.FTN /TR:BLOCKS/WR 0001 SUBROUTINE EVAL(BOARD,STATUS) 00001 0002 INTEGER BOARD(26),STATUS(6) 00002 0003 DATA LUTR /6/ 00003 0004 DO 5 I=1,6 00004 0005 5 STATUS(I)=0 00005 0006 DO 10 I=1,25 00006 0007 IF(BOARD(I).EQ.0) GO TO 10 00007 0008 IF(ISHFT(BOARD(I),-4).NE.0) GO TO 10 00008 0009 STATUS(1)=STATUS(1)+IAND(BOARD(I),15)*(26-I) 00009 0010 10 CONTINUE 00010 0011 DO 20 I=2,26 00011 0012 IF(BOARD(I).EQ.0) GO TO 20 00012 0013 IF(ISHFT(BOARD(I),-4).EQ.0) GO TO 20 00013 0014 STATUS(2)=STATUS(2)+IAND(BOARD(I),15)*(I-1) 00014 0015 20 CONTINUE 00015 0016 DO 30 I=2,25 00016 0017 IBRDP=BOARD(I) 00017 0018 IF(IBRDP.EQ.0) GOTO 30 00018 0019 IF(ISHFT(IBRDP,-4).NE.0) GO TO 30 00019 0020 IF(IAND(IBRDP,15).NE.1) GO TO 30 00020 0021 K=J+12 00021 0022 IF(K.GT.25) K=25 00022 0023 DO 35 J=I,K 00023 0024 IF(ISHFT(BOARD(J),-4).NE.1) GO TO 35 00024 0025 STATUS(3)=STATUS(3)+2-(J-I)/6 00025 0026 35 CONTINUE 00026 0027 30 CONTINUE 00027 0028 VUN=0 00028 0029 DO 40 I=1,25 00029 0030 IBRDP=BOARD(I) 00030 0031 IF(IBRDP.EQ.0) GOTO 40 00031 0032 IF(ISHFT(IBRDP,-4).NE.1) GO TO 40 00032 0033 IF(IAND(IBRDP,15).GT.1) GO TO 40 00033 0034 ISW=0 00034 0035 IF(I.GE.20) ISW=1 00035 0036 K=I-12 00036 0037 IF(K.LT.1) K=1 00037 0038 VUN=0 00038 0039 DO 45 J=K,I 00039 0040 IF(BOARD(J).EQ.0) GOTO 45 00040 0041 IF(ISHFT(BOARD(J),-4).NE.0) GO TO 45 00041 0042 RANGE=I-J 00042 0043 VUN=VUN+(2-(RANGE-1)/6) 00043 0044 45 CONTINUE 00044 0045 IF(VUN.GT.5) VUN=5 00045 0046 ADV=(31-I)/6 00046 0047 POCC=0 00047 0048 DO 49 K=20,25 00048 0049 IF(BOARD(K).EQ.0) GOTO 49 00049 0050 IF(ISHFT(BOARD(K),-4).NE.0) GO TO 49 00050 0051 IF(IAND(BOARD(K),15).LT.2) GO TO 49 00051 0052 POCC=POCC+1 00052 0053 49 CONTINUE 00053 0054 POCC=POCC/3+1 00054 0055 IF(ADV.EQ.1.AND.POCC.LE.2) VUN=VUN/2 00055 0056 NETVUN=VUN*ADV*POCC 00056 FORTRAN IV-PLUS V02-51E 13:47:57 12-APR-80 PAGE 16 BG.FTN /TR:BLOCKS/WR 0057 STATUS(4)=STATUS(4)+NETVUN 00057 0058 40 CONTINUE 00058 0059 STATUS(5)=STATUS(1)-STATUS(2)+STATUS(3) 00059 0060 STATUS(6)=STATUS(2)-STATUS(1)+STATUS(4) 00060 0061 IOURS=1 00061 0062 PCNT=0 00062 0063 MCNT=0 00063 0064 DO 50 I=1,26 00064 0065 IBP=BOARD(I) 00065 0066 CNT=IAND(IBP,15) 00066 0067 IF(IBP.EQ.0) GO TO 50 00067 0068 IF(ISHFT(IBP,-4).NE.IOURS) GOTO 50 00068 0069 MCNT=MCNT+CNT 00069 0070 IF(CNT.GT.3) STATUS(6)=STATUS(6)+CNT-3 00070 0071 IF(CNT.LT.2) GO TO 50 00071 0072 PCNT=PCNT+1 00072 0073 50 CONTINUE 00073 0074 STATUS(6)=STATUS(6)-PCNT+MCNT*3 00074 0075 RETURN 00075 0076 END 00076 PROGRAM SECTIONS NAME SIZE ATTRIBUTES $CODE1 002232 589 RW,I,CON,LCL $PDATA 000004 2 RW,D,CON,LCL $IDATA 000046 19 RW,D,CON,LCL $VARS 000054 22 RW,D,CON,LCL $TEMPS 000006 3 RW,D,CON,LCL TOTAL SPACE ALLOCATED = 002366 635 BG,BG=BG