Forum > FPC development
CompareText improvement
PascalDragon:
--- Quote from: edgarrod71 on March 23, 2023, 07:49:41 pm ---@Martin_fr I know that, it's simply a replacement for CompareText or an option to it.
--- End quote ---
It is not a replacement, because CompareText can be used for sorting, yours can not. And it won't be added as an alternative, because there already is the existing CompareText.
edgarrod71:
I'm not saying you're wrong... but! Inside fpcsrc there are 246 calls to CompareText and in Lazarus source code there are 180+ (depending on the components you install) and not all of them are meant for sorting!
When both strings are the same, benchmarks give us 10% aprox. but when they are different benchmark give us more than 90% of acceleration depending on what we want to achieve. For instance, I discovered there was a problem with RegisterFileLocation on weblaz and when I saw another error on it, I found that CompareText is not the best solution.
So, I think we must put ego out and take a humbling sight, our community will be benefit on faster apps.
wp:
10% only if every program would consist only of CompareText calls! Your improvement will not be detectable in practice. Conversely, such micro-optimization usually introduces new bugs.
domasz:
How about working in 32/64 bits? Perhaps I am not seeing some details but something like below should be faster:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function AnsiCompare(S1,S2: String);var A1: array of Int64; B1: array of Int64;begin SetLength... FillChar... Move(S1[1], A1[0], Length(S1)); Move(S2[1], A2[0], Length(S2)); for i:=0 to Length-1 do if A1[i] < A2[i] then ...end;
edgarrod71:
@domasz, looking above the lake, water seems to be delicious, nevertheless, going deep, I found that this calls all of these:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---const MB_CUR_MAX = 10; type TFoT = (Falso, Verdadero); wint_t = longint; clonglong = wint_t; mbstate_t = record case byte of 0: (__mbstate8: array[0..127] of char); 1: (_mbstateL: clonglong); { for alignment } end; size_t = qword; wchar_t = longint; pmbstate_t = ^mbstate_t; function wcrtomb(s: pchar; wc: wchar_t; ps: pmbstate_t): size_t; cdecl; external clib name 'wcrtomb'; procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;begin if (len>length(s)) then if (length(s) < 10*256) then setlength(s,length(s)+10) else setlength(s,length(s)+length(s) shr 8);end; procedure ConcatCharToAnsiStr(const c: char; var S: AnsiString; var index: SizeInt);begin EnsureAnsiLen(s,index); pchar(@s[index])^:=c; inc(index);end; { concatenates an utf-32 char to a widestring. S *must* be unique when entering. }{$if not(defined(beos) and not defined(haiku))}procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt; var mbstate: mbstate_t);{$else not beos}procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt);{$endif beos}var p : pchar; mblen : size_t;begin { we know that s is unique -> avoid uniquestring calls} p:=@s[index]; if (nc<=127) then ConcatCharToAnsiStr(char(nc),s,index) else begin EnsureAnsiLen(s,index+MB_CUR_MAX);{$if not(defined(beos) and not defined(haiku))} mblen:=wcrtomb(p,wchar_t(nc),@mbstate);{$else not beos} mblen:=wctomb(p,wchar_t(nc));{$endif not beos} if (mblen<>size_t(-1)) then inc(index,mblen) else begin { invalid wide char } p^:='?'; inc(index); end; end;end; function UpperAnsiString(const s : AnsiString) : AnsiString; var i, slen, resindex : SizeInt; mblen : size_t;{$if not(defined(beos) and not defined(haiku))} ombstate, nmbstate : mbstate_t;{$endif beos} wc : wchar_t; begin{$if not(defined(beos) and not defined(haiku))} fillchar(ombstate,sizeof(ombstate),0); fillchar(nmbstate,sizeof(nmbstate),0);{$endif beos} slen:=length(s); SetLength(result,slen+10); i:=1; resindex:=1; while (i<=slen) do begin if (s[i]<=#127) then begin wc:=wchar_t(s[i]); mblen:= 1; end else{$if not(defined(beos) and not defined(haiku))} mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);{$else not beos} mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);{$endif beos} case mblen of size_t(-2): begin { partial invalid character, copy literally } while (i<=slen) do begin ConcatCharToAnsiStr(s[i],result,resindex); inc(i); end; end; size_t(-1), 0: begin { invalid or null character } ConcatCharToAnsiStr(s[i],result,resindex); inc(i); end; else begin { a valid sequence } { even if mblen = 1, the uppercase version may have a } { different length } { We can't do anything special if wchar_t is 16 bit... }{$if not(defined(beos) and not defined(haiku))} ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);{$else not beos} ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);{$endif not beos} inc(i,mblen); end; end; end; SetLength(result,resindex-1); end; function StrCompAnsiIntern(s1,s2 : PChar; len1, len2: PtrInt; canmodifys1, canmodifys2: boolean): PtrInt; var a,b: pchar; i: PtrInt; begin if not(canmodifys1) then getmem(a,len1+1) else a:=s1; for i:=0 to len1-1 do if s1[i]<>#0 then a[i]:=s1[i] else a[i]:=#32; a[len1]:=#0; if not(canmodifys2) then getmem(b,len2+1) else b:=s2; for i:=0 to len2-1 do if s2[i]<>#0 then b[i]:=s2[i] else b[i]:=#32; b[len2]:=#0; result:=strcoll(a,b); if not(canmodifys1) then freemem(a); if not(canmodifys2) then freemem(b); end; function AnsiCompareText(const S1, S2: ansistring): PtrInt; var a, b: AnsiString; begin a:=UpperAnsistring(s1); b:=UpperAnsistring(s2); result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b),true,true); end;
So I think it is not faster... :(
Navigation
[0] Message Index
[#] Next page
[*] Previous page