dos_compilers/Digital Research PLI-86 v1/TTT.PLI

352 lines
10 KiB
Plaintext
Raw Normal View History

2024-06-30 21:01:25 +02:00
/*
PL/I version of an app that proves you can't win at tic-tac-toe if the opponent is competent.
Written for Digital Research PL/I-86 version 1.0 for MS-DOS
To build (first build PL/I's ms-dos system call wrappers in pcdio.a86)
ntvdm rasm86 pcdio
ntvdm pli %1
ntvdm link86 %1,pcdio.obj
*/
ttt:
proc options( main );
%include 'diomod.dcl';
%replace
ScoreWin by 6,
ScoreTie by 5,
ScoreLose by 4,
ScoreMax by 9,
ScoreMin by 2,
pieceX by 1,
pieceO by 2,
pieceBlank by 0,
DefaultIterations by 1;
dcl board(9) binary(7);
dcl movecount binary;
dcl ( x, iterations, tstart, tend ) binary;
dcl funcs(9) entry variable returns( binary(7) );
dcl thefunc entry variable returns( binary(7) );
funcs( 0 ) = func0;
funcs( 1 ) = func1;
funcs( 2 ) = func2;
funcs( 3 ) = func3;
funcs( 4 ) = func4;
funcs( 5 ) = func5;
funcs( 6 ) = func6;
funcs( 7 ) = func7;
funcs( 8 ) = func8;
iterations = readcommandtail();
if 0 = iterations then
iterations = DefaultIterations;
tstart = getticks();
do x = 1 to iterations;
movecount = 0;
call findsolution( 0 );
call findsolution( 1 );
call findsolution( 4 );
end;
tend = getticks();
put skip list( 'moves: ', movecount );
put skip list( 'iterations: ', iterations );
put skip list( 'hundredths of a second: ', tend - tstart );
stop;
findsolution: proc( move );
dcl move binary(7);
dcl result binary(7);
board( move ) = pieceX;
result = minmax( ScoreMin, ScoreMax, 0, move );
board( move ) = pieceBlank;
end findsolution;
minmax: proc( alpha, beta, depth, move ) returns ( binary(7) ) recursive;
dcl (alpha, beta, depth, move) binary(7);
dcl (value, score, pieceMove, p, m) binary(7);
movecount = movecount + 1;
if depth >= 4 then do;
/*p = winner();*/
/*p = winner2( move );*/
thefunc = funcs( move ); /* can't invoke the function via the array directly due to a compiler bug */
p = thefunc();
if pieceBlank ^= p then do;
if pieceX = p then return ( ScoreWin );
return ( ScoreLose );
end;
if 8 = depth then return ( ScoreTie );
end;
if pieceO = board( move ) then do;
value = ScoreMin;
pieceMove = pieceX;
end;
else do;
value = ScoreMax;
pieceMove = pieceO;
end;
do m = 0 to 8;
if pieceBlank = board( m ) then do;
board( m ) = pieceMove;
score = minmax( alpha, beta, depth + 1, m );
board( m ) = pieceBlank;
if pieceX = pieceMove then do;
/* put skip list ( 'odd depth, score: ', score ); */
if ScoreWin = score then return ( ScoreWin );
if score > value then do;
/* put skip list ( 'score > value, alpha and beta ', score, value, alpha, beta ); */
if score >= beta then return ( score );
value = score;
if value > alpha then alpha = value;
end;
end;
else do;
/* put skip list ( 'even depth, score: ', score ); */
if ScoreLose = score then return ( ScoreLose );
if score < value then do;
/* put skip list ( 'score < value, alpha and beta ', score, value, alpha, beta ); */
if score <= alpha then return ( score );
value = score;
if value < beta then beta = value;
end;
end;
end;
end;
return ( value );
end minmax;
winner: proc returns ( binary(7) );
dcl p binary(7);
p = board( 0 );
if pieceBlank ^= p then do;
if p = board(1) & p = board(2) then return ( p );
if p = board(3) & p = board(6) then return ( p );
end;
p = board(3);
if PieceBlank ^= p & p = board(4) & p = board(5) then return ( p );
p = board(6);
if PieceBlank ^= p & p = board(7) & p = board(8) then return ( p );
p = board(1);
if PieceBlank ^= p & p = board(4) & p = board(7) then return ( p );
p = board(2);
if PieceBlank ^= p & p = board(5) & p = board(8) then return ( p );
p = board(4);
if pieceBlank ^= p then do;
if p = board(0) & p = board(8) then return ( p );
if p = board(2) & p = board(6) then return ( p );
end;
return ( pieceBlank );
end winner;
winner2: proc( m ) returns ( binary(7) );
dcl m binary(7);
dcl v binary(7);
v = board( m );
/* the 'if' expressions below can't be combined or the DOS version of
PL/I generates bad code. */
go to q( m );
q(0):
if ( v = board(1) & v = board(2) ) then return ( v );
if ( v = board(3) & v = board(6) ) then return ( v );
if ( v = board(4) & v = board(8) ) then return ( v );
return ( pieceBlank );
/* this generates bad code from PL/I-86 Compiler Version 1.0 Digital Research, Inc.
if ( ( ( v = board(1) ) & ( v = board(2) ) |
( ( v = board(3) ) & ( v = board(6) ) |
( ( v = board(4) ) & ( v = board(8) ) ) ) then return ( v );
return ( pieceBlank );
*/
q(1):
if ( v = board(0) & v = board(2) ) then return ( v );
if ( v = board(4) & v = board(7) ) then return ( v );
return ( pieceBlank );
q(2):
if ( v = board(0) & v = board(1) ) then return ( v );
if ( v = board(5) & v = board(8) ) then return ( v );
if ( v = board(4) & v = board(6) ) then return ( v );
return ( pieceBlank );
q(3):
if ( v = board(4) & v = board(5) ) then return ( v );
if ( v = board(0) & v = board(6) ) then return ( v );
return ( pieceBlank );
q(4):
if ( v = board(0) & v = board(8) ) then return ( v );
if ( v = board(2) & v = board(6) ) then return ( v );
if ( v = board(1) & v = board(7) ) then return ( v );
if ( v = board(3) & v = board(5) ) then return ( v );
return ( pieceBlank );
q(5):
if ( v = board(3) & v = board(4) ) then return ( v );
if ( v = board(2) & v = board(8) ) then return ( v );
return ( pieceBlank );
q(6):
if ( v = board(7) & v = board(8) ) then return ( v );
if ( v = board(0) & v = board(3) ) then return ( v );
if ( v = board(4) & v = board(2) ) then return ( v );
return ( pieceBlank );
q(7):
if ( v = board(6) & v = board(8) ) then return ( v );
if ( v = board(1) & v = board(4) ) then return ( v );
return ( pieceBlank );
q(8):
if ( v = board(6) & v = board(7) ) then return ( v );
if ( v = board(2) & v = board(5) ) then return ( v );
if ( v = board(0) & v = board(4) ) then return ( v );
return ( pieceBlank );
endq:
return ( pieceBlank );
end winner2;
func0: proc returns ( binary(7) );
dcl p binary(7);
p = board( 0 );
if ( p = board( 1 ) & p = board( 2 ) ) then return( p );
if ( p = board( 3 ) & p = board( 6 ) ) then return( p );
if ( p = board( 4 ) & p = board( 8 ) ) then return( p );
return( 0 );
end func0;
func1: proc returns ( binary(7) );
dcl p binary(7);
p = board( 1 );
if ( p = board( 0 ) & p = board( 2 ) ) then return( p );
if ( p = board( 4 ) & p = board( 7 ) ) then return( p );
return( 0 );
end func1;
func2: proc returns ( binary(7) );
dcl p binary(7);
p = board( 2 );
if ( p = board( 0 ) & p = board( 1 ) ) then return( p );
if ( p = board( 5 ) & p = board( 8 ) ) then return( p );
if ( p = board( 4 ) & p = board( 6 ) ) then return( p );
return( 0 );
end func2;
func3: proc returns ( binary(7) );
dcl p binary(7);
p = board( 3 );
if ( p = board( 4 ) & p = board( 5 ) ) then return( p );
if ( p = board( 0 ) & p = board( 6 ) ) then return( p );
return( 0 );
end func3;
func4: proc returns ( binary(7) );
dcl p binary(7);
p = board( 4 );
if ( p = board( 0 ) & p = board( 8 ) ) then return( p );
if ( p = board( 2 ) & p = board( 6 ) ) then return( p );
if ( p = board( 1 ) & p = board( 7 ) ) then return( p );
if ( p = board( 3 ) & p = board( 5 ) ) then return( p );
return( 0 );
end func4;
func5: proc returns ( binary(7) );
dcl p binary(7);
p = board( 5 );
if ( p = board( 3 ) & p = board( 4 ) ) then return( p );
if ( p = board( 2 ) & p = board( 8 ) ) then return( p );
return( 0 );
end func5;
func6: proc returns ( binary(7) );
dcl p binary(7);
p = board( 6 );
if ( p = board( 7 ) & p = board( 8 ) ) then return( p );
if ( p = board( 0 ) & p = board( 3 ) ) then return( p );
if ( p = board( 4 ) & p = board( 2 ) ) then return( p );
return( 0 );
end func6;
func7: proc returns ( binary(7) );
dcl p binary(7);
p = board( 7 );
if ( p = board( 6 ) & p = board( 8 ) ) then return( p );
if ( p = board( 1 ) & p = board( 4 ) ) then return( p );
return( 0 );
end func7;
func8: proc returns ( binary(7) );
dcl p binary(7);
p = board( 8 );
if ( p = board( 6 ) & p = board( 7 ) ) then return( p );
if ( p = board( 2 ) & p = board( 5 ) ) then return( p );
if ( p = board( 0 ) & p = board( 4 ) ) then return( p );
return( 0 );
end func8;
readcommandtail: proc returns ( binary );
dcl dbuff_ptr pointer,
command character(127) varying based ( dbuff_ptr );
dcl memory (0:256) bit(8) based( dbuff_ptr );
dcl ( r, v, x ) binary;
r = 0;
dbuff_ptr = dbuff();
/*put edit ('Command Tail: ',command) (a);*/
/* command tail is bytes with length, space, and the command-line arguments */
if 0 ^= memory( 0 ) then do;
do x = 2 to 10;
v = memory( x );
if v < 48 | v > 57 then return ( r );
r = ( r * 10 ) + v - 48;
end;
end;
return ( r );
end readcommandtail;
getticks: proc returns ( binary );
dcl ( hour, minute, second, fraction ) binary(7);
call gettime( addr(hour), addr(minute), addr(second), addr(fraction) );
return ( minute * 60 * 100 + second * 100 + fraction );
end getticks;
end ttt;