[MSEide-MSEgui-talk] Another MSElang bechmark

[Martin Schreiber]

Hi,

The attached program on Linux-x86:
MSElang with LLVM 3.8.0 -O3

time ./test1.bin

real    0m2.582s
user    0m2.467s
sys     0m0.111s
Binary size 18088 bytes after strip.

FPC 3.0.3 -O3:

time ./test1_fpc

real    0m4.074s
user    0m3.955s
sys     0m0.119s
Binary size 177576 bytes after strip.

Looks good! :-)

Martin

program test1;

{$ifdef FPC}{$mode objfpc}{$h+}{$goto on}{$endif}
const
 stringcount = 2000000;
 defaultmwcseedw = 521288629;
 defaultmwcseedz = 362436069;
type
{$ifdef FPC}
 card8 = byte;
 card32 = cardinal;
 char8 = char;
 string8 = string;
{$endif}
 mwcinfoty = record
  fw,fz: card32; //call checkmwcseed() after init
 end;
 pstring8 = ^string8;
 pcard8 = ^card8;
 ppointer = ^pointer;
 pointerarty = array of pointer;
 arraysortcomparety = function (const l,r: ppointer): int32;
// arraysortcomparety = function (const l,r): int32;

function comparestring(const l,r: ppointer): int32;
var
 pl,pr,pe: pcard8;
 c: int8;
 i1,i2: int32;
begin
 result:= 0;
 pl:= l^;
 pr:= r^;
 if pl <> pr then begin
  if pl = nil then begin
   result:= -1;
  end
  else begin
   if pr = nil then begin
    result:= 1;
   end
   else begin
    i1:= length(string8(pointer(pl)));
    i2:= length(string8(pointer(pr)));
    if i1 < i2 then begin
     pe:= pl+i1;
     while pl < pe do begin
      c:= pl^-pr^;
      if c <> 0 then begin
       result:= c;
       exit;
      end;
      inc(pl);
      inc(pr);
     end;
    end
    else begin
     pe:= pr+i1;
     while pr < pe do begin
      c:= pl^-pr^;
      if c <> 0 then begin
       result:= c;
       exit;
      end;
      inc(pl);
      inc(pr);
     end;
    end;
    result:= i1-i2;
   end;
  end;
 end;
end;

procedure sortarray(var dest: pointerarty; {const} compare: arraysortcomparety);
var
 ar1: pointerarty;
 step: integer;
 l,r,d: ppointer;
 stopl,stopr,stops: ppointer;
 sourcepo,destpo: ppointer;
 acount: integer;
label
 endstep;
begin
 setlength(ar1,length(dest));
 sourcepo:= pointer(dest);
 destpo:= pointer(ar1);
 step:= 1;
 acount:= length(dest);
 while step < acount do begin
  d:= destpo;
  l:= sourcepo;
  r:= sourcepo + step;
  stopl:= r;
  stopr:= r+step;
  stops:= sourcepo + acount;
  if stopr > stops then begin
   stopr:= stops;
  end;
  while true do begin //runs
   while true do begin //steps
    while compare(l,r) <= 0 do begin //merge from left
     d^:= l^;
     inc(l);
     inc(d);
     if l = stopl then begin
      while r <> stopr do begin
       d^:= r^;   //copy rest
       inc(d);
       inc(r);
      end;
      goto endstep;
     end;
    end;
    while compare(l,r) > 0 do begin //merge from right;
     d^:= r^;
     inc(r);
     inc(d);
     if r = stopr then begin
      while l <> stopl do begin
       d^:= l^;   //copy rest
       inc(d);
       inc(l);
      end;
      goto endstep;
     end; 
    end;
   end;
endstep:
   if stopr = stops then begin
    break;  //run finished
   end;
   l:= stopr; //next step
   r:= l + step;
   if r >= stops then begin
    r:= stops-1;
   end;
   if r = l then begin
    d^:= l^;
    break;
   end;
   stopl:= r;
   stopr:= r + step;
   if stopr > stops then begin
    stopr:= stops;
   end;
  end;
  d:= sourcepo;     //swap buffer
  sourcepo:= destpo;
  destpo:= d;
  step:= step*2;
 end;
 if sourcepo <> pointer(dest) then begin
  dest:= ar1;
 end;
end;


function mwcnoise(var state: mwcinfoty): card32;
begin
 with state do begin
  fz:= 36969 * (fz and $ffff) + (fz shr 16);
  fw:= 18000 * (fw and $ffff) + (fw shr 16);
  result:= fz shl 16 + fw;
 end;
end;

procedure test1();
var
 mwc: mwcinfoty;
 ar1: array of string8;
 i1,i2: int32;
 ch1: char8;
begin
 mwc.fw:= defaultmwcseedw;
 mwc.fz:= defaultmwcseedz;
 setlength(ar1,stringcount);
 for i1:= 0 to high(ar1) do begin
  mwcnoise(mwc);
  setlength(ar1[i1],card8(mwcnoise(mwc)));
  for i2:= 1 to length(ar1[i1]) do begin
   ch1:= char8(card8(((mwcnoise(mwc) and $ff) * 95) div 255 + 32)); //32..127
   ar1[i1][i2]:= ch1;
  end;
 end;
 sortarray(pointerarty(pointer(ar1)),@comparestring);
 for i1:= 1 to high(ar1) do begin
{
  if ar1[i1] = '' then begin
   writeln(i1,':');
  end
  else begin
   writeln(i1,':',card8(ar1[i1][1]),': ', ar1[i1]);
  end;
}
  if ar1[i1-1] > ar1[i1] then begin
   exitcode:= 1;
   exit;
  end;
 end; 
end;


begin
 test1();
end.

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
mseide-msegui-talk mailing list
mseide-msegui-talk@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mseide-msegui-talk