diff --git a/DX-FORTH v430/E.F b/DX-FORTH v430/E.F index 5ab2198..e7a49b4 100644 --- a/DX-FORTH v430/E.F +++ b/DX-FORTH v430/E.F @@ -15,10 +15,12 @@ VARIABLE X ( var x : integer ) 1 - ( high := high - 1; -- high is at the top of the stack) DUP ( n := high; -- put N on the top of the stack ) BEGIN DUP 0 <> WHILE ( while 0 <> n do begin ) - X @ OVER MOD ( x MOD n; -- OVER copies n from one up the stack onto the stack ) + X @ OVER /MOD ( x MOD n; -- OVER copies n from one up the stack onto the stack ) + ROT ( save two divides with /MOD and ROT: stack is now remainder, quotient, index ) + ROT ( and now it's quotient, index, remainder ) OVER ARRAY + C! ( a[ n ] := mod result ) ( statements below are for x := 10 * a[ n - 1 ] + x DIV n; ) - X @ OVER / ( quotient = x DIV n ) + SWAP OVER 1 - ARRAY + C@ ( a[ n - 1 ] ) 10 * + ( 10 * + quotient; ) X ! ( x := ) diff --git a/DX-FORTH v430/SIEVE.F b/DX-FORTH v430/SIEVE.F index f15b4cd..c504836 100644 --- a/DX-FORTH v430/SIEVE.F +++ b/DX-FORTH v430/SIEVE.F @@ -1,17 +1,25 @@ -8190 CONSTANT SIZE -VARIABLE FLAGS SIZE ALLOT +( comments refer to the Pascal implementation ) -: SIEVE - ." primes 10 iterations: " - 10 0 DO - FLAGS SIZE -1 FILL - 0 SIZE 0 DO - I FLAGS + C@ IF - I 2 * 3 + DUP I + BEGIN - DUP SIZE < WHILE - DUP FLAGS + 0 SWAP C! OVER + - REPEAT DROP DROP 1+ - THEN LOOP - LOOP - . ; +8190 CONSTANT SIZE ( const size = 8190; ) +VARIABLE FLAGS SIZE ALLOT ( flagType = array[ 0..size ] of boolean; var flags : flagType ) + +: SIEVE ( program sieve{ OUTPUT }; ) + 10 0 DO ( for iter := 1 to 10 do begin ) + FLAGS SIZE -1 FILL ( for i := 0 to size do flags[ i ] := true; ) + 0 ( count := 0; -- push it on the stack ) + SIZE 0 DO ( for i := 0 to size do begin ) + I FLAGS + C@ IF ( if flags[ i ] then begin -- do loop index is i, c@ reads byte from flags element i ) + I I + 3 + ( prime := i + i + 3; ) + DUP I + ( k := i + prime; -- DUP duplicates the top of stack ) + BEGIN DUP SIZE < WHILE ( while k <= size do begin ) + DUP FLAGS + 0 SWAP C! ( flags[ k ] := false; -- c! writes to address with value both on stack ) + OVER + ( k := k + prime; -- OVER copies second item [prime] to the top ) + REPEAT + DROP DROP ( remove k and prime from stack ) + 1 + ( count := count + 1; -- count is on the top of the stack ) + THEN ( end the if block ) + LOOP + LOOP + ." count of primes: " . ( writeln{ 'count of primes: ', count }; ) + ; ( end. ) diff --git a/DX-FORTH v430/TTT.F b/DX-FORTH v430/TTT.F new file mode 100644 index 0000000..4a1cf9b --- /dev/null +++ b/DX-FORTH v430/TTT.F @@ -0,0 +1,170 @@ +( prove you can't win at tic-tac-toe if the opponent is competent. expected visited board positions: 6493 ) + +VARIABLE board 9 ALLOT +VARIABLE moves +VARIABLE alpha +VARIABLE beta +VARIABLE recursionDepth +VARIABLE piecemove +VARIABLE val +VARIABLE boardIndex +VARIABLE score + +6 CONSTANT scoreWin +5 CONSTANT scoreTie +4 CONSTANT scoreLose +9 CONSTANT scoreMax +2 CONSTANT scoreMin +0 CONSTANT scoreInvalid + +0 CONSTANT pieceBlank +1 CONSTANT pieceX +2 CONSTANT pieceO + +board 0 + CONSTANT B0 +board 1 + CONSTANT B1 +board 2 + CONSTANT B2 +board 3 + CONSTANT B3 +board 4 + CONSTANT B4 +board 5 + CONSTANT B5 +board 6 + CONSTANT B6 +board 7 + CONSTANT B7 +board 8 + CONSTANT B8 + +: LOOKFORWINNER + B0 C@ + DUP pieceBlank <> IF + DUP B1 C@ = IF DUP B2 C@ = IF EXIT THEN THEN + DUP B3 C@ = IF DUP B6 C@ = IF EXIT THEN THEN + THEN + DROP + + B1 C@ + DUP pieceBlank <> IF DUP B4 C@ = IF DUP B7 C@ = IF EXIT THEN THEN THEN + DROP + + B2 C@ + DUP pieceBlank <> IF DUP B5 C@ = IF DUP B8 C@ = IF EXIT THEN THEN THEN + DROP + + B3 C@ + DUP pieceBlank <> IF DUP B4 C@ = IF DUP B5 C@ = IF EXIT THEN THEN THEN + DROP + + B6 C@ + DUP pieceBlank <> IF DUP B7 C@ = IF DUP B8 C@ = IF EXIT THEN THEN THEN + DROP + + B4 C@ + DUP pieceBlank <> IF + DUP B0 C@ = IF DUP B8 C@ = IF EXIT THEN THEN + DUP B2 C@ = IF DUP B6 C@ = IF EXIT THEN THEN + THEN + DROP + + pieceBlank + ; + +: dumpboard + ." board: " + 9 0 DO + I board + C@ . + LOOP + CR + ; + +: MINMAX ( stack: alpha beta ) + 1 moves +! + 0 val ! + + recursionDepth @ 3 > IF + LOOKFORWINNER + DUP pieceBlank <> IF + pieceX = IF scoreWin ELSE scoreLose THEN + val ! + ELSE + DROP recursionDepth @ 8 = IF scoreTie val ! THEN + THEN + THEN + + 0 val @ = IF + recursionDepth @ 1 AND IF + scoreMin val ! + pieceX pieceMove ! + ELSE + scoreMax val ! + pieceO pieceMove ! + THEN + + beta ! + alpha ! + 0 boardIndex ! + + BEGIN boardIndex @ 9 < WHILE + boardIndex @ board + C@ 0 = IF + pieceMove @ board boardIndex @ + C! + boardIndex @ piecemove @ val @ alpha @ beta @ \ save locals on stack + 1 recursionDepth +! + alpha @ beta @ RECURSE + -1 recursionDepth +! + score ! + beta ! alpha ! val ! pieceMove ! boardIndex ! \ restore locals + + pieceBlank boardIndex @ board + C! + + pieceX pieceMove @ = IF + score @ val @ > IF + score @ val ! + scoreWin val @ = val @ beta @ < INVERT OR IF + 10 boardIndex ! + ELSE + val @ alpha @ > IF val @ alpha ! THEN + THEN + THEN + ELSE + score @ val @ < IF + score @ val ! + scoreLose val @ = val @ alpha @ > INVERT OR IF + 10 boardIndex ! + ELSE + val @ beta @ < IF val @ beta ! THEN + THEN + THEN + THEN + THEN + 1 boardIndex +! + REPEAT + ELSE + DROP DROP + THEN + + val @ + ; + +: RUNIT ( move -- ) + pieceX + OVER board + C! \ make the move + 0 recursionDepth ! + scoreMin scoreMax MINMAX + + scoreTie <> IF ." there's a bug somewhere" THEN + + pieceBlank + OVER board + C! \ restore the board to the original state + DROP + ; + +: TTT + + board 9 pieceBlank FILL ( for i := 0 to 8 do board[i] := pieceBlank; ) + + 10 0 DO + 0 moves ! + 0 RUNIT ( runit{ 0 }; ) + 1 RUNIT ( runit{ 1 }; ) + 4 RUNIT ( runit{ 4 }; ) + LOOP + + ." 10 iterations" cr + ." moves evaluated: " MOVES ? CR ( WriteLn{ 'moves evaluated: ', evaluated }; ) +;