mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 17:19:26 +02:00
257 lines
8.7 KiB
ObjectPascal
257 lines
8.7 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2003 by Jonas Maebe
|
|
|
|
This unit implements the generic implementation of optimized nodes
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit ncgopt;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
uses node, nopt;
|
|
|
|
type
|
|
tcgaddsstringcharoptnode = class(taddsstringcharoptnode)
|
|
function det_resulttype: tnode; override;
|
|
function pass_1: tnode; override;
|
|
procedure pass_2; override;
|
|
end;
|
|
|
|
tcgaddsstringcsstringoptnode = class(taddsstringcsstringoptnode)
|
|
{ must be duplicated from ti386addnode :( }
|
|
procedure pass_2; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,
|
|
pass_1,defutil,htypechk,
|
|
symdef,paramgr,
|
|
aasmbase,aasmtai,
|
|
ncnv, ncon, pass_2,
|
|
cginfo, cgbase, cpubase,
|
|
tgobj, rgobj, cgobj, ncgutil;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCGADDOPTNODE
|
|
*****************************************************************************}
|
|
|
|
function tcgaddsstringcharoptnode.det_resulttype: tnode;
|
|
begin
|
|
det_resulttype := nil;
|
|
resulttypepass(left);
|
|
resulttypepass(right);
|
|
if codegenerror then
|
|
exit;
|
|
{ update the curmaxlen field (before converting to a string!) }
|
|
updatecurmaxlen;
|
|
if not is_shortstring(left.resulttype.def) then
|
|
inserttypeconv(left,cshortstringtype);
|
|
resulttype:=left.resulttype;
|
|
end;
|
|
|
|
|
|
function tcgaddsstringcharoptnode.pass_1: tnode;
|
|
begin
|
|
pass_1 := nil;
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
expectloc:=LOC_CREFERENCE;
|
|
if not is_constcharnode(right) then
|
|
{ it's not sure we need the register, but we can't know it here yet }
|
|
calcregisters(self,2,0,0)
|
|
else
|
|
calcregisters(self,1,0,0);
|
|
end;
|
|
|
|
|
|
procedure tcgaddsstringcharoptnode.pass_2;
|
|
var
|
|
l: tasmlabel;
|
|
href,href2 : treference;
|
|
hreg, lengthreg: tregister;
|
|
checklength: boolean;
|
|
len : integer;
|
|
begin
|
|
{ first, we have to more or less replicate some code from }
|
|
{ ti386addnode.pass_2 }
|
|
secondpass(left);
|
|
if not(tg.istemp(left.location.reference) and
|
|
(tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and
|
|
not(nf_use_strconcat in flags) then
|
|
begin
|
|
tg.Gettemp(exprasmlist,256,tt_normal,href);
|
|
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
|
|
{ location is released by copyshortstring }
|
|
location_freetemp(exprasmlist,left.location);
|
|
{ return temp reference }
|
|
location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
|
|
left.location.reference:=href;
|
|
end;
|
|
secondpass(right);
|
|
{ special case for string := string + char (JM) }
|
|
hreg.enum:=R_INTREGISTER;
|
|
hreg.number:=NR_NO;
|
|
|
|
{ we have to load the char before checking the length, because we }
|
|
{ may need registers from the reference }
|
|
|
|
{ is it a constant char? }
|
|
if not is_constcharnode(right) then
|
|
{ no, make sure it is in a register }
|
|
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
|
|
begin
|
|
{ free the registers of right }
|
|
reference_release(exprasmlist,right.location.reference);
|
|
{ get register for the char }
|
|
hreg := rg.getregisterint(exprasmlist,OS_8);
|
|
cg.a_load_ref_reg(exprasmlist,OS_8,right.location.reference,hreg);
|
|
{ I don't think a temp char exists, but it won't hurt (JM) }
|
|
tg.ungetiftemp(exprasmlist,right.location.reference);
|
|
end
|
|
else hreg := right.location.register;
|
|
|
|
{ load the current string length }
|
|
lengthreg := rg.getregisterint(exprasmlist,OS_INT);
|
|
cg.a_load_ref_reg(exprasmlist,OS_8,left.location.reference,lengthreg);
|
|
|
|
{ do we have to check the length ? }
|
|
if tg.istemp(left.location.reference) then
|
|
checklength := curmaxlen = 255
|
|
else
|
|
checklength := curmaxlen >= tstringdef(left.resulttype.def).len;
|
|
if checklength then
|
|
begin
|
|
{ is it already maximal? }
|
|
objectlibrary.getlabel(l);
|
|
if tg.istemp(left.location.reference) then
|
|
len:=255
|
|
else
|
|
len:=tstringdef(left.resulttype.def).len;
|
|
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_EQ,len,lengthreg,l)
|
|
end;
|
|
|
|
{ no, so increase the length and add the new character }
|
|
href2 := left.location.reference;
|
|
|
|
{ we need a new reference to store the character }
|
|
{ at the end of the string. Check if the base or }
|
|
{ index register is still free }
|
|
if (href2.base.number <> NR_NO) and
|
|
(href2.index.number <> NR_NO) then
|
|
begin
|
|
{ they're not free, so add the base reg to }
|
|
{ the string length (since the index can }
|
|
{ have a scalefactor) and use lengthreg as base }
|
|
cg.a_op_reg_reg(exprasmlist,OP_ADD,OS_INT,href2.base,lengthreg);
|
|
href2.base := lengthreg;
|
|
end
|
|
else
|
|
{ at least one is still free, so put EDI there }
|
|
if href2.base.number = NR_NO then
|
|
href2.base := lengthreg
|
|
else
|
|
begin
|
|
href2.index := lengthreg;
|
|
{$ifdef i386}
|
|
href2.scalefactor := 1;
|
|
{$endif i386}
|
|
end;
|
|
{ we need to be one position after the last char }
|
|
inc(href2.offset);
|
|
{ store the character at the end of the string }
|
|
if (right.nodetype <> ordconstn) then
|
|
begin
|
|
{ no new_reference(href2) because it's only }
|
|
{ used once (JM) }
|
|
cg.a_load_reg_ref(exprasmlist,OS_8,hreg,href2);
|
|
rg.ungetregisterint(exprasmlist,hreg);
|
|
end
|
|
else
|
|
cg.a_load_const_ref(exprasmlist,OS_8,tordconstnode(right).value,href2);
|
|
lengthreg.number:=(lengthreg.number and not $ff) or R_SUBL;
|
|
{ increase the string length }
|
|
cg.a_op_const_reg(exprasmlist,OP_ADD,1,lengthreg);
|
|
cg.a_load_reg_ref(exprasmlist,OS_8,lengthreg,left.location.reference);
|
|
rg.ungetregisterint(exprasmlist,lengthreg);
|
|
if checklength then
|
|
cg.a_label(exprasmlist,l);
|
|
location_copy(location,left.location);
|
|
end;
|
|
|
|
procedure tcgaddsstringcsstringoptnode.pass_2;
|
|
var
|
|
href: treference;
|
|
pushedregs: tpushedsavedint;
|
|
regstopush: tsupregset;
|
|
begin
|
|
{ first, we have to more or less replicate some code from }
|
|
{ ti386addnode.pass_2 }
|
|
secondpass(left);
|
|
if not(tg.istemp(left.location.reference) and
|
|
(tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and
|
|
not(nf_use_strconcat in flags) then
|
|
begin
|
|
tg.GetTemp(exprasmlist,256,tt_normal,href);
|
|
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
|
|
{ release the registers }
|
|
location_freetemp(exprasmlist,left.location);
|
|
{ return temp reference }
|
|
location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
|
|
left.location.reference:=href;
|
|
end;
|
|
secondpass(right);
|
|
{ on the right we do not need the register anymore too }
|
|
{ Instead of releasing them already, simply do not }
|
|
{ push them (so the release is in the right place, }
|
|
{ because emitpushreferenceaddr doesn't need extra }
|
|
{ registers) (JM) }
|
|
regstopush := all_intregisters;
|
|
remove_non_regvars_from_loc(right.location,regstopush);
|
|
rg.saveusedintregisters(exprasmlist,pushedregs,regstopush);
|
|
{ push the maximum possible length of the result }
|
|
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
|
|
{ the optimizer can more easily put the }
|
|
{ deallocations in the right place if it happens }
|
|
{ too early than when it happens too late (if }
|
|
{ the pushref needs a "lea (..),edi; push edi") }
|
|
reference_release(exprasmlist,right.location.reference);
|
|
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
|
|
rg.saveintregvars(exprasmlist,regstopush);
|
|
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
|
|
tg.ungetiftemp(exprasmlist,right.location.reference);
|
|
rg.restoreusedintregisters(exprasmlist,pushedregs);
|
|
location_copy(location,left.location);
|
|
end;
|
|
|
|
begin
|
|
caddsstringcharoptnode := tcgaddsstringcharoptnode;
|
|
caddsstringcsstringoptnode := tcgaddsstringcsstringoptnode
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.1 2003-04-24 11:20:06 florian
|
|
+ created from n386opt
|
|
} |