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

* Experiment: Compress strings to save memory

Browse Source 
Did not save a single byte of mem; clearly the core size is boosted by
    temporary memory usage...
This commit is contained in:
daniel 2004-01-11 23:56:19 +00:00
parent ad451147d7
commit 4a4b8f2a72
8 changed files with 369 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
compiler/cclasses.pas
View File

@ -170,11 +170,11 @@ interface
FSpeedValue : cardinal; FSpeedValue : cardinal;
{ singleList } { singleList }
FListNext : TNamedIndexItem; FListNext : TNamedIndexItem;
FName : Pstring;
protected protected
function GetName:string;virtual; function GetName:string;virtual;
procedure SetName(const n:string);virtual; procedure SetName(const n:string);virtual;
public public
FName : Pstring;
constructor Create; constructor Create;
constructor CreateName(const n:string); constructor CreateName(const n:string);
destructor Destroy;override; destructor Destroy;override;
@ -870,7 +870,11 @@ end;
Fleft:=nil; Fleft:=nil;
Fright:=nil; Fright:=nil;
Fspeedvalue:=cardinal($ffffffff); Fspeedvalue:=cardinal($ffffffff);
{$ifdef compress}
FName:=stringdup(minilzw_encode(n));
{$else}
FName:=stringdup(n); FName:=stringdup(n);
{$endif}
{ List } { List }
FListNext:=nil; FListNext:=nil;
end; end;
@ -888,7 +892,11 @@ end;
begin begin
if assigned(FName) then if assigned(FName) then
stringdispose(FName); stringdispose(FName);
{$ifdef compress}
FName:=stringdup(minilzw_encode(n));
{$else}
FName:=stringdup(n); FName:=stringdup(n);
{$endif}
end; end;
end; end;
@ -896,7 +904,11 @@ end;
function TNamedIndexItem.GetName:string; function TNamedIndexItem.GetName:string;
begin begin
if assigned(FName) then if assigned(FName) then
{$ifdef compress}
Getname:=minilzw_decode(FName^)
{$else}
Getname:=FName^ Getname:=FName^
{$endif}
else else
Getname:=''; Getname:='';
end; end;
@ -975,6 +987,11 @@ end;
var var
p,SpeedValue : cardinal; p,SpeedValue : cardinal;
n : TNamedIndexItem; n : TNamedIndexItem;
{$ifdef compress}
senc:string;
{$else}
senc:string absolute s;
{$endif}
procedure insert_right_bottom(var root,Atree:TNamedIndexItem); procedure insert_right_bottom(var root,Atree:TNamedIndexItem);
begin begin
@ -1005,10 +1022,10 @@ end;
lr:=left; lr:=left;
end; end;
end; end;
while (root<>nil) and (root.FName^<>s) do while (root<>nil) and (root.FName^<>senc) do
begin begin
oldroot:=root; oldroot:=root;
if s<root.FName^ then if senc<root.FName^ then
begin begin
root:=root.FRight; root:=root.FRight;
lr:=right; lr:=right;
@ -1044,7 +1061,10 @@ end;
end; end;
begin begin
SpeedValue:=GetSpeedValue(s); {$ifdef compress}
senc:=minilzw_encode(s);
{$endif}
SpeedValue:=GetSpeedValue(senc);
n:=FRoot; n:=FRoot;
if assigned(FHashArray) then if assigned(FHashArray) then
begin begin
@ -1053,7 +1073,7 @@ end;
p:=SpeedValue mod hasharraysize; p:=SpeedValue mod hasharraysize;
n:=FHashArray^[p]; n:=FHashArray^[p];
if (n<>nil) and (n.SpeedValue=SpeedValue) and if (n<>nil) and (n.SpeedValue=SpeedValue) and
(n.FName^=s) then (n.FName^=senc) then
begin begin
{ The Node to delete is directly located under the { The Node to delete is directly located under the
hasharray. Make the hasharray point to the left hasharray. Make the hasharray point to the left
@ -1075,7 +1095,7 @@ end;
begin begin
{ First check if the Node to delete is the root.} { First check if the Node to delete is the root.}
if (FRoot<>nil) and (n.SpeedValue=SpeedValue) and if (FRoot<>nil) and (n.SpeedValue=SpeedValue) and
(n.FName^=s) then (n.FName^=senc) then
begin begin
if n.FLeft<>nil then if n.FLeft<>nil then
begin begin
@ -1305,8 +1325,18 @@ end;
spdval : cardinal; spdval : cardinal;
lasthp, lasthp,
hp,hp2,hp3 : TNamedIndexItem; hp,hp2,hp3 : TNamedIndexItem;
{$ifdef compress}
oldsenc,newsenc:string;
{$else}
oldsenc:string absolute olds;
newsenc:string absolute news;
{$endif}
begin begin
spdval:=GetSpeedValue(olds); {$ifdef compress}
oldsenc:=minilzw_encode(olds);
newsenc:=minilzw_encode(news);
{$endif}
spdval:=GetSpeedValue(oldsenc);
if assigned(FHashArray) then if assigned(FHashArray) then
hp:=FHashArray^[spdval mod hasharraysize] hp:=FHashArray^[spdval mod hasharraysize]
else else
@ -1327,7 +1357,7 @@ end;
end end
else else
begin begin
if (hp.FName^=olds) then if (hp.FName^=oldsenc) then
begin begin
{ Get in hp2 the replacer for the root or hasharr } { Get in hp2 the replacer for the root or hasharr }
hp2:=hp.FLeft; hp2:=hp.FLeft;
@ -1358,8 +1388,8 @@ end;
hp.FLeft:=nil; hp.FLeft:=nil;
hp.FRight:=nil; hp.FRight:=nil;
stringdispose(hp.FName); stringdispose(hp.FName);
hp.FName:=stringdup(newS); hp.FName:=stringdup(newsenc);
hp.FSpeedValue:=GetSpeedValue(newS); hp.FSpeedValue:=GetSpeedValue(newsenc);
{ 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])
@ -1368,7 +1398,7 @@ end;
exit; exit;
end end
else else
if olds>hp.FName^ then if oldsenc>hp.FName^ then
begin begin
lasthp:=hp; lasthp:=hp;
hp:=hp.FLeft hp:=hp.FLeft
@ -1385,9 +1415,17 @@ end;
function Tdictionary.search(const s:string):TNamedIndexItem; function Tdictionary.search(const s:string):TNamedIndexItem;
begin
search:=speedsearch(s,GetSpeedValue(s)); var t:string;
end;
begin
{$ifdef compress}
t:=minilzw_encode(s);
search:=speedsearch(t,getspeedvalue(t));
{$else}
search:=speedsearch(s,getspeedvalue(s));
{$endif}
end;
function Tdictionary.speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem; function Tdictionary.speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem;
@ -1905,7 +1943,12 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.28 2003-10-23 14:44:07 peter Revision 1.29 2004-01-11 23:56:19 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.28 2003/10/23 14:44:07 peter
* splitted buildderef and buildderefimpl to fix interface crc * splitted buildderef and buildderefimpl to fix interface crc
calculation calculation

26
compiler/cgobj.pas
View File

@ -63,6 +63,9 @@ unit cgobj;
alignment : talignment; alignment : talignment;
rg : array[tregistertype] of trgobj; rg : array[tregistertype] of trgobj;
t_times:cardinal; t_times:cardinal;
{$ifdef flowgraph}
aktflownode:word;
{$endif}
{************************************************} {************************************************}
{ basic routines } { basic routines }
constructor create; constructor create;
@ -72,6 +75,10 @@ unit cgobj;
{# Clean up the register allocators needed for the codegenerator.} {# Clean up the register allocators needed for the codegenerator.}
procedure done_register_allocators;virtual; procedure done_register_allocators;virtual;
{$ifdef flowgraph}
procedure init_flowgraph;
procedure done_flowgraph;
{$endif}
{# Gets a register suitable to do integer operations on.} {# Gets a register suitable to do integer operations on.}
function getintregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual; function getintregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
{# Gets a register suitable to do integer operations on.} {# Gets a register suitable to do integer operations on.}
@ -590,6 +597,18 @@ implementation
add_reg_instruction_hook:=nil; add_reg_instruction_hook:=nil;
end; end;
{$ifdef flowgraph}
procedure Tcg.init_flowgraph;
begin
aktflownode:=0;
end;
procedure Tcg.done_flowgraph;
begin
end;
{$endif}
function tcg.getintregister(list:Taasmoutput;size:Tcgsize):Tregister; function tcg.getintregister(list:Taasmoutput;size:Tcgsize):Tregister;
begin begin
@ -2047,7 +2066,12 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.146 2003-12-26 14:02:30 peter Revision 1.147 2004-01-11 23:56:19 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.146 2003/12/26 14:02:30 peter
* sparc updates * sparc updates
* use registertype in spill_register * use registertype in spill_register

154
compiler/cutils.pas
View File

@ -102,20 +102,19 @@ interface
{ ambivalent to pchar2pstring } { ambivalent to pchar2pstring }
function pstring2pchar(p : pstring) : pchar; function pstring2pchar(p : pstring) : pchar;
{ Speed/Hash value } { Speed/Hash value }
Function GetSpeedValue(Const s:String):cardinal; Function GetSpeedValue(Const s:String):cardinal;
{ Ansistring (pchar+length) support } { Ansistring (pchar+length) support }
procedure ansistringdispose(var p : pchar;length : longint); procedure ansistringdispose(var p : pchar;length : longint);
function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint; function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar; function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
{*****************************************************************************
File Functions
*****************************************************************************}
function DeleteFile(const fn:string):boolean; function DeleteFile(const fn:string):boolean;
{Lzw encode/decode to compress strings -> save memory.}
function minilzw_encode(const s:string):string;
function minilzw_decode(const s:string):string;
implementation implementation
@ -851,13 +850,145 @@ uses
DeleteFile:=(IOResult=0); DeleteFile:=(IOResult=0);
end; 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:='';
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:='';
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;
initialization initialization
initupperlower; initupperlower;
end. end.
{ {
$Log$ $Log$
Revision 1.29 2003-10-31 15:51:11 peter Revision 1.30 2004-01-11 23:56:19 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.29 2003/10/31 15:51:11 peter
* USEINLINE directive added (not enabled yet) * USEINLINE directive added (not enabled yet)
Revision 1.28 2003/09/03 15:55:00 peter Revision 1.28 2003/09/03 15:55:00 peter
@ -915,5 +1046,4 @@ end.
Revision 1.14 2002/04/12 17:16:35 carl Revision 1.14 2002/04/12 17:16:35 carl
+ more documentation of basic unit + more documentation of basic unit
} }

13
compiler/ncal.pas
View File

@ -1317,7 +1317,11 @@ type
begin begin
if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
begin begin
srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue)); {$ifdef compress}
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
@ -2702,7 +2706,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.217 2003-12-28 22:09:12 florian Revision 1.218 2004-01-11 23:56:19 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.217 2003/12/28 22:09:12 florian
+ setting of bit 6 of cr for c var args on ppc implemented + setting of bit 6 of cr for c var args on ppc implemented
Revision 1.216 2003/12/21 19:42:42 florian Revision 1.216 2003/12/21 19:42:42 florian

21
compiler/symbase.pas
View File

@ -283,9 +283,17 @@ implementation
function tsymtable.search(const s : stringid) : tsymentry; function tsymtable.search(const s : stringid) : tsymentry;
begin
search:=speedsearch(s,getspeedvalue(s)); var senc:string;
end;
begin
{$ifdef compress}
senc:=minilzw_encode(s);
search:=speedsearch(senc,getspeedvalue(senc));
{$else}
search:=speedsearch(s,getspeedvalue(s));
{$endif}
end;
function tsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry; function tsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
@ -333,7 +341,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.16 2003-12-01 18:44:15 peter Revision 1.17 2004-01-11 23:56:20 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.16 2003/12/01 18:44:15 peter
* fixed some crashes * fixed some crashes
* fixed varargs and register calling probs * fixed varargs and register calling probs

42
compiler/symdef.pas
View File

@ -3769,7 +3769,7 @@ implementation
ppufile.do_interface_crc:=oldintfcrc; ppufile.do_interface_crc:=oldintfcrc;
ppufile.putbyte(byte(has_mangledname)); ppufile.putbyte(byte(has_mangledname));
if has_mangledname then if has_mangledname then
ppufile.putstring(mangledname); ppufile.putstring(_mangledname^);
ppufile.putword(overloadnumber); ppufile.putword(overloadnumber);
ppufile.putword(extnumber); ppufile.putword(extnumber);
ppufile.putbyte(parast.symtablelevel); ppufile.putbyte(parast.symtablelevel);
@ -4282,29 +4282,35 @@ implementation
function tprocdef.mangledname : string; function tprocdef.mangledname : string;
var var
s : string;
hp : TParaItem; hp : TParaItem;
begin begin
if assigned(_mangledname) then if assigned(_mangledname) then
begin begin
{$ifdef compress}
mangledname:=minilzw_decode(_mangledname^);
{$else}
mangledname:=_mangledname^; mangledname:=_mangledname^;
{$endif}
exit; exit;
end; end;
{ we need to use the symtable where the procsym is inserted, { we need to use the symtable where the procsym is inserted,
because that is visible to the world } because that is visible to the world }
s:=make_mangledname('',procsym.owner,procsym.name); mangledname:=make_mangledname('',procsym.owner,procsym.name);
if overloadnumber>0 then if overloadnumber>0 then
s:=s+'$'+tostr(overloadnumber); mangledname:=mangledname+'$'+tostr(overloadnumber);
{ add parameter types } { add parameter types }
hp:=TParaItem(Para.first); hp:=TParaItem(Para.first);
while assigned(hp) do while assigned(hp) do
begin begin
if not hp.is_hidden then if not hp.is_hidden then
s:=s+'$'+hp.paratype.def.mangledparaname; mangledname:=mangledname+'$'+hp.paratype.def.mangledparaname;
hp:=TParaItem(hp.next); hp:=TParaItem(hp.next);
end; end;
_mangledname:=stringdup(s); {$ifdef compress}
mangledname:=_mangledname^; _mangledname:=stringdup(minilzw_encode(mangledname));
{$else}
_mangledname:=stringdup(mangledname);
{$endif}
end; end;
@ -4381,7 +4387,11 @@ implementation
procedure tprocdef.setmangledname(const s : string); procedure tprocdef.setmangledname(const s : string);
begin begin
stringdispose(_mangledname); stringdispose(_mangledname);
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(s));
{$else}
_mangledname:=stringdup(s); _mangledname:=stringdup(s);
{$endif}
has_mangledname:=true; has_mangledname:=true;
end; end;
@ -5249,7 +5259,7 @@ implementation
end; end;
procedure tobjectdef.concatstabto(asmlist : taasmoutput); procedure tobjectdef.concatstabto(asmlist : taasmoutput);
var st : pstring; var st:string;
begin begin
if objecttype<>odt_class then if objecttype<>odt_class then
begin begin
@ -5270,15 +5280,12 @@ implementation
is_def_stab_written:=not_written; is_def_stab_written:=not_written;
if assigned(typesym) then if assigned(typesym) then
begin begin
st:=typesym.FName; st:=typesym.name;
typesym.FName:=stringdup(' '); typesym.name:=' ';
end; end;
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
if assigned(typesym) then if assigned(typesym) then
begin typesym.name:=st;
stringdispose(typesym.FName);
typesym.FName:=st;
end;
end; end;
end; end;
{$endif GDB} {$endif GDB}
@ -6156,7 +6163,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.197 2004-01-04 21:10:04 jonas Revision 1.198 2004-01-11 23:56:20 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.197 2004/01/04 21:10:04 jonas
* Darwin's assembler assumes that all labels starting with 'L' are local * Darwin's assembler assumes that all labels starting with 'L' are local
-> rename symbols starting with 'L' -> rename symbols starting with 'L'

40
compiler/symsym.pas
View File

@ -623,7 +623,11 @@ implementation
if not assigned(_mangledname) then if not assigned(_mangledname) then
internalerror(200204171); internalerror(200204171);
end; end;
{$ifdef compress}
mangledname:=minilzw_decode(_mangledname^)
{$else}
mangledname:=_mangledname^ mangledname:=_mangledname^
{$endif}
end; end;
@ -663,9 +667,14 @@ implementation
procedure tlabelsym.generate_mangledname; procedure tlabelsym.generate_mangledname;
begin
_mangledname:=stringdup(lab.name); begin
end; {$ifdef compress}
_mangledname:=stringdup(minilzw_encode(lab.name));
{$else}
_mangledname:=stringdup(lab.name);
{$endif}
end;
procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile); procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
@ -1645,7 +1654,11 @@ implementation
begin begin
tvarsym(self).create(n,vsp,tt); tvarsym(self).create(n,vsp,tt);
stringdispose(_mangledname); stringdispose(_mangledname);
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(mangled));
{$else}
_mangledname:=stringdup(mangled); _mangledname:=stringdup(mangled);
{$endif}
end; end;
@ -1700,21 +1713,29 @@ implementation
hvo:=varoptions-[vo_regable,vo_fpuregable]; hvo:=varoptions-[vo_regable,vo_fpuregable];
ppufile.putsmallset(hvo); ppufile.putsmallset(hvo);
if (vo_is_C_var in varoptions) then if (vo_is_C_var in varoptions) then
ppufile.putstring(mangledname); ppufile.putstring(_mangledname^);
ppufile.writeentry(ibvarsym); ppufile.writeentry(ibvarsym);
end; end;
procedure tvarsym.generate_mangledname; procedure tvarsym.generate_mangledname;
begin begin
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(make_mangledname('U',owner,name)));
{$else}
_mangledname:=stringdup(make_mangledname('U',owner,name)); _mangledname:=stringdup(make_mangledname('U',owner,name));
{$endif}
end; end;
procedure tvarsym.set_mangledname(const s:string); procedure tvarsym.set_mangledname(const s:string);
begin begin
stringdispose(_mangledname); stringdispose(_mangledname);
{$ifdef compress}
_mangledname:=stringdup(minilzw_encode(s));
{$else}
_mangledname:=stringdup(s); _mangledname:=stringdup(s);
{$endif}
end; end;
@ -2002,7 +2023,11 @@ implementation
procedure ttypedconstsym.generate_mangledname; procedure ttypedconstsym.generate_mangledname;
begin begin
{$ifdef compress}
_mangledname:=stringdup(make_mangledname('TC',owner,name)); _mangledname:=stringdup(make_mangledname('TC',owner,name));
{$else}
_mangledname:=stringdup(make_mangledname('TC',owner,name));
{$endif}
end; end;
@ -2689,7 +2714,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.140 2004-01-06 15:46:12 peter Revision 1.141 2004-01-11 23:56:20 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.140 2004/01/06 15:46:12 peter
* fix stabs for locals * fix stabs for locals
Revision 1.139 2003/12/23 22:13:26 peter Revision 1.139 2003/12/23 22:13:26 peter

67
compiler/symtable.pas
View File

@ -1793,12 +1793,20 @@ 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
speedvalue:=getspeedvalue(s); {$ifdef compress}
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(s,speedvalue)); srsym:=tsym(srsymtable.speedsearch(senc,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
@ -1816,8 +1824,16 @@ 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
speedvalue:=getspeedvalue(s); {$ifdef compress}
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
srsymtable:=symtablestack; srsymtable:=symtablestack;
while assigned(srsymtable) do while assigned(srsymtable) do
begin begin
@ -1829,7 +1845,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(s,speedvalue)); srsym:=tsym(srsymtable.speedsearch(senc,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
@ -1877,8 +1893,16 @@ 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
speedvalue:=getspeedvalue(s); {$ifdef compress}
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
@ -1897,7 +1921,7 @@ implementation
sym:=nil; sym:=nil;
while assigned(classh) do while assigned(classh) do
begin begin
sym:=tsym(classh.symtable.speedsearch(s,speedvalue)); sym:=tsym(classh.symtable.speedsearch(senc,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;
@ -2043,11 +2067,19 @@ implementation
var var
speedvalue : cardinal; speedvalue : cardinal;
srsym : tsym; srsym : tsym;
{$ifdef compress}
senc:string;
{$else}
senc:string absolute s;
{$endif}
begin begin
speedvalue:=getspeedvalue(s); {$ifdef compress}
senc:=minilzw_encode(s);
{$endif}
speedvalue:=getspeedvalue(senc);
while assigned(pd) do while assigned(pd) do
begin begin
srsym:=tsym(pd.symtable.speedsearch(s,speedvalue)); srsym:=tsym(pd.symtable.speedsearch(senc,speedvalue));
if assigned(srsym) then if assigned(srsym) then
begin begin
search_class_member:=srsym; search_class_member:=srsym;
@ -2108,7 +2140,7 @@ implementation
var var
speedvalue : cardinal; speedvalue : cardinal;
srsym : tprocsym; srsym : tprocsym;
s : string; senc : string;
objdef : tobjectdef; objdef : tobjectdef;
begin begin
if aprocsym.overloadchecked then if aprocsym.overloadchecked then
@ -2121,11 +2153,15 @@ implementation
if not assigned(objdef.childof) then if not assigned(objdef.childof) then
exit; exit;
objdef:=objdef.childof; objdef:=objdef.childof;
s:=aprocsym.name; {$ifdef compress}
speedvalue:=getspeedvalue(s); senc:=minilzw_encode(aprocsym.name);
{$else}
senc:=aprocsym.name;
{$endif}
speedvalue:=getspeedvalue(senc);
while assigned(objdef) do while assigned(objdef) do
begin begin
srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue)); srsym:=tprocsym(objdef.symtable.speedsearch(senc,speedvalue));
if assigned(srsym) then if assigned(srsym) then
begin begin
if (srsym.typ<>procsym) then if (srsym.typ<>procsym) then
@ -2298,7 +2334,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.123 2003-11-10 22:02:52 peter Revision 1.124 2004-01-11 23:56:20 daniel
* Experiment: Compress strings to save memory
Did not save a single byte of mem; clearly the core size is boosted by
temporary memory usage...
Revision 1.123 2003/11/10 22:02:52 peter
* cross unit inlining fixed * cross unit inlining fixed
Revision 1.122 2003/11/08 17:08:44 florian Revision 1.122 2003/11/08 17:08:44 florian