The Computer Language
Benchmarks Game

mandelbrot Pascal Free Pascal #5 program

source code

{ The Computer Language Benchmarks Game
  http://benchmarksgame.alioth.debian.org

  contributed by Ales Katona
  modified by Vincent Snijders
  optimized and multithreaded by Jean de La Taille
  modified by Jeppe Johansen
  modified by Peter Blackman
      (Restore 'CalculatePoint' as leaf function, better use of registers)
}

program mandelbrot;

uses
  {$ifdef unix}cthreads,{$endif}
  sysUtils, math;

const
  ThreadCount = 4;

var
  nInv: double;
  TextBuf: pbyte; 
  yCounter,
  n, dimx : longint;


function subThread(p: pointer) : ptrint;
var
  Cr, Ci : Double;
  x, y, bits, bit, buf_index: Longint;
  
   function CalculatePoint(Cx, Cy : double): boolean; inline;
   var
     Limit : double = double(4);
     Two   : double = double(2);
     Zr, Zi, Ti, Tr: Double;
     i: longint;

  begin
    Zr := 0;  Zi := Zr; Tr := Zr; Ti := Zr;
    for i := 1 to 50 do begin
      Zi := Two*Zr*Zi + Cy;
      Zr := Tr - Ti + Cx;
      Ti := Zi * Zi;
      Tr := Zr * Zr;
      if (Tr + Ti>=limit) then exit(true);
    end;

    CalculatePoint := false;
  end;
  
  
begin
  while true do
  begin
    y := interlockedincrement(yCounter)-1;

    if y >= n then break;

    buf_index := y*dimx;
    prefetch(TextBuf[buf_index]);

    bit := 128; // 1000 0000
    bits := 0;

    Ci := ((y + y) * nInv) - 1.0;
    for x := 0 to n-1 do
    begin
      Cr := ((x + x) * nInv) - 1.5;
           
      If CalculatePoint (Cr, Ci) then
          bits := bits or bit;
 
      bit := bit >> 1;
      if (bit = 0) then
      begin
        TextBuf[buf_index] := not bits;
        inc(buf_index);

        bits := 0;
        bit := 128;
      end;
    end;
  end;
  subThread := 0;
end;

procedure run;
var
  tt : array[0..ThreadCount-1] of TThreadID;
  i, t, buf_index: Longint;
  
begin
  nInv := 1/n;

  for i := 0 to ThreadCount-1 do
    tt[i] := BeginThread(@subThread, nil);

  for i := 0 to ThreadCount-1 do
    WaitForThreadTerminate(tt[i], 0);

  buf_index := 0;
  i := n*dimx;
  while buf_index < i do
  begin
    t := FileWrite(StdOutputHandle, TextBuf[buf_index], i-buf_index);;
    if t >= 0 then
      buf_index := buf_index + t;
  end;
end;

begin
  Val(ParamStr(1), n);
  write('P4', chr(10), n, ' ', n, chr(10));
  Flush(output);

  dimx := Ceil(n / 8);
  TextBuf := GetMem(dimx*n);

  run;
  freemem(textbuf);
end.
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
Free Pascal Compiler version 3.0.2 [2017/02/05] for x86_64


Fri, 03 Mar 2017 18:23:12 GMT

MAKE:
mv mandelbrot.fpascal-5.fpascal mandelbrot.fpascal-5.pas
/usr/local/src/fpc-3.0.2.x86_64-linux/bin/fpc -FuInclude/fpascal -XXs -O4 -Tlinux  -oFPASCAL_RUN mandelbrot.fpascal-5.pas
Free Pascal Compiler version 3.0.2 [2017/02/05] for x86_64
Copyright (c) 1993-2016 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling mandelbrot.fpascal-5.pas
Linking FPASCAL_RUN
/usr/bin/ld: warning: link.res contains output sections; did you forget -T?
123 lines compiled, 0.2 sec
mv FPASCAL_RUN mandelbrot.fpascal-5.fpascal_run
rm mandelbrot.fpascal-5.pas
0.27s to complete and log all make actions

COMMAND LINE:
./mandelbrot.fpascal-5.fpascal_run 16000

(BINARY) PROGRAM OUTPUT NOT SHOWN