paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 19:10:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Some minor stuff

Browse Source 
* Managed to eliminate speed effects of string compression
This commit is contained in:
daniel 2004-01-15 15:16:17 +00:00
parent 541955ad91
commit 7a6b6f4bd4
6 changed files with 69 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
compiler/cclasses.pas
View File

@ -869,7 +869,7 @@ end;
{ dictionary } { dictionary }
Fleft:=nil; Fleft:=nil;
Fright:=nil; Fright:=nil;
Fspeedvalue:=cardinal($ffffffff); fspeedvalue:=getspeedvalue(n);
{$ifdef compress} {$ifdef compress}
FName:=stringdup(minilzw_encode(n)); FName:=stringdup(minilzw_encode(n));
{$else} {$else}
@ -892,6 +892,7 @@ end;
begin begin
if assigned(FName) then if assigned(FName) then
stringdispose(FName); stringdispose(FName);
fspeedvalue:=getspeedvalue(n);
{$ifdef compress} {$ifdef compress}
FName:=stringdup(minilzw_encode(n)); FName:=stringdup(minilzw_encode(n));
{$else} {$else}
@ -1064,7 +1065,7 @@ end;
{$ifdef compress} {$ifdef compress}
senc:=minilzw_encode(s); senc:=minilzw_encode(s);
{$endif} {$endif}
SpeedValue:=GetSpeedValue(senc); SpeedValue:=GetSpeedValue(s);
n:=FRoot; n:=FRoot;
if assigned(FHashArray) then if assigned(FHashArray) then
begin begin
@ -1187,7 +1188,7 @@ end;
begin begin
hp:=nil; hp:=nil;
Replace:=false; Replace:=false;
newobj.FSpeedValue:=GetSpeedValue(newobj.FName^); { newobj.FSpeedValue:=GetSpeedValue(newobj.FName^);}
{ must be the same name and hash } { must be the same name and hash }
if (oldobj.FSpeedValue<>newobj.FSpeedValue) or if (oldobj.FSpeedValue<>newobj.FSpeedValue) or
(oldobj.FName^<>newobj.FName^) then (oldobj.FName^<>newobj.FName^) then
@ -1255,7 +1256,7 @@ end;
function Tdictionary.insert(obj:TNamedIndexItem):TNamedIndexItem; function Tdictionary.insert(obj:TNamedIndexItem):TNamedIndexItem;
begin begin
obj.FSpeedValue:=GetSpeedValue(obj.FName^); { obj.FSpeedValue:=GetSpeedValue(obj.FName^);}
if assigned(FHashArray) then if assigned(FHashArray) then
insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize]) insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize])
else else
@ -1336,7 +1337,7 @@ end;
oldsenc:=minilzw_encode(olds); oldsenc:=minilzw_encode(olds);
newsenc:=minilzw_encode(news); newsenc:=minilzw_encode(news);
{$endif} {$endif}
spdval:=GetSpeedValue(oldsenc); spdval:=GetSpeedValue(olds);
if assigned(FHashArray) then if assigned(FHashArray) then
hp:=FHashArray^[spdval mod hasharraysize] hp:=FHashArray^[spdval mod hasharraysize]
else else
@ -1389,7 +1390,7 @@ end;
hp.FRight:=nil; hp.FRight:=nil;
stringdispose(hp.FName); stringdispose(hp.FName);
hp.FName:=stringdup(newsenc); hp.FName:=stringdup(newsenc);
hp.FSpeedValue:=GetSpeedValue(newsenc); hp.FSpeedValue:=GetSpeedValue(news);
{ reinsert } { reinsert }
if assigned(FHashArray) then if assigned(FHashArray) then
rename:=insertNode(hp,FHashArray^[hp.SpeedValue mod hasharraysize]) rename:=insertNode(hp,FHashArray^[hp.SpeedValue mod hasharraysize])
@ -1419,18 +1420,16 @@ end;
var t:string; var t:string;
begin begin
{$ifdef compress}
t:=minilzw_encode(s);
search:=speedsearch(t,getspeedvalue(t));
{$else}
search:=speedsearch(s,getspeedvalue(s)); search:=speedsearch(s,getspeedvalue(s));
{$endif}
end; end;
function Tdictionary.speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem; function Tdictionary.speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem;
var var
NewNode:TNamedIndexItem; NewNode:TNamedIndexItem;
{$ifdef compress}
decn:string;
{$endif}
begin begin
if assigned(FHashArray) then if assigned(FHashArray) then
NewNode:=FHashArray^[SpeedValue mod hasharraysize] NewNode:=FHashArray^[SpeedValue mod hasharraysize]
@ -1445,6 +1444,19 @@ end;
NewNode:=NewNode.FRight NewNode:=NewNode.FRight
else else
begin begin
{$ifdef compress}
decn:=minilzw_decode(newnode.fname^);
if (decn=s) then
begin
speedsearch:=NewNode;
exit;
end
else
if s>decn then
NewNode:=NewNode.FLeft
else
NewNode:=NewNode.FRight;
{$else}
if (NewNode.FName^=s) then if (NewNode.FName^=s) then
begin begin
speedsearch:=NewNode; speedsearch:=NewNode;
@ -1455,6 +1467,7 @@ end;
NewNode:=NewNode.FLeft NewNode:=NewNode.FLeft
else else
NewNode:=NewNode.FRight; NewNode:=NewNode.FRight;
{$endif}
end; end;
end; end;
speedsearch:=nil; speedsearch:=nil;
@ -1943,7 +1956,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.29 2004-01-11 23:56:19 daniel Revision 1.30 2004-01-15 15:16:17 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.29 2004/01/11 23:56:19 daniel
* Experiment: Compress strings to save memory * Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage... temporary memory usage...

9
compiler/cutils.pas
View File

@ -767,8 +767,6 @@ uses
i : integer; i : integer;
InitCrc : cardinal; InitCrc : cardinal;
begin begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
InitCrc:=cardinal($ffffffff); InitCrc:=cardinal($ffffffff);
for i:=1 to Length(s) do for i:=1 to Length(s) do
InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8); InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
@ -979,11 +977,16 @@ uses
end; end;
initialization initialization
makecrc32tbl;
initupperlower; initupperlower;
end. end.
{ {
$Log$ $Log$
Revision 1.30 2004-01-11 23:56:19 daniel Revision 1.31 2004-01-15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.30 2004/01/11 23:56:19 daniel
* Experiment: Compress strings to save memory * Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage... temporary memory usage...

12
compiler/ncal.pas
View File

@ -1324,11 +1324,7 @@ type
begin begin
if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
begin begin
{$ifdef compress} srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
srprocsym:=tprocsym(srsymtable.speedsearch(minilzw_encode(symtableprocentry.name),symtableprocentry.speedvalue));
{$else}
srprocsym:=tprocsym(srsymtable.speedsearch(minilzw_encode(symtableprocentry.name),symtableprocentry.speedvalue));
{$endif}
{ process only visible procsyms } { process only visible procsyms }
if assigned(srprocsym) and if assigned(srprocsym) and
(srprocsym.typ=procsym) and (srprocsym.typ=procsym) and
@ -2715,7 +2711,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.219 2004-01-14 17:53:58 peter Revision 1.220 2004-01-15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.219 2004/01/14 17:53:58 peter
* ignore hidden parameters when default parameters are used * ignore hidden parameters when default parameters are used
Revision 1.218 2004/01/11 23:56:19 daniel Revision 1.218 2004/01/11 23:56:19 daniel

13
compiler/symbase.pas
View File

@ -284,15 +284,8 @@ implementation
function tsymtable.search(const s : stringid) : tsymentry; function tsymtable.search(const s : stringid) : tsymentry;
var senc:string;
begin begin
{$ifdef compress}
senc:=minilzw_encode(s);
search:=speedsearch(senc,getspeedvalue(senc));
{$else}
search:=speedsearch(s,getspeedvalue(s)); search:=speedsearch(s,getspeedvalue(s));
{$endif}
end; end;
@ -341,7 +334,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.17 2004-01-11 23:56:20 daniel Revision 1.18 2004-01-15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.17 2004/01/11 23:56:20 daniel
* Experiment: Compress strings to save memory * Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage... temporary memory usage...

7
compiler/symdef.pas
View File

@ -4137,6 +4137,7 @@ implementation
end; end;
procedure tprocdef.concatstabto(asmlist : taasmoutput); procedure tprocdef.concatstabto(asmlist : taasmoutput);
begin begin
{ released procdef? } { released procdef? }
if not assigned(parast) then if not assigned(parast) then
@ -6163,7 +6164,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.198 2004-01-11 23:56:20 daniel Revision 1.199 2004-01-15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.198 2004/01/11 23:56:20 daniel
* Experiment: Compress strings to save memory * Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage... temporary memory usage...

66
compiler/symtable.pas
View File

@ -1793,20 +1793,12 @@ implementation
function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean; function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
var var
speedvalue : cardinal; speedvalue : cardinal;
{$ifdef compress}
senc:stringid;
{$else}
senc:stringid absolute s;
{$endif}
begin begin
{$ifdef compress} speedvalue:=getspeedvalue(s);
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
srsymtable:=symtablestack; srsymtable:=symtablestack;
while assigned(srsymtable) do while assigned(srsymtable) do
begin begin
srsym:=tsym(srsymtable.speedsearch(senc,speedvalue)); srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and if assigned(srsym) and
(not assigned(current_procinfo) or (not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
@ -1824,16 +1816,8 @@ implementation
function searchsym_type(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean; function searchsym_type(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
var var
speedvalue : cardinal; speedvalue : cardinal;
{$ifdef compress}
senc:stringid;
{$else}
senc:stringid absolute s;
{$endif}
begin begin
{$ifdef compress} speedvalue:=getspeedvalue(s);
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
srsymtable:=symtablestack; srsymtable:=symtablestack;
while assigned(srsymtable) do while assigned(srsymtable) do
begin begin
@ -1845,7 +1829,7 @@ implementation
} }
if not(srsymtable.symtabletype in [recordsymtable,objectsymtable,parasymtable]) then if not(srsymtable.symtabletype in [recordsymtable,objectsymtable,parasymtable]) then
begin begin
srsym:=tsym(srsymtable.speedsearch(senc,speedvalue)); srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and if assigned(srsym) and
(not assigned(current_procinfo) or (not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
@ -1893,16 +1877,8 @@ implementation
speedvalue : cardinal; speedvalue : cardinal;
topclassh : tobjectdef; topclassh : tobjectdef;
sym : tsym; sym : tsym;
{$ifdef compress}
senc:stringid;
{$else}
senc:stringid absolute s;
{$endif}
begin begin
{$ifdef compress} speedvalue:=getspeedvalue(s);
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
{ when the class passed is defined in this unit we { when the class passed is defined in this unit we
need to use the scope of that class. This is a trick need to use the scope of that class. This is a trick
that can be used to access protected members in other that can be used to access protected members in other
@ -1921,7 +1897,7 @@ implementation
sym:=nil; sym:=nil;
while assigned(classh) do while assigned(classh) do
begin begin
sym:=tsym(classh.symtable.speedsearch(senc,speedvalue)); sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
if assigned(sym) and if assigned(sym) and
tstoredsym(sym).is_visible_for_object(topclassh) then tstoredsym(sym).is_visible_for_object(topclassh) then
break; break;
@ -2067,19 +2043,11 @@ implementation
var var
speedvalue : cardinal; speedvalue : cardinal;
srsym : tsym; srsym : tsym;
{$ifdef compress}
senc:string;
{$else}
senc:string absolute s;
{$endif}
begin begin
{$ifdef compress} speedvalue:=getspeedvalue(s);
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
while assigned(pd) do while assigned(pd) do
begin begin
srsym:=tsym(pd.symtable.speedsearch(senc,speedvalue)); srsym:=tsym(pd.symtable.speedsearch(s,speedvalue));
if assigned(srsym) then if assigned(srsym) then
begin begin
search_class_member:=srsym; search_class_member:=srsym;
@ -2140,7 +2108,7 @@ implementation
var var
speedvalue : cardinal; speedvalue : cardinal;
srsym : tprocsym; srsym : tprocsym;
senc : string; s : string;
objdef : tobjectdef; objdef : tobjectdef;
begin begin
if aprocsym.overloadchecked then if aprocsym.overloadchecked then
@ -2153,15 +2121,11 @@ implementation
if not assigned(objdef.childof) then if not assigned(objdef.childof) then
exit; exit;
objdef:=objdef.childof; objdef:=objdef.childof;
{$ifdef compress} s:=aprocsym.name;
senc:=minilzw_encode(aprocsym.name); speedvalue:=getspeedvalue(s);
{$else}
senc:=aprocsym.name;
{$endif}
speedvalue:=getspeedvalue(senc);
while assigned(objdef) do while assigned(objdef) do
begin begin
srsym:=tprocsym(objdef.symtable.speedsearch(senc,speedvalue)); srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
if assigned(srsym) then if assigned(srsym) then
begin begin
if (srsym.typ<>procsym) then if (srsym.typ<>procsym) then
@ -2334,7 +2298,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.124 2004-01-11 23:56:20 daniel Revision 1.125 2004-01-15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression
Revision 1.124 2004/01/11 23:56:20 daniel
* Experiment: Compress strings to save memory * Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage... temporary memory usage...