Re: [fpc-devel] shootout - mandelbrot
DarekM schrieb: > Hi > In attachment is my proposition of mandelbrot program. It is about 5% > faster. You can hand it in yourself. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel
[fpc-devel] shootout - mandelbrot
Hi
In attachment is my proposition of mandelbrot program. It is about 5%
faster.
changed:
1. output result
2. condition of limit move inner to loop
Darek
{ The Computer Language Shootout
http://shootout.alioth.debian.org
contributed by Ales Katona
modified by Vincent Snijders
}
program mandelbrot;
{$FPUTYPE SSE2}{$I-}
var n, x, y, bits,bit: Longint;
Cx, Cy: double;
procedure CalculatePoint; nostackframe;
const
Limit: double =4.0;
zero: double = 0.0;
var
i: longint;
GC,
Zr, Zi, Ti, Tr: Double;
begin
Zr := zero; Zi := Zr;
Tr := Zr; Ti := Zi;
GC := Limit;
i := 50;
repeat
Zi := 2 * Zr * Zi + Cy;
Zr := Tr - Ti + Cx;
Tr := Zr * Zr;
Ti := Zi * Zi;
if (Tr + Ti) >= GC then begin
bits := bits xor bit;
exit;
end;
dec(i);
until (i=0);
end;
{$FPUTYPE X87}
var
ss : shortstring;
bb : byte absolute ss;
textbuf:array[0..8191] of char;
procedure writeSS;
begin
write(ss);
end;
procedure writech( const ch : char);inline;
begin
if length(ss)=250 then begin
writess;
bb:=1;
end else begin
inc(bb);
end;
ss[bb]:=ch;
end;
begin
Val(ParamStr(1), n);
settextbuf(output,textbuf,sizeof(textbuf));
writeln('P4');
writeln(n,' ',n);
ss:='';
for y := 0 to n-1 do
begin
Cy := y * 2 / n - 1;
bits := 255; bit := 128;
for x := 0 to n-1 do
begin
Cx := x * 2 / n - 1.5;
CalculatePoint;
if bit > 1 then
bit := bit shr 1
else
begin
writech(chr(bits));
bits := 255; bit := 128;
end;
end;
if bit < 128 then writech(chr(bits xor((bit shl 1)-1)));
end;
write(ss);
end.
___
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
Re: [fpc-devel] Shootout
Daniël Mantione wrote: Op Sat, 30 Sep 2006, schreef Marc Weustink: Daniël Mantione wrote: Hi, Encouraged by Vincent I made an attempt to implement the Chameneos benchmark of the Shootout. ??? Last week I submitted chamenos to shootout and it got accepted. Argh, then we have been double work :) It's only the work of one night, so it might need some improvement (it' isn't faster that the C implementation for instance) Mine neither :/ If people are willing to help, I have some suggestions: Create headers for gmp, so we can use gmp instead my own hacked bigint library. There is an header for gpc, but I don't know how compitable it is to fpc: http://www.mingw.org/cgi-bin/info2html/info2html?(gpc.info)GMP Write a working regexpr engine. The one packages doesn't support looking for expressions that contain a "|" for example "ab|c". Vincent ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel
Re: [fpc-devel] Shootout
Op Sat, 30 Sep 2006, schreef Marc Weustink: > Daniël Mantione wrote: > > Hi, > > > > Encouraged by Vincent I made an attempt to implement the Chameneos > > benchmark of the Shootout. > > ??? Last week I submitted chamenos to shootout and it got accepted. Argh, then we have been double work :) > It's only the work of one night, so it might need some improvement (it' > isn't faster that the C implementation for instance) Mine neither :/ Daniël___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel
Re: [fpc-devel] Shootout
Daniël Mantione wrote: > Hi, > > Encouraged by Vincent I made an attempt to implement the Chameneos > benchmark of the Shootout. ??? Last week I submitted chamenos to shootout and it got accepted. It's only the work of one night, so it might need some improvement (it' isn't faster that the C implementation for instance) Marc ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel
[fpc-devel] Shootout
Hi,
Encouraged by Vincent I made an attempt to implement the Chameneos
benchmark of the Shootout. It turned out to be really hard, because we
don't have real semafores (which makes it for example impossible to
translate the C version).
However, with the RTLevent* routines, it is possible to implement it.
I have a final problem I'm unable to solve at this time. When all threads
exit, one of the threads still hangs in a RTLeventwaitfor call. We don't
know which one.
The trick is to get it out of its wait state in a safe way. My currect
solution (a set event call when the end is eached) sometimes fails,
depending on the weather or something.
If anyone wants to take a look, the source is attached.
Daniëlprogram chameneos;
uses sysutils
{$ifdef unix}
,cthreads
{$endif};
type colour=(blue,red,yellow,fade);
chamid=0..3;
var complement:array[colour,colour] of colour=
((blue,yellow,red,fade),
(yellow,red,blue,fade),
(red,blue,yellow,fade),
(fade,fade,fade,fade));
meet_event:PRTLevent;
tid:array[chamid] of Tthreadid;
const cham_colours:array[chamid] of colour=(blue,red,yellow,blue);
meetings:longint=0;
meetings_left:longint=100;
first_call:boolean=true;
state:longint=0;
var first,second:colour;
function other_creatures_colour(id:chamid;c:colour):colour;
begin
other_creatures_colour:=fade;
if meetings_left<>0 then
begin
if interlockedincrement(state) and 1<>0 then
begin
other_creatures_colour:=first;
second:=c;
RTLeventsetevent(meet_event);
dec(meetings_left);
end
else
begin
RTLeventstartwait(meet_event);
first:=c;
RTLeventwaitfor(meet_event);
other_creatures_colour:=second;
end
end
else
RTLeventsetevent(meet_event); {!!! Not trusted!}
end;
function chameneos(parameter:pointer):ptrint;
var id:chamid;
other:colour;
begin
id:=ptrint(parameter);
while cham_colours[id]<>fade do
begin
other:=other_creatures_colour(id,cham_colours[id]);
if other=fade then
cham_colours[id]:=fade
else
begin
cham_colours[id]:=complement[cham_colours[id],other];
inc(meetings);
end;
end;
chameneos:=0;
end;
var i:chamid;
begin
if paramcount>=1 then
val(paramstr(1),meetings_left);
meet_event:=RTLeventcreate;
for i:=low(chamid) to high(chamid) do
tid[i]:=beginthread(@chameneos,pointer(ptrint(i)));
for i:=low(chamid) to high(chamid) do
waitforthreadterminate(tid[i],0);
RTLeventdestroy(meet_event);
writeln(meetings);
end.
___
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
