source code
(* The Computer Language Benchmarks Game
https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
- Based on "Go #4" by Martin Koistinen
- Contributed by Akira1364
*)
program Mandelbrot;
uses CMem, {$IFDEF UNIX}CThreads,{$ENDIF} SysUtils, Math, PasMP;
const
Limit = 4.0;
MaxIter = 50;
Size: Int32 = 200;
var
BytesPerRow: Int32;
Rows: array of array of Byte;
Initial_R, Initial_I: array of Double;
procedure RenderRows(const Job: PPasMPJob;
const ThreadIndex: Int32;
const Data: Pointer;
const FromIndex, ToIndex: SizeInt); inline;
var
Res, B: Byte;
XByte, I, J, X: Int32;
Index: SizeInt;
ZRA, ZRB, ZIA, ZIB, TRA, TRB,
TIA, TIB, CRA, CRB, CI: Double;
begin
for Index := FromIndex to ToIndex do begin
SetLength(Rows[Index], BytesPerRow);
for XByte := 0 to Pred(BytesPerRow) do begin
Res := 0;
I := 0;
CI := Initial_I[Index];
repeat
X := XByte shl 3;
CRA := Initial_R[X + I];
CRB := Initial_R[X + I + 1];
ZRA := CRA;
ZIA := CI;
ZRB := CRB;
ZIB := CI;
B := 0;
for J := 0 to Pred(MaxIter) do begin
TRA := ZRA * ZRA;
TIA := ZIA * ZIA;
ZIA := 2 * ZRA * ZIA + CI;
ZRA := TRA - TIA + CRA;
if TRA + TIA > Limit then begin
B := B or 2;
if B = 3 then Break;
end;
TRB := ZRB * ZRB;
TIB := ZIB * ZIB;
ZIB := 2 * ZRB * ZIB + CI;
ZRB := TRB - TIB + CRB;
if TRB + TIB > Limit then begin
B := B or 1;
if B = 3 then Break;
end;
end;
Res := (Res shl 2) or B;
I += 2;
until I = 8;
Rows[Index][XByte] := not Res;
end;
end;
end;
var
Inv, InvScaled: Double;
XY, Y: SizeInt;
IO: PText;
begin
SetExceptionMask([exInvalidOp, exOverflow, exPrecision]);
if ParamCount > 0 then Val(ParamStr(1), Size);
SetLength(Initial_R, Size);
SetLength(Initial_I, Size);
Inv := 2.0 / Double(Size);
for XY := 0 to Pred(Size) do begin
InvScaled := Inv * Double(XY);
Initial_R[XY] := InvScaled - 1.5;
Initial_I[XY] := InvScaled - 1.0;
end;
BytesPerRow := Size shr 3;
SetLength(Rows, Size);
with TPasMP.CreateGlobalInstance() do
Invoke(ParallelFor(nil, 0, Pred(Size), @RenderRows));
IO := @Output;
Write(IO^, 'P4', #10, Size, ' ', Size, #10);
Flush(IO^);
for Y := 0 to Pred(Size) do
FileWrite(StdOutputHandle, Rows[Y][0], BytesPerRow);
end.
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
Free Pascal Compiler
version 3.2.2 [2021/05/16]
Wed, 22 May 2024 20:49:12 GMT
MAKE:
mv mandelbrot.fpascal-7.fpascal mandelbrot.fpascal-7.pas
/opt/src/fpc-3.2.2/bin/fpc -FuInclude/fpascal -XXs -O3 -Ci- -Cr- -g- -CpCOREAVX -CfAVX -Tlinux -oFPASCAL_RUN mandelbrot.fpascal-7.pas
Free Pascal Compiler version 3.2.2 [2021/05/16] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling mandelbrot.fpascal-7.pas
mandelbrot.fpascal-7.pas(92,5) Note: Call to subroutine "function TPasMP.GetJobWorkerThread:TPasMPJobWorkerThread;" marked as inline is not inlined
mandelbrot.fpascal-7.pas(92,5) Note: Call to subroutine "procedure TPasMP.PushJob(const Job:PPasMPJob;const JobWorkerThread:TPasMPJobWorkerThread);" marked as inline is not inlined
Linking FPASCAL_RUN
Warning: "crtbegin.o" not found, this will probably cause a linking failure
Warning: "crtend.o" not found, this will probably cause a linking failure
97 lines compiled, 1.5 sec
2 warning(s) issued
2 note(s) issued
mv FPASCAL_RUN mandelbrot.fpascal-7.fpascal_run
rm mandelbrot.fpascal-7.pas
1.81s to complete and log all make actions
COMMAND LINE:
./mandelbrot.fpascal-7.fpascal_run 16000
(BINARY) PROGRAM OUTPUT NOT SHOWN