paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 01:09:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed several sparc alignment issues

Browse Source 
+ Jonas' inline node patch; non functional yet
This commit is contained in:
florian 2004-08-14 14:50:42 +00:00
parent f46756e96b
commit 6368652be2
5 changed files with 213 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/aasmtai.pas
View File

@ -182,9 +182,9 @@ interface
{ please keep the size of this record <=12 bytes and keep it properly aligned }
toper = record
ot : longint;
{$ifdef cpuarm}
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
dummy1,dummy2,dummy3 : byte;
{$endif cpuarm}
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
case typ : toptype of
top_none : ();
top_reg : (reg:tregister);
@ -2217,7 +2217,11 @@ begin
end.
{
$Log$
Revision 1.86 2004-06-20 08:55:28 florian
Revision 1.87 2004-08-14 14:50:42 florian
* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet
Revision 1.86 2004/06/20 08:55:28 florian
* logs truncated
Revision 1.85 2004/06/16 20:07:06 florian

210
compiler/ncal.pas
View File

@ -50,6 +50,10 @@ interface
tcallnode = class(tbinarynode)
private
{$ifndef VER1_0}
{ info for inlining }
inlinelocals: array of tnode;
{$endif VER1_0}
{ number of parameters passed from the source, this does not include the hidden parameters }
paralength : smallint;
function gen_self_tree_methodpointer:tnode;
@ -66,6 +70,9 @@ interface
procedure createinlineparas(var createstatement, deletestatement: tstatementnode);
function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
{$ifndef VER1_0}
procedure createlocaltemps(p:TNamedIndexItem;arg:pointer);
{$endif VER1_0}
protected
pushedparasize : longint;
public
@ -1847,8 +1854,10 @@ type
function tcallnode.replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
var
paras: tcallparanode;
temp: tnode;
begin
result := fen_false;
n.fileinfo := pfileposinfo(arg)^;
if (n.nodetype = loadn) then
begin
paras := tcallparanode(left);
@ -1861,56 +1870,171 @@ type
n := paras.left.getcopy;
resulttypepass(n);
result := fen_true;
end
{$ifndef VER1_0}
else
begin
{ local? }
if (tloadnode(n).symtableentry.typ <> varsym) or
(tloadnode(n).symtableentry.owner <> tprocdef(procdefinition).localst) then
exit;
if (tloadnode(n).symtableentry.indexnr > high(inlinelocals)) or
not assigned(inlinelocals[tloadnode(n).symtableentry.indexnr]) then
internalerror(20040720);
temp := inlinelocals[tloadnode(n).symtableentry.indexnr].getcopy;
n.free;
n := temp;
resulttypepass(n);
result := fen_true;
end;
{$endif ndef VER1_0}
end;
end;
{$ifndef VER1_0}
type
ptempnodes = ^ttempnodes;
ttempnodes = record
createstatement, deletestatement: tstatementnode;
end;
procedure tcallnode.createlocaltemps(p:TNamedIndexItem;arg:pointer);
var
tempinfo: ptempnodes absolute ptempnodes(arg);
tempnode: ttempcreatenode;
begin
if (tsymentry(p).typ <> varsym) then
exit;
if (p.indexnr > high(inlinelocals)) then
setlength(inlinelocals,p.indexnr+10);
{$ifndef VER1_0}
if (vo_is_funcret in tvarsym(p).varoptions) and
assigned(funcretnode) then
begin
if node_complexity(funcretnode) > 1 then
begin
{ can this happen? }
{ we may have to replace the funcretnode with the address of funcretnode }
{ loaded in a temp in this case, because the expression may e.g. contain }
{ a global variable that gets changed inside the function }
internalerror(2004072101);
end;
inlinelocals[tvarsym(p).indexnr] := funcretnode.getcopy
end
else
{$endif ndef VER1_0}
begin
if (cs_regvars in aktglobalswitches) and
(([vo_regable{$ifndef x86},vo_fpuregable{$endif}] * tvarsym(p).varoptions) <> []) and
(not tvarsym(p).vartype.def.needs_inittable) then
tempnode := ctempcreatenode.create_reg(tvarsym(p).vartype,tvarsym(p).vartype.def.size,tt_persistent)
else
tempnode := ctempcreatenode.create(tvarsym(p).vartype,tvarsym(p).vartype.def.size,tt_persistent);
addstatement(tempinfo^.createstatement,tempnode);
if assigned(tvarsym(p).defaultconstsym) then
begin
{ warning: duplicate from psub.pas:initializevars() -> must refactor }
addstatement(tempinfo^.createstatement,cassignmentnode.create(
ctemprefnode.create(tempnode),
cloadnode.create(tvarsym(p).defaultconstsym,tvarsym(p).defaultconstsym.owner)));
end;
if (vo_is_funcret in tvarsym(p).varoptions) then
begin
funcretnode := ctemprefnode.create(tempnode);
addstatement(tempinfo^.deletestatement,ctempdeletenode.create_normal_temp(tempnode));
end
else
addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
inlinelocals[p.indexnr] := ctemprefnode.create(tempnode);
end;
end;
{$endif ndef VER1_0}
procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode);
var
para: tcallparanode;
tempnode: ttempcreatenode;
hp: tnode;
{$ifndef VER1_0}
tempnodes: ttempnodes;
{$endif ndef VER1_0}
begin
{ parameters }
para := tcallparanode(left);
while assigned(para) do
begin
{ create temps for value parameters, and also for const parameters }
{ which are passed by value instead of by reference }
if (para.paraitem.paratyp = vs_value) or
((para.paraitem.paratyp = vs_const) and
not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption)) then
if (para.paraitem.parasym.typ = varsym) and
{ para.left will already be the same as funcretnode in the following case, so don't change }
(not(vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) or
(not assigned(funcretnode))) then
begin
if (cs_regvars in aktglobalswitches) and
(([vo_regable,vo_fpuregable] * tvarsym(para.paraitem.parasym).varoptions) <> []) and
(not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
else
tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
addstatement(createstatement,tempnode);
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
para.left));
para.left := ctemprefnode.create(tempnode);
addstatement(deletestatement,ctempdeletenode.create(tempnode));
end
else if node_complexity(para.left) > 1 then
begin
if (cs_regvars in aktglobalswitches) and
not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable then
tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
else
tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
addstatement(createstatement,tempnode);
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
caddrnode.create(para.left)));
hp := cderefnode.create(ctemprefnode.create(tempnode));
inserttypeconv_explicit(hp,para.left.resulttype);
para.left := hp;
addstatement(deletestatement,ctempdeletenode.create(tempnode));
{ create temps for value parameters, function result and also for }
{ const parameters which are passed by value instead of by reference }
if (vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) or
(para.paraitem.paratyp = vs_value) or
((para.paraitem.paratyp = vs_const) and
(not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption) or
{ the problem is that we can't take the address of a function result :( }
(node_complexity(para.left) >= NODE_COMPLEXITY_INF))) then
begin
if (cs_regvars in aktglobalswitches) and
(([vo_regable,vo_fpuregable] * tvarsym(para.paraitem.parasym).varoptions) <> []) and
(not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
else
tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
addstatement(createstatement,tempnode);
{ assign the value of the parameter to the temp, except in case of the function result }
{ (in that case, para.left is a block containing the creation of a new temp, while we }
{ only need a temprefnode, so delete the old stuff) }
if not(vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) then
begin
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
para.left));
para.left := ctemprefnode.create(tempnode);
addstatement(deletestatement,ctempdeletenode.create(tempnode));
end
else
begin
if not(assigned(funcretnode)) then
funcretnode := ctemprefnode.create(tempnode);
para.left.free;
para.left := ctemprefnode.create(tempnode);
addstatement(deletestatement,ctempdeletenode.create_normal_temp(tempnode));
end
end
else if node_complexity(para.left) > 1 then
begin
if (cs_regvars in aktglobalswitches) and
not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable then
tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
else
tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
addstatement(createstatement,tempnode);
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
caddrnode.create(para.left)));
hp := cderefnode.create(ctemprefnode.create(tempnode));
inserttypeconv_explicit(hp,para.left.resulttype);
para.left := hp;
addstatement(deletestatement,ctempdeletenode.create(tempnode));
end;
para := tcallparanode(para.right);
end;
para := tcallparanode(para.right);
end;
{$ifndef VER1_0}
{ local variables }
if not assigned(tprocdef(procdefinition).localst) or
(tprocdef(procdefinition).localst.symindex.count = 0) then
exit;
tempnodes.createstatement := createstatement;
tempnodes.deletestatement := deletestatement;
setlength(inlinelocals,tprocdef(procdefinition).localst.symindex.count);
tprocdef(procdefinition).localst.foreach({$ifdef FPCPROCVAR}@{$endif}createlocaltemps,@tempnodes);
createstatement := tempnodes.createstatement;
deletestatement := tempnodes.deletestatement;
{$endif ndef VER1_0}
end;
@ -1918,11 +2042,12 @@ type
var
createstatement,deletestatement: tstatementnode;
createblock,deleteblock: tblocknode;
i: longint;
label
errorexit;
begin
result:=nil;
{!!!!!!!!
if (procdefinition.proccalloption=pocall_inline) and
{ can we inline this procedure at the node level? }
(tprocdef(procdefinition).inlininginfo^.inlinenode) then
@ -1948,9 +2073,18 @@ type
{ replace complex parameters with temps }
createinlineparas(createstatement,deletestatement);
{ replace the parameter loads with the parameter values }
foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,pointer(funcretnode));
foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,@fileinfo);
{ free the temps for the locals }
for i := 0 to high(inlinelocals) do
if assigned(inlinelocals[i]) then
inlinelocals[i].free;
setlength(inlinelocals,0);
addstatement(createstatement,result);
addstatement(createstatement,deleteblock);
{ set function result location if necessary }
if assigned(funcretnode) and
(cnf_return_value_used in callnodeflags) then
addstatement(createstatement,funcretnode.getcopy);
result := createblock;
{ consider it must not be inlined if called
again inside the args or itself }
@ -1960,7 +2094,7 @@ type
exit;
end;
end;
}
{ calculate the parameter info for the procdef }
if not procdefinition.has_paraloc_info then
begin
@ -2258,7 +2392,11 @@ begin
end.
{
$Log$
Revision 1.243 2004-07-16 19:45:15 jonas
Revision 1.244 2004-08-14 14:50:42 florian
* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet
Revision 1.243 2004/07/16 19:45:15 jonas
+ temps can now also hold fpu values in registers (take care with use,
bacause of the x86 fpu stack)
* fpu parameters to node-inlined procedures can now also be put in

25
compiler/psub.pas
View File

@ -155,11 +155,14 @@ implementation
tvarsym(p).vartype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);
end;
{
must be done at the end of the program, not at the end of the procedure
typedconstsym :
begin
if ttypedconstsym(p).typedconsttype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);
end;
}
end;
end;
@ -969,23 +972,15 @@ implementation
begin
result := false;
if not assigned(procdef.inlininginfo^.code) or
(po_assembler in procdef.procoptions) or
{ no locals }
(tprocdef(procdef).localst.symsearch.count <> 0) or
{ procedure, not function }
(not is_void(procdef.rettype.def)) then
(po_assembler in procdef.procoptions) then
exit;
paraitem:=tparaitem(procdef.para.first);
{ all call by reference parameters, or parameters which don't }
{ get a new value? }
{ also note: in theory, if there are only value parameters and none of those }
{ are changed, we could also inline the paras. However, the compiler does }
{ not distinguish between "used but not changed" and "used and changed" }
{ (both are represented by vs_used), so that this not yet possible to do }
while assigned(paraitem) do
begin
{ we can't handle formaldefs, valuepara's which get a new value and special arrays }
{ we can't handle formaldefs and special arrays (the latter may need a }
{ re-basing of the index, i.e. if you pass an array[1..10] as open array, }
{ you have to add 1 to all index operations if you directly inline it }
if ((paraitem.paratyp in [vs_out,vs_var]) and
(paraitem.paratype.def.deftype=formaldef)) or
is_special_array(paraitem.paratype.def) then
@ -1428,7 +1423,11 @@ implementation
end.
{
$Log$
Revision 1.202 2004-07-16 21:11:31 jonas
Revision 1.203 2004-08-14 14:50:42 florian
* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet
Revision 1.202 2004/07/16 21:11:31 jonas
- disable node-based inlining of routines with special array parameters
for now (de indexes of open arrays have to be changed, because on the
caller-side these routines are not necessarily 0-based)

12
compiler/sparc/cpubase.pas
View File

@ -224,7 +224,11 @@ type
References are given from the caller's point of view. The usual
TLocation isn't used, because contains a lot of unnessary fields.
}
tparalocation = packed record
tparalocation =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
Size : TCGSize;
{ The location type where the parameter is passed, usually
LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
@ -567,7 +571,11 @@ implementation
end.
{
$Log$
Revision 1.68 2004-07-26 04:00:35 mazen
Revision 1.69 2004-08-14 14:50:42 florian
* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet
Revision 1.68 2004/07/26 04:00:35 mazen
* fix compile problem
Revision 1.67 2004/06/20 08:55:32 florian

12
compiler/symdef.pas
View File

@ -455,7 +455,11 @@ interface
{$ifdef i386}
fpu_used : byte; { how many stack fpu must be empty }
{$endif i386}
funcret_paraloc : packed array[tcallercallee] of tparalocation;
funcret_paraloc :
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
array[tcallercallee] of tparalocation;
has_paraloc_info : boolean; { paraloc info is available }
constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile);
@ -6146,7 +6150,11 @@ implementation
end.
{
$Log$
Revision 1.249 2004-08-07 14:52:45 florian
Revision 1.250 2004-08-14 14:50:42 florian
* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet
Revision 1.249 2004/08/07 14:52:45 florian
* fixed web bug 3226: type p = type pointer;
Revision 1.248 2004/07/19 19:15:50 florian