paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 11:39:33 +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

84
compiler/ncgcon.pas
View File

@ -1,6 +1,6 @@
{
$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
all (most) processors
@ -175,9 +175,10 @@ implementation
procedure tcgstringconstnode.pass_2;
var
hp1 : tai;
hp1,hp2 : tai;
l1,l2,
lastlabel : tasmlabel;
lastlabelhp : tai;
pc : pchar;
same_string : boolean;
l,j,
@ -195,6 +196,7 @@ implementation
location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
{ const already used ? }
lastlabel:=nil;
lastlabelhp:=nil;
if not assigned(lab_str) then
begin
if is_shortstring(resulttype.def) then
@ -209,7 +211,10 @@ implementation
while assigned(hp1) do
begin
if hp1.typ=ait_label then
lastlabel:=tai_label(hp1).l
begin
lastlabel:=tai_label(hp1).l;
lastlabelhp:=hp1;
end
else
begin
{ when changing that code, be careful that }
@ -224,14 +229,49 @@ implementation
same_string:=true;
{ if shortstring then check the length byte first and
set the start index to 1 }
if is_shortstring(resulttype.def) then
begin
if len<>ord(tai_string(hp1).str[0]) then
case st_type of
st_shortstring:
begin
if len=ord(tai_string(hp1).str[0]) then
j:=1
else
same_string:=false;
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
else
same_string:=false;
end;
else
same_string:=false;
j:=1;
end
else
j:=0;
end;
{ don't check if the length byte was already wrong }
if same_string then
begin
@ -249,15 +289,6 @@ implementation
if same_string then
begin
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;
end;
end;
@ -488,7 +519,10 @@ begin
end.
{
$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
* 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
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
}