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

* gen high tree makes copy in temp when there is a calln

Browse Source
This commit is contained in:
peter 2004-10-12 14:36:38 +00:00
parent 4a7e02d817
commit 560a790a57
3 changed files with 87 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/nbas.pas
View File

@ -193,6 +193,7 @@ interface
{ Create a blocknode and statement node for multiple statements
generated internally by the parser }
function internalstatements(var laststatement:tstatementnode):tblocknode;
function laststatement(block:tblocknode):tstatementnode;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
@ -220,6 +221,14 @@ implementation
end;
function laststatement(block:tblocknode):tstatementnode;
begin
result:=tstatementnode(block.left);
while assigned(result) do
result:=tstatementnode(result.right);
end;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
begin
if assigned(laststatement.right) then
@ -1018,7 +1027,10 @@ begin
end.
{
$Log$
Revision 1.87 2004-09-26 17:45:30 peter
Revision 1.88 2004-10-12 14:36:38 peter
* gen high tree makes copy in temp when there is a calln
Revision 1.87 2004/09/26 17:45:30 peter
* simple regvar support, not yet finished
Revision 1.86 2004/07/16 19:45:15 jonas

106
compiler/ncal.pas
View File

@ -87,7 +87,7 @@ interface
procdefinitionderef : tderef;
{ tree that contains the pointer to the object for this method }
methodpointerinit,
methodpointerdone,
methodpointerdone : tblocknode;
methodpointer : tnode;
{ inline function body }
inlinecode : tnode;
@ -220,7 +220,58 @@ type
end;
function gen_high_tree(p:tnode;paradef:tdef):tnode;
procedure maybe_load_para_in_temp(var p:tnode);
var
hp : tnode;
ptemp : ttempcreatenode;
newinitstatement,
newdonestatement : tstatementnode;
begin
if not assigned(aktcallnode) then
internalerror(200410121);
hp:=p;
while assigned(hp) and
(hp.nodetype=typeconvn) do
hp:=tunarynode(hp).left;
if assigned(hp) and
(
{ call result must always be loaded in temp to prevent
double creation }
(hp.nodetype=calln)
{ Also optimize also complex loads }
{$warning Complex loads can also be optimized}
// or not(hp.nodetype in [typen,loadvmtaddrn,loadn])
) then
begin
if not assigned(aktcallnode.methodpointerinit) then
begin
aktcallnode.methodpointerinit:=internalstatements(newinitstatement);
aktcallnode.methodpointerdone:=internalstatements(newdonestatement);
end
else
begin
newinitstatement:=laststatement(aktcallnode.methodpointerinit);
newdonestatement:=laststatement(aktcallnode.methodpointerdone);
end;
{ temp create }
ptemp:=ctempcreatenode.create_reg(p.resulttype,p.resulttype.def.size,tt_persistent);
addstatement(newinitstatement,ptemp);
addstatement(newinitstatement,cassignmentnode.create(
ctemprefnode.create(ptemp),
p));
resulttypepass(aktcallnode.methodpointerinit);
{ new tree is only a temp reference }
p:=ctemprefnode.create(ptemp);
resulttypepass(p);
{ temp release }
addstatement(newdonestatement,ctempdeletenode.create(ptemp));
resulttypepass(aktcallnode.methodpointerdone);
end;
end;
function gen_high_tree(var p:tnode;paradef:tdef):tnode;
var
temp: tnode;
len : integer;
@ -240,6 +291,7 @@ type
len:=0
else
begin
maybe_load_para_in_temp(p);
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,p.getcopy);
@ -258,6 +310,7 @@ type
begin
if is_open_string(paradef) then
begin
maybe_load_para_in_temp(p);
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,p.getcopy);
@ -273,6 +326,7 @@ type
end
else
begin
maybe_load_para_in_temp(p);
hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
cordconstnode.create(1,s32inttype,false));
loadconst:=false;
@ -789,8 +843,8 @@ type
ppufile.getderef(procdefinitionderef);
ppufile.getsmallset(callnodeflags);
methodpointer:=ppuloadnode(ppufile);
methodpointerinit:=ppuloadnode(ppufile);
methodpointerdone:=ppuloadnode(ppufile);
methodpointerinit:=tblocknode(ppuloadnode(ppufile));
methodpointerdone:=tblocknode(ppuloadnode(ppufile));
_funcretnode:=ppuloadnode(ppufile);
inlinecode:=ppuloadnode(ppufile);
end;
@ -885,7 +939,7 @@ type
n.restype := restype;
n.callnodeflags := callnodeflags;
if assigned(methodpointerinit) then
n.methodpointerinit:=methodpointerinit.getcopy
n.methodpointerinit:=tblocknode(methodpointerinit.getcopy)
else
n.methodpointerinit:=nil;
{ methodpointerinit is copied, now references to the temp will also be copied
@ -899,7 +953,7 @@ type
else
n.methodpointer:=nil;
if assigned(methodpointerdone) then
n.methodpointerdone:=methodpointerdone.getcopy
n.methodpointerdone:=tblocknode(methodpointerdone.getcopy)
else
n.methodpointerdone:=nil;
if assigned(_funcretnode) then
@ -1352,8 +1406,6 @@ type
method_must_be_valid,
is_const : boolean;
hp : tnode;
mptemp : ttempcreatenode;
newstatement : tstatementnode;
label
errorexit;
begin
@ -1361,7 +1413,7 @@ type
candidates:=nil;
oldcallnode:=aktcallnode;
aktcallnode:=nil;
aktcallnode:=self;
{ determine length of parameter list }
pt:=tcallparanode(left);
@ -1383,35 +1435,7 @@ type
if assigned(methodpointer) then
begin
resulttypepass(methodpointer);
hp:=methodpointer;
while assigned(hp) and
(hp.nodetype=typeconvn) do
hp:=tunarynode(hp).left;
if assigned(hp) and
(
{ call result must always be loaded in temp to prevent
double creation }
(hp.nodetype=calln)
{ Also optimize also complex loads }
{$warning Complex loads can also be optimized}
// not(hp.nodetype in [typen,loadvmtaddrn,loadn])
) then
begin
{ methodpointer loading }
methodpointerinit:=internalstatements(newstatement);
mptemp:=ctempcreatenode.create_reg(methodpointer.resulttype,methodpointer.resulttype.def.size,tt_persistent);
addstatement(newstatement,mptemp);
addstatement(newstatement,cassignmentnode.create(
ctemprefnode.create(mptemp),
methodpointer));
resulttypepass(methodpointerinit);
{ new methodpointer is only a temp reference }
methodpointer:=ctemprefnode.create(mptemp);
resulttypepass(methodpointer);
{ methodpointer cleanup }
methodpointerdone:=ctempdeletenode.create(mptemp);
resulttypepass(methodpointerdone);
end;
maybe_load_para_in_temp(methodpointer);
end;
{ procedure variable ? }
@ -1745,7 +1769,6 @@ type
convert_carg_array_of_const;
{ bind paraitems to the callparanodes and insert hidden parameters }
aktcallnode:=self;
bind_paraitem;
{ methodpointer is only needed for virtual calls, and
@ -2392,7 +2415,10 @@ begin
end.
{
$Log$
Revision 1.250 2004-10-10 20:22:53 peter
Revision 1.251 2004-10-12 14:36:38 peter
* gen high tree makes copy in temp when there is a calln
Revision 1.250 2004/10/10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters

13
compiler/pdecvar.pas
View File

@ -169,7 +169,7 @@ implementation
IncompatibleTypes(p.resulttype.def,tarraydef(def).rangetype.def);
end
else
Message(parser_e_illegal_expression)
Message(type_e_ordinal_expr_expected)
end;
p.free;
pl.addconst(sl_vec,idx);
@ -334,7 +334,7 @@ implementation
consume(_COLON);
{ insert types in global symtable }
oldsymtablestack:=symtablestack;
while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
symtablestack:=symtablestack.next;
single_type(p.proptype,hs,false);
symtablestack:=oldsymtablestack;
@ -769,7 +769,7 @@ implementation
newtype.free;
end;
{$ifdef powerpc}
{ from gcc/gcc/config/rs6000/rs6000.h:
{ from gcc/gcc/config/rs6000/rs6000.h:
/* APPLE LOCAL begin Macintosh alignment 2002-1-22 ff */
/* Return the alignment of a struct based on the Macintosh PowerPC
alignment rules. In general the alignment of a struct is
@ -791,7 +791,7 @@ implementation
maxpadalign := tempdef.alignment
else
maxpadalign := trecorddef(tempdef).padalignment;
if (maxpadalign > 4) and
(maxpadalign > trecordsymtable(symtablestack).padalignment) then
trecordsymtable(symtablestack).padalignment := maxpadalign;
@ -1288,7 +1288,10 @@ implementation
end.
{
$Log$
Revision 1.79 2004-08-17 16:29:21 jonas
Revision 1.80 2004-10-12 14:36:38 peter
* gen high tree makes copy in temp when there is a calln
Revision 1.79 2004/08/17 16:29:21 jonas
+ padalgingment field for recordsymtables (saved by recorddefs)
+ support for Macintosh PowerPC alignment (if the first field of a record
or union has an alignment > 4, then the record or union size must be