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

make a TTT.ADA that works with the buggy a86 compiler

Browse Source
This commit is contained in:
davidly 2024-07-08 13:22:02 -07:00
parent 52c763c19b
commit b4d04e44b4
2 changed files with 104 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

214
Artek Ada v125/TTT.ADA
View File

@ -1,6 +1,7 @@
-- Note: The AI interpreter produces correct results. -- Note: this code passes "board" as an arguments instead of using a global variable because
-- The a86 compiler produces inconsistent offsets for accessing "board" and ttt fails to run properly. -- while the AI interpreter produces correct results both ways, the A86 compiler produces
-- I tried a variety of work-arounds, but they all failed to actually work. -- inconsistent offsets for accessing "board" as a global variable and ttt fails to run properly.
-- Ada (well, this version) prohibits in+out arguments to functions, so procedures are used instead.
with TEXT_IO; use TEXT_IO; with TEXT_IO; use TEXT_IO;
@ -20,154 +21,144 @@ PieceBlank : Constant := 0;
moves : integer; moves : integer;
type TTTBoardType is array (integer range 0..8) of integer; type TTTBoardType is array (integer range 0..8) of integer;
board : TTTBoardType;
function LookForWinner return integer is procedure LookForWinner( board : in TTTBoardType; p : in out integer ) is
p : integer;
begin begin
p := board(0); p := board(0);
if ( PieceBlank /= p and p = board(1) and p = board(2) ) then return p; end if; if ( PieceBlank /= p ) then
if ( PieceBlank /= p and p = board(3) and p = board(6) ) then return p; end if; if ( p = board(1) and p = board(2) ) then return; end if;
if ( p = board(3) and p = board(6) ) then return; end if;
end if;
p := board(3); p := board(3);
if ( ( PieceBlank /= p ) and ( p = board(4) ) and ( p = board(5) ) ) then return p; end if; if ( ( PieceBlank /= p ) and ( p = board(4) ) and ( p = board(5) ) ) then return; end if;
p := board(6); p := board(6);
if ( ( PieceBlank /= p ) and ( p = board(7) ) and ( p = board(8) ) ) then return p; end if; if ( ( PieceBlank /= p ) and ( p = board(7) ) and ( p = board(8) ) ) then return; end if;
p := board(1); p := board(1);
if ( PieceBlank /= p and p = board(4) and p = board(7) ) then return p; end if; if ( PieceBlank /= p and p = board(4) and p = board(7) ) then return; end if;
p := board(2); p := board(2);
if ( PieceBlank /= p and p = board(5) and p = board(8) ) then return p; end if; if ( PieceBlank /= p and p = board(5) and p = board(8) ) then return; end if;
p := board(4); p := board(4);
if ( PieceBlank /= p and p = board(0) and p = board(8) ) then return p; end if; if ( PieceBlank /= p ) then
if ( PieceBlank /= p and p = board(2) and p = board(6) ) then return p; end if; if ( p = board(0) and p = board(8) ) then return; end if;
if ( p = board(2) and p = board(6) ) then return; end if;
end if;
return PieceBlank; p := PieceBlank;
end LookForWinner; end LookForWinner;
function pos0func return integer is procedure pos0func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 0 ); p := board( 0 );
if ( ( x = board(1) and x = board(2) ) or if ( ( p = board(1) and p = board(2) ) or
( x = board(3) and x = board(6) ) or ( p = board(3) and p = board(6) ) or
( x = board(4) and x = board(8) ) ) then return x; end if; ( p = board(4) and p = board(8) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos0func; end pos0func;
function pos1func return integer is procedure pos1func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 1 ); p := board( 1 );
if ( ( x = board(0) and x = board(2) ) or if ( ( p = board(0) and p = board(2) ) or
( x = board(4) and x = board(7) ) ) then return x; end if; ( p = board(4) and p = board(7) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos1func; end pos1func;
function pos2func return integer is procedure pos2func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 2 ); p := board( 2 );
if ( ( x = board(0) and x = board(1) ) or if ( ( p = board(0) and p = board(1) ) or
( x = board(5) and x = board(8) ) or ( p = board(5) and p = board(8) ) or
( x = board(4) and x = board(6) ) ) then return x; end if; ( p = board(4) and p = board(6) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos2func; end pos2func;
function pos3func return integer is procedure pos3func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 3 ); p := board( 3 );
if ( ( x = board(4) and x = board(5) ) or if ( ( p = board(4) and p = board(5) ) or
( x = board(0) and x = board(6) ) ) then return x; end if; ( p = board(0) and p = board(6) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos3func; end pos3func;
function pos4func return integer is procedure pos4func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 4 ); p := board( 4 );
if ( ( x = board(0) and x = board(8) ) or if ( ( p = board(0) and p = board(8) ) or
( x = board(2) and x = board(6) ) or ( p = board(2) and p = board(6) ) or
( x = board(1) and x = board(7) ) or ( p = board(1) and p = board(7) ) or
( x = board(3) and x = board(5) ) ) then return x; end if; ( p = board(3) and p = board(5) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos4func; end pos4func;
function pos5func return integer is procedure pos5func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 5 ); p := board( 5 );
if ( ( x = board(3) and x = board(4) ) or if ( ( p = board(3) and p = board(4) ) or
( x = board(2) and x = board(8) ) ) then return x; end if; ( p = board(2) and p = board(8) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos5func; end pos5func;
function pos6func return integer is procedure pos6func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 6 ); p := board( 6 );
if ( ( x = board(7) and x = board(8) ) or if ( ( p = board(7) and p = board(8) ) or
( x = board(0) and x = board(3) ) or ( p = board(0) and p = board(3) ) or
( x = board(4) and x = board(2) ) ) then return x; end if; ( p = board(4) and p = board(2) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos6func; end pos6func;
function pos7func return integer is procedure pos7func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 7 ); p := board( 7 );
if ( ( x = board(6) and x = board(8) ) or if ( ( p = board(6) and p = board(8) ) or
( x = board(1) and x = board(4) ) ) then return x; end if; ( p = board(1) and p = board(4) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos7func; end pos7func;
function pos8func return integer is procedure pos8func( board : in TTTBoardType; p : in out integer ) is
x : integer;
begin begin
x := board( 8 ); p := board( 8 );
if ( ( x = board(6) and x = board(7) ) or if ( ( p = board(6) and p = board(7) ) or
( x = board(2) and x = board(5) ) or ( p = board(2) and p = board(5) ) or
( x = board(0) and x = board(4) ) ) then return x; end if; ( p = board(0) and p = board(4) ) ) then return; end if;
return PieceBlank; p := PieceBlank;
end pos8func; end pos8func;
function MinMax( alphaarg : in integer; betaarg : in integer; depth : in integer; procedure MinMax( alphaarg : in integer; betaarg : in integer;
move : in integer ) return integer is depth : in integer; move : in integer;
alpha, beta, p, value, score, pieceMove : integer; board : in out TTTBoardType; score : out integer ) is
sc, alpha, beta, p, value, pieceMove : integer;
begin begin
-- Put( "Moves: " ); Put( INTEGER'IMAGE( moves ) ); New_line;
-- Put( " Depth: " ); Put( INTEGER'IMAGE( depth ) ); New_line;
-- Put( " Move: " ); Put( INTEGER'IMAGE( move ) ); New_line;
-- ShowBoard;
moves := moves + 1; moves := moves + 1;
if ( depth >= 4 ) then if ( depth >= 4 ) then
-- p := LookForWinner; -- this is much slower than the posXfunc solution --LookForWinner( board, p ); -- this is much slower than the posXfunc solution
case move is case move is
when 0 => p := pos0func; when 0 => pos0func( board, p );
when 1 => p := pos1func; when 1 => pos1func( board, p );
when 2 => p := pos2func; when 2 => pos2func( board, p );
when 3 => p := pos3func; when 3 => pos3func( board, p );
when 4 => p := pos4func; when 4 => pos4func( board, p );
when 5 => p := pos5func; when 5 => pos5func( board, p );
when 6 => p := pos6func; when 6 => pos6func( board, p );
when 7 => p := pos7func; when 7 => pos7func( board, p );
when 8 => p := pos8func; when 8 => pos8func( board, p );
when others => Put( "invalid move!" ); when others => Put( "invalid move!" ); -- the compiler needs a when others
end case; end case;
if ( PieceBlank /= p ) then if ( PieceBlank /= p ) then
if ( PieceX = p ) then return ScoreWin; end if; if ( PieceX = p ) then score := ScoreWin; return; end if;
return ScoreLose; score := ScoreLose;
return;
end if; end if;
if ( 8 = depth ) then return ScoreTie; end if; if ( 8 = depth ) then score := ScoreTie; return; end if;
end if; end if;
alpha := alphaarg; alpha := alphaarg;
@ -184,39 +175,38 @@ begin
for p in 0..8 loop for p in 0..8 loop
if ( PieceBlank = board( p ) ) then if ( PieceBlank = board( p ) ) then
board( p ) := pieceMove; board( p ) := pieceMove;
score := MinMax( alpha, beta, depth + 1, p ); MinMax( alpha, beta, depth + 1, p, board, sc );
board( p ) := pieceBlank; board( p ) := pieceBlank;
if ( PieceX = pieceMove ) then if ( PieceX = pieceMove ) then
if ( score = ScoreWin ) then return ScoreWin; end if; if ( sc = ScoreWin ) then score := ScoreWin; return; end if;
if ( score > value ) then if ( sc > value ) then
if ( score >= beta ) then return score; end if; if ( sc >= beta ) then score := sc; return; end if;
value := score; value := sc;
if ( value > alpha ) then alpha := value; end if; if ( value > alpha ) then alpha := value; end if;
end if; end if;
else else
if ( score = ScoreLose ) then return ScoreLose; end if; if ( sc = ScoreLose ) then score := ScoreLose; return; end if;
if ( score < value ) then if ( sc < value ) then
if ( score <= alpha ) then return score; end if; if ( sc <= alpha ) then score := sc; return; end if;
value := score; value := sc;
if ( value < beta ) then beta := value; end if; if ( value < beta ) then beta := value; end if;
end if; end if;
end if; end if;
end if; end if;
end loop; end loop;
return value; score := value;
end MinMax; end MinMax;
procedure FindSolution( move : in integer ) is procedure FindSolution( move : in integer ) is
z, x, score : integer; board : TTTBoardType;
score : integer;
begin begin
for z in board'range loop board := ( others => PieceBlank );
board( z ) := PieceBlank;
end loop;
board( move ) := PieceX; board( move ) := PieceX;
score := MinMax( ScoreMin, ScoreMax, 0, move ); MinMax( ScoreMin, ScoreMax, 0, move, board, score );
end FindSolution; end FindSolution;
i, iterations : integer; i, iterations : integer;

4
Artek Ada v125/m.bat
View File

@ -9,8 +9,8 @@ rem interpreter
ntvdm -c -p ai %1 ntvdm -c -p ai %1
rem native code. I've found a86 to be buggy. rem native code. I've found a86 to be buggy.
rem note: a86 produces bad code for ttt.ada. it uses inconsistent addresses for the "board" array. rem note: a86 produces bad code for the stock ttt.ada so the board is passed as an argument.
rem note2: a86 produces bad code for e.ada but the workaround to use more local variables worked. rem note2: a86 produces bad code for the stock e.ada so more locals were added to reduce complexity.
del %1.exe 2>nul del %1.exe 2>nul
ntvdm a86 %1.axe /n ntvdm a86 %1.axe /n
ntvdm -c -p %1.exe ntvdm -c -p %1.exe