OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add ttt benmchmark and comments to other benchmarks

Browse Source
This commit is contained in:
davidly 2024-07-10 12:11:53 -07:00
parent d23c014f5b
commit d40e777a08
3 changed files with 197 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
DX-FORTH v430/E.F
View File

@ -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 * <array value> + quotient; )
X ! ( x := <math> )

36
DX-FORTH v430/SIEVE.F
View File

@ -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
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. )

170
DX-FORTH v430/TTT.F Normal file
View File

@ -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 }; )
;