From 8498eacdeb34d2b8cbffb24553914ac8af91912c Mon Sep 17 00:00:00 2001 From: Rika Ichinose Date: Mon, 4 Nov 2024 07:52:15 +0300 Subject: [PATCH] Remove unused cutils functions. --- compiler/cutils.pas | 281 +----------------------------------------- compiler/htypechk.pas | 104 ++++++++-------- 2 files changed, 53 insertions(+), 332 deletions(-) diff --git a/compiler/cutils.pas b/compiler/cutils.pas index aed869953b..42afe93aa4 100644 --- a/compiler/cutils.pas +++ b/compiler/cutils.pas @@ -156,13 +156,6 @@ interface } function lowercase(c : char) : char; - { makes zero terminated string to a pascal string } - { the data in p is modified and p is returned } - function pchar2pshortstring(p : pchar) : pshortstring; - - { inverse of pchar2pshortstring } - function pshortstring2pchar(p : pshortstring) : pchar; - { allocate a new pchar with the contents of a} function ansistring2pchar(const a: ansistring) : pchar; @@ -171,12 +164,6 @@ interface function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint; function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar; - {Lzw encode/decode to compress strings -> save memory.} - function minilzw_encode(const s:string):string; - function minilzw_decode(const s:string):string; - - Function nextafter(x,y:double):double; - function LengthUleb128(a: qword) : byte; function LengthSleb128(a: int64) : byte; function EncodeUleb128(a: qword;out buf;len: byte) : byte; @@ -776,10 +763,10 @@ implementation if (length(needle)=0) or (length(needle)>length(haystack)) then exit; - result:=length(haystack)-length(needle); + result:=length(haystack)-length(needle)+1; repeat if (haystack[result]=needle[1]) and - (copy(haystack,result,length(needle))=needle) then + (CompareByte(haystack[result],needle[1],length(needle))=0) then exit; dec(result); until result=0; @@ -1158,30 +1145,6 @@ implementation end; - function pchar2pshortstring(p : pchar) : pshortstring; - var - w,i : longint; - begin - w:=strlen(p); - for i:=w-1 downto 0 do - p[i+1]:=p[i]; - p[0]:=chr(w); - pchar2pshortstring:=pshortstring(p); - end; - - - function pshortstring2pchar(p : pshortstring) : pchar; - var - w,i : longint; - begin - w:=length(p^); - for i:=1 to w do - p^[i-1]:=p^[i]; - p^[w]:=#0; - pshortstring2pchar:=pchar(p); - end; - - function ansistring2pchar(const a: ansistring) : pchar; var len: ptrint; @@ -1335,252 +1298,12 @@ implementation end; -{***************************************************************************** - Ultra basic KISS Lzw (de)compressor -*****************************************************************************} - - {This is an extremely basic implementation of the Lzw algorithm. It - compresses 7-bit ASCII strings into 8-bit compressed strings. - The Lzw dictionary is preinitialized with 0..127, therefore this - part of the dictionary does not need to be stored in the arrays. - The Lzw code size is allways 8 bit, so we do not need complex code - that can write partial bytes.} - - function minilzw_encode(const s:string):string; - - var t,u,i:byte; - c:char; - data:array[128..255] of char; - previous:array[128..255] of byte; - lzwptr:byte; - next_avail:set of 0..255; - - label l1; - - begin - minilzw_encode:=''; - fillchar(data,sizeof(data),#0); - fillchar(previous,sizeof(previous),#0); - if s<>'' then - begin - lzwptr:=127; - t:=byte(s[1]); - i:=2; - u:=128; - next_avail:=[]; - while i<=length(s) do - begin - c:=s[i]; - if not(t in next_avail) or (u>lzwptr) then goto l1; - while (previous[u]<>t) or (data[u]<>c) do - begin - inc(u); - if u>lzwptr then goto l1; - end; - t:=u; - inc(i); - continue; - l1: - {It's a pity that we still need those awfull tricks - with this modern compiler. Without this performance - of the entire procedure drops about 3 times.} - inc(minilzw_encode[0]); - minilzw_encode[length(minilzw_encode)]:=char(t); - if lzwptr=255 then - begin - lzwptr:=127; - next_avail:=[]; - end - else - begin - inc(lzwptr); - data[lzwptr]:=c; - previous[lzwptr]:=t; - include(next_avail,t); - end; - t:=byte(c); - u:=128; - inc(i); - end; - inc(minilzw_encode[0]); - minilzw_encode[length(minilzw_encode)]:=char(t); - end; - end; - - function minilzw_decode(const s:string):string; - - var oldc,newc,c:char; - i,j:byte; - data:array[128..255] of char; - previous:array[128..255] of byte; - lzwptr:byte; - t:string; - - begin - minilzw_decode:=''; - fillchar(data,sizeof(data),#0); - fillchar(previous,sizeof(previous),#0); - if s<>'' then - begin - lzwptr:=127; - oldc:=s[1]; - c:=oldc; - i:=2; - minilzw_decode:=oldc; - while i<=length(s) do - begin - newc:=s[i]; - if byte(newc)>lzwptr then - begin - t:=c; - c:=oldc; - end - else - begin - c:=newc; - t:=''; - end; - while c>=#128 do - begin - inc(t[0]); - t[length(t)]:=data[byte(c)]; - byte(c):=previous[byte(c)]; - end; - inc(minilzw_decode[0]); - minilzw_decode[length(minilzw_decode)]:=c; - for j:=length(t) downto 1 do - begin - inc(minilzw_decode[0]); - minilzw_decode[length(minilzw_decode)]:=t[j]; - end; - if lzwptr=255 then - lzwptr:=127 - else - begin - inc(lzwptr); - previous[lzwptr]:=byte(oldc); - data[lzwptr]:=c; - end; - oldc:=newc; - inc(i); - end; - end; - end; - - procedure defaulterror(i:longint); begin writeln('Internal error ',i); runerror(255); end; - Function Nextafter(x,y:double):double; - // Returns the double precision number closest to x in - // the direction toward y. - - // Initial direct translation by Soeren Haastrup from - // www.netlib.org/fdlibm/s_nextafter.c according to - // ==================================================== - // Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - // Developed at SunSoft, a Sun Microsystems, Inc. business. - // Permission to use, copy, modify, and distribute this - // software is freely granted, provided that this notice - // is preserved. - // ==================================================== - // and with all signaling policies preserved as is. - - type - {$if defined(ENDIAN_LITTLE) and not defined(FPC_DOUBLE_HILO_SWAPPED)} - twoword=record - lo,hi:longword; // Little Endian split of a double. - end; - {$else} - twoword=record - hi,lo:longword; // Big Endian split of a double. - end; - {$endif} - - var - hx,hy,ix,iy:longint; - lx,ly:longword; - - Begin - hx:=twoword(x).hi; // high and low words of x and y - lx:=twoword(x).lo; - hy:=twoword(y).hi; - ly:=twoword(y).lo; - ix:=hx and $7fffffff; // absolute values - iy:=hy and $7fffffff; - - // Case x=NAN or y=NAN - - if ( (ix>=$7ff00000) and ((longword(ix-$7ff00000) or lx) <> 0) ) - or ( (iy>=$7ff00000) and ((longword(iy-$7ff00000) OR ly) <> 0) ) - then exit(x+y); - - // Case x=y - - if x=y then exit(x); // (implies Nextafter(0,-0) is 0 and not -0...) - - // Case x=0 - - if (longword(ix) or lx)=0 - then begin - twoword(x).hi:=hy and $80000000; // return +-minimalSubnormal - twoword(x).lo:=1; - y:=x*x; // set underflow flag (ignored in FPC as default) - if y=x - then exit(y) - else exit(x); - end; - - // all other cases - - if hx>=0 // x>0 - then begin - if (hx>hy) or ( (hx=hy) and (lx>ly) ) // x>y , return x-ulp - then begin - if (lx=0) then hx:=hx-1; - lx:=lx-1; - end - else begin // x=0) or (hx>=hy) or ( (hx=hy) and (lx>ly)) // xy , return x+ulp - lx:=lx+1; - if lx=0 then hx:=hx+1; - end - end; - - // finally check if overflow or underflow just happend - - hy:=hx and $7ff00000; - if (hy>= $7ff00000) then exit(x+x); // overflow and signal - if (hy<$0010000) // underflow - then begin - y:=x*x; // raise underflow flag - if y<>x - then begin - twoword(y).hi:=hx; - twoword(y).lo:=lx; - exit(y); - end - end; - - twoword(x).hi:=hx; - twoword(x).lo:=lx; - nextafter:=x; - - end; - function LengthUleb128(a: qword) : byte; begin diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 1802e99f71..aa44e1e1f3 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -46,18 +46,20 @@ interface end; pcandidate = ^tcandidate; - tcandidate = record + tcandidate = object next : pcandidate; data : tprocdef; wrongparaidx, firstparaidx : integer; te_count : array[te_convert_operator .. te_exact] of integer; { should be signed } - ordinal_distance : double; + ordinal_distance_lo : uint64; + ordinal_distance_hi,ordinal_distance_secondary : uint32; { “hi” allows summing many uint64s, “secondary” allows tie-break corrections. } invalid : boolean; {$ifndef DISABLE_FAST_OVERLOAD_PATCH} saved_validity : boolean; {$endif} wrongparanr : byte; + procedure increment_ordinal_distance(by: uint64); end; tcallcandidatesflag = @@ -2155,6 +2157,14 @@ implementation end; + procedure tcandidate.increment_ordinal_distance(by: uint64); + begin + {$push} {$q-,r-} inc(ordinal_distance_lo,by); {$pop} + if ordinal_distance_lopd.owner then - candidate^.ordinal_distance:=candidate^.ordinal_distance+1.0; + candidate^.increment_ordinal_distance(1); candidate:=candidate^.next; end; @@ -2838,7 +2848,9 @@ implementation ' l5: '+tostr(hp^.te_count[te_convert_l5])+ ' l6: '+tostr(hp^.te_count[te_convert_l6])+ ' oper: '+tostr(hp^.te_count[te_convert_operator])+ - ' ord: '+realtostr(hp^.ordinal_distance)); + ' ordhi: '+tostr(hp^.ordinal_distance_hi)+ + ' ordlo: '+tostr(hp^.ordinal_distance_lo)+ + ' ord2: '+tostr(hp^.ordinal_distance_secondary)); { Print parameters in left-right order } for i:=0 to hp^.data.paras.count-1 do begin @@ -2857,9 +2869,8 @@ implementation var hp : pcandidate; currpara : tparavarsym; - paraidx : integer; + paraidx,fp_precision_distance : integer; currparanr : byte; - rfh,rth : double; obj_from, obj_to : tobjectdef; def_from, @@ -2875,12 +2886,16 @@ implementation cdoptions : tcompare_defs_options; n : tnode; - {$push} - {$r-} - {$q-} - const - inf=1.0/0.0; - {$pop} + function fp_precision_score(def: tdef): integer; + begin + if is_extended(def) then + result:=4 + else if is_double(def) then + result:=2 + else + result:=1; + end; + begin cdoptions:=[cdo_check_operator]; if FAllowVariant then @@ -3008,19 +3023,13 @@ implementation is_in_limit(def_from,def_to) then begin eq:=te_equal; - hp^.ordinal_distance:=hp^.ordinal_distance+ - abs(bestreal(torddef(def_from).low)-bestreal(torddef(def_to).low)); - rth:=bestreal(torddef(def_to).high); - rfh:=bestreal(torddef(def_from).high); - hp^.ordinal_distance:=hp^.ordinal_distance+abs(rth-rfh); + { is_in_limit(def_from, def_to) means that def_from.low >= def_to.low and def_from.high <= def_to.high. } + hp^.increment_ordinal_distance(torddef(def_from).low-torddef(def_to).low); + hp^.increment_ordinal_distance(torddef(def_to).high-torddef(def_from).high); { Give wrong sign a small penalty, this is need to get a diffrence from word->[longword,longint] } - if is_signed(def_from)<>is_signed(def_to) then -{$push} -{$r-} -{$q-} - hp^.ordinal_distance:=nextafter(hp^.ordinal_distance,inf); -{$pop} + if (is_signed(def_from)<>is_signed(def_to)) then + inc(hp^.ordinal_distance_secondary); end else { for value and const parameters check precision of real, give @@ -3030,26 +3039,11 @@ implementation is_real_or_cextended(def_to) then begin eq:=te_equal; - if is_extended(def_to) then - rth:=4 - else - if is_double (def_to) then - rth:=2 - else - rth:=1; - if is_extended(def_from) then - rfh:=4 - else - if is_double (def_from) then - rfh:=2 - else - rfh:=1; + fp_precision_distance:=fp_precision_score(def_to)-fp_precision_score(def_from); { penalty for shrinking of precision } - if rth0 then exit; { less cl6 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l6]-currpd^.te_count[te_convert_l6]); + is_better_candidate:=bestpd^.te_count[te_convert_l6]-currpd^.te_count[te_convert_l6]; if is_better_candidate<>0 then exit; { less cl5 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l5]-currpd^.te_count[te_convert_l5]); + is_better_candidate:=bestpd^.te_count[te_convert_l5]-currpd^.te_count[te_convert_l5]; if is_better_candidate<>0 then exit; { less cl4 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l4]-currpd^.te_count[te_convert_l4]); + is_better_candidate:=bestpd^.te_count[te_convert_l4]-currpd^.te_count[te_convert_l4]; if is_better_candidate<>0 then exit; { less cl3 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l3]-currpd^.te_count[te_convert_l3]); + is_better_candidate:=bestpd^.te_count[te_convert_l3]-currpd^.te_count[te_convert_l3]; if is_better_candidate<>0 then exit; { less cl2 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l2]-currpd^.te_count[te_convert_l2]); + is_better_candidate:=bestpd^.te_count[te_convert_l2]-currpd^.te_count[te_convert_l2]; if is_better_candidate<>0 then exit; { less cl1 parameters? } - is_better_candidate:=(bestpd^.te_count[te_convert_l1]-currpd^.te_count[te_convert_l1]); + is_better_candidate:=bestpd^.te_count[te_convert_l1]-currpd^.te_count[te_convert_l1]; if is_better_candidate<>0 then exit; { more exact parameters? } - is_better_candidate:=(currpd^.te_count[te_exact]-bestpd^.te_count[te_exact]); + is_better_candidate:=currpd^.te_count[te_exact]-bestpd^.te_count[te_exact]; if is_better_candidate<>0 then exit; { less equal parameters? } - is_better_candidate:=(bestpd^.te_count[te_equal]-currpd^.te_count[te_equal]); + is_better_candidate:=bestpd^.te_count[te_equal]-currpd^.te_count[te_equal]; if is_better_candidate<>0 then exit; { if a specialization is better than a non-specialization then @@ -3317,8 +3311,12 @@ implementation exit; end; { smaller ordinal distance? } - if (currpd^.ordinal_distance<>bestpd^.ordinal_distance) then - is_better_candidate:=2*ord(currpd^.ordinal_distance0 if currpd^.ordinal_distance_hi < bestpd^.ordinal_distance_hi. } + if is_better_candidate<>0 then + exit; + if currpd^.ordinal_distance_lo<>bestpd^.ordinal_distance_lo then + exit(2*ord(currpd^.ordinal_distance_lo0 if currpd^.ordinal_distance_secondary < bestpd^.ordinal_distance_secondary. } end;