Skip to content

Commit ae82810

Browse files
davidlydavidly
committed
add mt+ pascal v55 files and update jrt pascal benchmark
1 parent 5c81d20 commit ae82810

File tree

5 files changed

+565
-150
lines changed

5 files changed

+565
-150
lines changed

‎ttt/DR MT+ Pascal v55/SIEVE.PAS

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
program sieve;
2+
3+
const
4+
size = 8190;
5+
6+
type
7+
flagType = array[ 0..size ] of boolean;
8+
9+
var
10+
i, k, prime, count, iter : integer;
11+
flags : flagType;
12+
13+
begin
14+
for iter := 1 to 10 do begin
15+
count := 0;
16+
for i := 0 to size do flags[ i ] := true;
17+
for i := 0 to size do begin
18+
if flags[ i ] then begin
19+
prime := i + i + 3;
20+
k := i + prime;
21+
while k <= size do begin
22+
flags[ k ] := false;
23+
k := k + prime;
24+
end;
25+
count := count + 1;
26+
end;
27+
end;
28+
end;
29+
30+
writeln( 'count of primes: ', count );
31+
end.

‎ttt/DR MT+ Pascal v55/e.pas

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
program e;
2+
3+
const
4+
DIGITS = 200;
5+
6+
type
7+
arrayType = array[ 0..DIGITS ] of integer;
8+
9+
var
10+
high, n, x : integer;
11+
a : arrayType;
12+
13+
begin
14+
high := DIGITS;
15+
x := 0;
16+
17+
n := high - 1;
18+
while n > 0 do begin
19+
a[ n ] := 1;
20+
n := n - 1;
21+
end;
22+
23+
a[ 1 ] := 2;
24+
a[ 0 ] := 0;
25+
26+
while high > 9 do begin
27+
high := high - 1;
28+
n := high;
29+
while 0 <> n do begin
30+
a[ n ] := x MOD n;
31+
{ writeln( 'a[n-1] ', a[ n - 1 ] ); }
32+
x := 10 * a[ n - 1 ] + x DIV n;
33+
{ writeln( 'x: ', x, 'n: ', n ); }
34+
n := n - 1;
35+
end;
36+
37+
Write( x );
38+
end;
39+
40+
writeln;
41+
writeln( 'done' );
42+
end.
43+

‎ttt/DR MT+ Pascal v55/m.bat

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
ntvcm mtplus %1 $Z
2+
ntvcm linkmt %1,paslib,fpreals
3+
rem ntvcm linkmt %1,paslib

‎ttt/DR MT+ Pascal v55/tttmtcpm.pas

Lines changed: 288 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,288 @@
1+
(*
2+
App to prove you can't win at Tic-Tac-Toe if the opponent is competent.
3+
Written to target PASCAL/MT+ (80) V5.5 and V5.6.1
4+
Build like this:
5+
ntvcm mtplus %1
6+
ntvcm linkmt %1,paslib/S
7+
*)
8+
9+
{ enable local variables for recursion and optimize }
10+
{$S+ }
11+
{$R- }
12+
{$X- }
13+
14+
program ttt;
15+
16+
const
17+
scoreWin = 6;
18+
scoreTie = 5;
19+
scoreLose = 4;
20+
scoreMax = 9;
21+
scoreMin = 2;
22+
scoreInvalid = 0;
23+
24+
pieceBlank = 0;
25+
pieceX = 1;
26+
pieceO = 2;
27+
28+
iterations = 10;
29+
30+
type
31+
boardType = array[ 0..8 ] of byte;
32+
PSTRING = ^STRING;
33+
34+
var
35+
evaluated: integer;
36+
board: boardType;
37+
38+
var
39+
i, loops: integer;
40+
41+
external function @cmd : PSTRING;
42+
43+
function winner2( move: integer ) : integer;
44+
var
45+
x : integer;
46+
begin
47+
case move of
48+
0: begin
49+
x := board[ 0 ];
50+
if not ( ( ( x = board[1] ) and ( x = board[2] ) ) or
51+
( ( x = board[3] ) and ( x = board[6] ) ) or
52+
( ( x = board[4] ) and ( x = board[8] ) ) )
53+
then x := PieceBlank;
54+
end;
55+
1: begin
56+
x := board[ 1 ];
57+
if not ( ( ( x = board[0] ) and ( x = board[2] ) ) or
58+
( ( x = board[4] ) and ( x = board[7] ) ) )
59+
then x := PieceBlank;
60+
end;
61+
2: begin
62+
x := board[ 2 ];
63+
if not ( ( ( x = board[0] ) and ( x = board[1] ) ) or
64+
( ( x = board[5] ) and ( x = board[8] ) ) or
65+
( ( x = board[4] ) and ( x = board[6] ) ) )
66+
then x := PieceBlank;
67+
end;
68+
3: begin
69+
x := board[ 3 ];
70+
if not ( ( ( x = board[4] ) and ( x = board[5] ) ) or
71+
( ( x = board[0] ) and ( x = board[6] ) ) )
72+
then x := PieceBlank;
73+
end;
74+
4: begin
75+
x := board[ 4 ];
76+
if not ( ( ( x = board[0] ) and ( x = board[8] ) ) or
77+
( ( x = board[2] ) and ( x = board[6] ) ) or
78+
( ( x = board[1] ) and ( x = board[7] ) ) or
79+
( ( x = board[3] ) and ( x = board[5] ) ) )
80+
then x := PieceBlank;
81+
end;
82+
5: begin
83+
x := board[ 5 ];
84+
if not ( ( ( x = board[3] ) and ( x = board[4] ) ) or
85+
( ( x = board[2] ) and ( x = board[8] ) ) )
86+
then x := PieceBlank;
87+
end;
88+
6: begin
89+
x := board[ 6 ];
90+
if not ( ( ( x = board[7] ) and ( x = board[8] ) ) or
91+
( ( x = board[0] ) and ( x = board[3] ) ) or
92+
( ( x = board[4] ) and ( x = board[2] ) ) )
93+
then x := PieceBlank;
94+
end;
95+
7: begin
96+
x := board[ 7 ];
97+
if not ( ( ( x = board[6] ) and ( x = board[8] ) ) or
98+
( ( x = board[1] ) and ( x = board[4] ) ) )
99+
then x := PieceBlank;
100+
end;
101+
8: begin
102+
x := board[ 8 ];
103+
if not ( ( ( x = board[6] ) and ( x = board[7] ) ) or
104+
( ( x = board[2] ) and ( x = board[5] ) ) or
105+
( ( x = board[0] ) and ( x = board[4] ) ) )
106+
then x := PieceBlank;
107+
end;
108+
end;
109+
110+
winner2 := x;
111+
end;
112+
113+
function lookForWinner : byte;
114+
var
115+
t, x : byte;
116+
begin
117+
{dumpBoard;}
118+
x := pieceBlank;
119+
t := board[ 0 ];
120+
if pieceBlank <> t then
121+
begin
122+
if ( ( ( t = board[1] ) and ( t = board[2] ) ) or
123+
( ( t = board[3] ) and ( t = board[6] ) ) ) then
124+
x := t;
125+
end;
126+
127+
if pieceBlank = x then
128+
begin
129+
t := board[1];
130+
if ( t = board[4] ) and ( t = board[7] ) then
131+
x := t
132+
else
133+
begin
134+
t := board[2];
135+
if ( t = board[5] ) and ( t = board[8] ) then
136+
x := t
137+
else
138+
begin
139+
t := board[3];
140+
if ( t = board[4] ) and ( t = board[5] ) then
141+
x := t
142+
else
143+
begin
144+
t := board[6];
145+
if ( t = board[7] ) and ( t = board[8] ) then
146+
x := t
147+
else
148+
begin
149+
t := board[4];
150+
if ( ( t = board[0] ) and ( t = board[8] ) ) then
151+
x := t
152+
else if ( ( t = board[2] ) and ( t = board[6] ) ) then
153+
x := t
154+
end;
155+
end;
156+
end;
157+
end;
158+
end;
159+
160+
lookForWinner := x;
161+
end;
162+
163+
function minmax( alpha: byte; beta: byte; depth: byte; move: byte ): byte;
164+
var
165+
p, value, pieceMove, score : byte;
166+
begin
167+
evaluated := evaluated + 1;
168+
value := scoreInvalid;
169+
if depth >= 4 then
170+
begin
171+
{ p := lookForWinner; }
172+
p := winner2( move );
173+
if p <> pieceBlank then
174+
begin
175+
if p = pieceX then
176+
value := scoreWin
177+
else
178+
value := scoreLose
179+
end
180+
else if depth = 8 then
181+
value := scoreTie;
182+
end;
183+
184+
if value = scoreInvalid then
185+
begin
186+
if Odd( depth ) then
187+
begin
188+
value := scoreMin;
189+
pieceMove := pieceX;
190+
end
191+
else
192+
begin
193+
value := scoreMax;
194+
pieceMove := pieceO;
195+
end;
196+
197+
p := 0;
198+
repeat
199+
if board[ p ] = pieceBlank then
200+
begin
201+
board[ p ] := pieceMove;
202+
score := minmax( alpha, beta, depth + 1, p );
203+
board[ p ] := pieceBlank;
204+
205+
if Odd( depth ) then
206+
begin
207+
{ writeln( 'odd depth, score ', score ); }
208+
if ( score > value ) then
209+
begin
210+
{ writeln( 'score > value, alpha and beta ', score, ' ', value, ' ', alpha, ' ', beta ); }
211+
value := score;
212+
if ( ( value = scoreWin ) or ( value >= beta ) ) then p := 10
213+
else if ( value > alpha ) then alpha := value;
214+
end;
215+
end
216+
else
217+
begin
218+
{ writeln( 'even depth, score ', score ); }
219+
if ( score < value ) then
220+
begin
221+
{ writeln( 'score < value, alpha and beta ', score, ' ', value, ' ', alpha, ' ', beta ); }
222+
value := score;
223+
if ( ( value = scoreLose ) or ( value <= alpha ) ) then p := 10
224+
else if ( value < beta ) then beta := value;
225+
end;
226+
end;
227+
end;
228+
p := p + 1;
229+
until p > 8;
230+
end;
231+
232+
minmax := value;
233+
end;
234+
235+
procedure runit( move : byte );
236+
var
237+
score: byte;
238+
begin
239+
board[move] := pieceX;
240+
score := minmax( scoreMin, scoreMax, 0, move );
241+
board[move] := pieceBlank;
242+
end;
243+
244+
function argAsInt : integer;
245+
var
246+
offset, x, len, result : integer;
247+
CommandString : STRING[ 127 ];
248+
PTR : PSTRING;
249+
begin
250+
result := 0;
251+
PTR := @CMD;
252+
CommandString := PTR^;
253+
len := ORD( CommandString[ 0 ] );
254+
if 0 <> len then
255+
begin
256+
offset := 2;
257+
x := ORD( CommandString[ 2 ] );
258+
while ( ( x >= 48 ) and ( x <= 57 ) ) do
259+
begin
260+
result := result * 10;
261+
result := result + x - 48;
262+
offset := offset + 1;
263+
x := ORD( CommandString[ offset ] );
264+
end;
265+
end;
266+
267+
argAsInt := result;
268+
end;
269+
270+
begin
271+
loops := argAsInt;
272+
if 0 = loops then loops := Iterations;
273+
WriteLn( 'begin, loops ', loops );
274+
275+
for i := 0 to 8 do
276+
board[i] := pieceBlank;
277+
278+
for i := 1 to loops do
279+
begin
280+
evaluated := 0; { once per loop to prevent overflow }
281+
runit( 0 );
282+
runit( 1 );
283+
runit( 4 );
284+
end;
285+
286+
WriteLn( 'moves evaluated: ', evaluated );
287+
WriteLn( 'iterations: ', loops );
288+
end.

0 commit comments

Comments
 (0)