https://gitlab.com/mseide-msegui/mselan ... ng_objects
MSElang Objekte vereinen FPC "record", "object" und "class". Sie können sowohl auf dem Stack als auch im Heap instantiiert werden.
Was meint ihr dazu?
Hier ein weiterer Leistungsvergleich auf Linux X86, Testprogramm im Anhang:
Code: Alles auswählen
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 26072 bytes after strip.
Code: Alles auswählen
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.