From 6368652be223cfbe8b26f714895f05e199f74675 Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 14 Aug 2004 14:50:42 +0000 Subject: [PATCH] * fixed several sparc alignment issues + Jonas' inline node patch; non functional yet --- compiler/aasmtai.pas | 10 +- compiler/ncal.pas | 210 ++++++++++++++++++++++++++++++------- compiler/psub.pas | 25 +++-- compiler/sparc/cpubase.pas | 12 ++- compiler/symdef.pas | 12 ++- 5 files changed, 213 insertions(+), 56 deletions(-) diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index fbd52b5138..dadd9be94f 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -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 diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 22fe5af4b8..ad03b4ce21 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -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 diff --git a/compiler/psub.pas b/compiler/psub.pas index 48e3acedfd..edb641f6fa 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -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) diff --git a/compiler/sparc/cpubase.pas b/compiler/sparc/cpubase.pas index 9f712fc2a3..132c2204d8 100644 --- a/compiler/sparc/cpubase.pas +++ b/compiler/sparc/cpubase.pas @@ -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 diff --git a/compiler/symdef.pas b/compiler/symdef.pas index b59806d88b..8cc013b7a8 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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