mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-26 21:09:26 +02:00
Remove unused cutils functions.
This commit is contained in:
Rika Ichinose
FPK
parent
f70a430b6f
commit
8498eacdeb
@ -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<y, return x+ulp
|
||||
lx:=lx+1;
|
||||
if lx=0 then hx:=hx+1;
|
||||
end
|
||||
end
|
||||
else begin // x<0
|
||||
if (hy>=0) or (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>y , 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
|
||||
|
||||
@ -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_lo<by then
|
||||
inc(ordinal_distance_hi); { Carry. }
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TCallCandidates
|
||||
****************************************************************************}
|
||||
@ -2746,7 +2756,7 @@ implementation
|
||||
pd:=candidate^.data;
|
||||
|
||||
if st<>pd.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 rth<rfh then
|
||||
rfh:=(rfh-rth)*16
|
||||
else
|
||||
rfh:=rth-rfh;
|
||||
hp^.ordinal_distance:=hp^.ordinal_distance+rfh;
|
||||
if fp_precision_distance<0 then
|
||||
fp_precision_distance:=16*-fp_precision_distance;
|
||||
hp^.increment_ordinal_distance(fp_precision_distance);
|
||||
end
|
||||
else
|
||||
{ related object parameters also need to determine the distance between the current
|
||||
@ -3069,7 +3063,7 @@ implementation
|
||||
begin
|
||||
if obj_from=obj_to then
|
||||
break;
|
||||
hp^.ordinal_distance:=hp^.ordinal_distance+1;
|
||||
hp^.increment_ordinal_distance(1);
|
||||
obj_from:=obj_from.childof;
|
||||
end;
|
||||
end
|
||||
@ -3277,35 +3271,35 @@ implementation
|
||||
if is_better_candidate<>0 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_distance<bestpd^.ordinal_distance)-1; { 1 if currpd^.ordinal_distance < bestpd^.ordinal_distance, -1 if the reverse. }
|
||||
is_better_candidate:=int32(bestpd^.ordinal_distance_hi)-int32(currpd^.ordinal_distance_hi); { >0 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_lo<bestpd^.ordinal_distance_lo)-1); { 1 if currpd^.ordinal_distance_lo < bestpd^.ordinal_distance_lo, -1 if the reverse. }
|
||||
is_better_candidate:=int32(bestpd^.ordinal_distance_secondary)-int32(currpd^.ordinal_distance_secondary); { >0 if currpd^.ordinal_distance_secondary < bestpd^.ordinal_distance_secondary. }
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user