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

* fixed reusing of ansistrings

Browse Source
This commit is contained in:
peter 2002-05-14 19:27:33 +00:00
parent a0866f619a
commit 6a77edd956
1 changed files with 54 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
compiler/ncgcon.pas
View File

@ -1,6 +1,6 @@
{ {
$Id$ $Id$
Copyright (c) 1998-2000 by Florian Klaempfl Copyright (c) 1998-2002 by Florian Klaempfl
Generate assembler for constant nodes which are the same for Generate assembler for constant nodes which are the same for
all (most) processors all (most) processors
@ -175,9 +175,10 @@ implementation
procedure tcgstringconstnode.pass_2; procedure tcgstringconstnode.pass_2;
var var
hp1 : tai; hp1,hp2 : tai;
l1,l2, l1,l2,
lastlabel : tasmlabel; lastlabel : tasmlabel;
lastlabelhp : tai;
pc : pchar; pc : pchar;
same_string : boolean; same_string : boolean;
l,j, l,j,
@ -195,6 +196,7 @@ implementation
location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
{ const already used ? } { const already used ? }
lastlabel:=nil; lastlabel:=nil;
lastlabelhp:=nil;
if not assigned(lab_str) then if not assigned(lab_str) then
begin begin
if is_shortstring(resulttype.def) then if is_shortstring(resulttype.def) then
@ -209,7 +211,10 @@ implementation
while assigned(hp1) do while assigned(hp1) do
begin begin
if hp1.typ=ait_label then if hp1.typ=ait_label then
lastlabel:=tai_label(hp1).l begin
lastlabel:=tai_label(hp1).l;
lastlabelhp:=hp1;
end
else else
begin begin
{ when changing that code, be careful that } { when changing that code, be careful that }
@ -224,14 +229,49 @@ implementation
same_string:=true; same_string:=true;
{ if shortstring then check the length byte first and { if shortstring then check the length byte first and
set the start index to 1 } set the start index to 1 }
if is_shortstring(resulttype.def) then case st_type of
st_shortstring:
begin begin
if len<>ord(tai_string(hp1).str[0]) then if len=ord(tai_string(hp1).str[0]) then
j:=1
else
same_string:=false; same_string:=false;
j:=1; end;
st_ansistring,
st_widestring :
begin
{ before the string the following sequence must be found:
<label>
constsymbol <datalabel>
const32 <len>
const32 <len>
const32 -1
we must then return <label> to reuse
}
hp2:=tai(lastlabelhp.previous);
if assigned(hp2) and
(hp2.typ=ait_const_32bit) and
(tai_const(hp2).value=-1) and
assigned(hp2.previous) and
(tai(hp2.previous).typ=ait_const_32bit) and
(tai_const(hp2.previous).value=len) and
assigned(hp2.previous.previous) and
(tai(hp2.previous.previous).typ=ait_const_32bit) and
(tai_const(hp2.previous.previous).value=len) and
assigned(hp2.previous.previous.previous) and
(tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
assigned(hp2.previous.previous.previous.previous) and
(tai(hp2.previous.previous.previous.previous).typ=ait_label) then
begin
lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
j:=0;
end end
else else
j:=0; same_string:=false;
end;
else
same_string:=false;
end;
{ don't check if the length byte was already wrong } { don't check if the length byte was already wrong }
if same_string then if same_string then
begin begin
@ -249,15 +289,6 @@ implementation
if same_string then if same_string then
begin begin
lab_str:=lastlabel; lab_str:=lastlabel;
{ create a new entry for ansistrings, but reuse the data }
if (st_type in [st_ansistring,st_widestring]) then
begin
getdatalabel(l2);
Consts.concat(Tai_label.Create(l2));
Consts.concat(Tai_const_symbol.Create(lab_str));
{ return the offset of the real string }
lab_str:=l2;
end;
break; break;
end; end;
end; end;
@ -488,7 +519,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 2002-04-04 19:05:57 peter Revision 1.8 2002-05-14 19:27:33 peter
* fixed reusing of ansistrings
Revision 1.7 2002/04/04 19:05:57 peter
* removed unused units * removed unused units
* use tlocation.size in cg.a_*loc*() routines * use tlocation.size in cg.a_*loc*() routines
@ -525,14 +559,4 @@ end.
"Luc Langlois" <L_Langlois@Videotron.ca>) (lo/hi don't work as in FPC "Luc Langlois" <L_Langlois@Videotron.ca>) (lo/hi don't work as in FPC
when used with int64's under Delphi) when used with int64's under Delphi)
Revision 1.3 2001/12/31 09:52:02 jonas
* empty widestrings can also be optimized to the constant '0'
Revision 1.2 2001/10/20 19:28:37 peter
* interface 2 guid support
* guid constants support
Revision 1.1 2001/09/30 16:17:17 jonas
* made most constant and mem handling processor independent
} }