From 51384ca53cc78aa7fab40193ec52ae45444fcf43 Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 23 Nov 2003 17:05:15 +0000 Subject: [PATCH] * register calling is left-right * parameter ordering * left-right calling inserts result parameter last --- compiler/i386/cpupara.pas | 88 +++++++++++++++++++++++++++++++-------- compiler/ncal.pas | 84 ++++++++++++++++++++++++++++++++++++- compiler/ncgcal.pas | 31 +++++--------- compiler/ncgutil.pas | 51 +++++++++++++---------- compiler/pdecsub.pas | 16 ++++--- compiler/pdecvar.pas | 28 ++++++++++--- compiler/psub.pas | 8 +++- compiler/symconst.pas | 15 +++++-- compiler/symsym.pas | 21 +++++++--- 9 files changed, 260 insertions(+), 82 deletions(-) diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index a327909e93..3e4059e041 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -327,20 +327,51 @@ unit cpupara; paraloc.size:=def_cgsize(hp.paratype.def); paraloc.loc:=LOC_REFERENCE; paraloc.alignment:=paraalign; - paraloc.reference.index:=NR_FRAME_POINTER_REG; + if side=callerside then + paraloc.reference.index:=NR_STACK_POINTER_REG + else + paraloc.reference.index:=NR_FRAME_POINTER_REG; l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); - varalign:=size_2_align(l); - paraloc.reference.offset:=parasize+target_info.first_parm_offset; - varalign:=used_align(varalign,paraalign,paraalign); + varalign:=used_align(size_2_align(l),paraalign,paraalign); + paraloc.reference.offset:=parasize; parasize:=align(parasize+l,varalign); - if (side=callerside) then - begin - paraloc.reference.index:=NR_STACK_POINTER_REG; - dec(paraloc.reference.offset,POINTER_SIZE); - end; hp.paraloc[side]:=paraloc; hp:=tparaitem(hp.next); end; + { Adapt offsets, for right-to-left calling we need to reverse the + offsets for the caller. For left-to-right calling we need to + reverse the offsets in the callee } + if (side=callerside) then + begin + if not(p.proccalloption in pushleftright_pocalls) then + begin + hp:=tparaitem(p.para.first); + while assigned(hp) do + begin + l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); + varalign:=used_align(size_2_align(l),paraalign,paraalign); + l:=align(l,varalign); + hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l; + hp:=tparaitem(hp.next); + end; + end; + end + else + begin + hp:=tparaitem(p.para.first); + while assigned(hp) do + begin + if (p.proccalloption in pushleftright_pocalls) then + begin + l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); + varalign:=used_align(size_2_align(l),paraalign,paraalign); + l:=align(l,varalign); + hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l; + end; + inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset); + hp:=tparaitem(hp.next); + end; + end; { We need to return the size allocated } result:=parasize; end; @@ -385,6 +416,7 @@ unit cpupara; if (parareg<=high(parasupregs)) and not( is_64bit or + (hp.paratype.def.deftype=floatdef) or ((hp.paratype.def.deftype in [floatdef,recorddef,arraydef]) and (not pushaddr)) ) then @@ -401,22 +433,37 @@ unit cpupara; else begin paraloc.loc:=LOC_REFERENCE; - paraloc.reference.index:=NR_FRAME_POINTER_REG; + if side=callerside then + paraloc.reference.index:=NR_STACK_POINTER_REG + else + paraloc.reference.index:=NR_FRAME_POINTER_REG; l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); varalign:=size_2_align(l); - paraloc.reference.offset:=parasize+target_info.first_parm_offset; + paraloc.reference.offset:=parasize; varalign:=used_align(varalign,paraalign,paraalign); parasize:=align(parasize+l,varalign); end; - if (side=callerside) and - (paraloc.loc=LOC_REFERENCE) then - begin - paraloc.reference.index:=NR_STACK_POINTER_REG; - dec(paraloc.reference.offset,POINTER_SIZE); - end; hp.paraloc[side]:=paraloc; hp:=tparaitem(hp.next); end; + { Register parameters are assigned from left-to-right, adapt offset + for calleeside to be reversed } + if (side=calleeside) then + begin + hp:=tparaitem(p.para.first); + while assigned(hp) do + begin + if (hp.paraloc[side].loc=LOC_REFERENCE) then + begin + l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); + varalign:=used_align(size_2_align(l),paraalign,paraalign); + l:=align(l,varalign); + hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l+ + target_info.first_parm_offset; + end; + hp:=tparaitem(hp.next); + end; + end; { We need to return the size allocated } result:=parasize; end; @@ -450,7 +497,12 @@ begin end. { $Log$ - Revision 1.43 2003-11-11 21:11:23 peter + Revision 1.44 2003-11-23 17:05:16 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.43 2003/11/11 21:11:23 peter * check for push_addr Revision 1.42 2003/10/19 01:34:30 florian diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 68a934b61f..8051227640 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -75,6 +75,7 @@ interface _funcretnode : tnode; procedure setfuncretnode(const returnnode: tnode); procedure convert_carg_array_of_const; + procedure order_parameters; public { the symbol containing the definition of the procedure } { to call } @@ -2335,6 +2336,68 @@ type end; + procedure tcallnode.order_parameters; + var + hp,hpcurr,hpnext,hpfirst,hpprev : tcallparanode; + currloc : tcgloc; + begin + hpfirst:=nil; + hpcurr:=tcallparanode(left); + while assigned(hpcurr) do + begin + { pull out } + hpnext:=tcallparanode(hpcurr.right); + { pull in at the correct place. + Used order: + 1. LOC_REFERENCE with smallest offset (x86 only) + 2. LOC_REFERENCE with most registers + 3. LOC_REGISTER with most registers } + currloc:=hpcurr.paraitem.paraloc[callerside].loc; + hpprev:=nil; + hp:=hpfirst; + while assigned(hp) do + begin + case currloc of + LOC_REFERENCE : + begin + case hp.paraitem.paraloc[callerside].loc of + LOC_REFERENCE : + begin + if (hpcurr.registers32>hp.registers32) +{$ifdef x86} + or (hpcurr.paraitem.paraloc[callerside].reference.offsethp.registers32) then + break; + end; + end; + hpprev:=hp; + hp:=tcallparanode(hp.right); + end; + hpcurr.right:=hp; + if assigned(hpprev) then + hpprev.right:=hpcurr + else + hpfirst:=hpcurr; + { next } + hpcurr:=hpnext; + end; + left:=hpfirst; + end; + + function tcallnode.pass_1 : tnode; {$ifdef m68k} var @@ -2345,10 +2408,24 @@ type begin result:=nil; + { calculate the parameter info for the procdef } + if not procdefinition.has_paraloc_info then + begin + paramanager.create_paraloc_info(procdefinition,callerside); + procdefinition.has_paraloc_info:=true; + end; + + { calculate the parameter info for varargs } + if assigned(varargsparas) then + paramanager.create_varargs_paraloc_info(procdefinition,varargsparas); + { work trough all parameters to get the register requirements } if assigned(left) then tcallparanode(left).det_registers; + { order parameters } + order_parameters; + { function result node } if assigned(_funcretnode) then firstpass(_funcretnode); @@ -2608,7 +2685,12 @@ begin end. { $Log$ - Revision 1.207 2003-11-10 22:02:52 peter + Revision 1.208 2003-11-23 17:05:15 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.207 2003/11/10 22:02:52 peter * cross unit inlining fixed Revision 1.206 2003/11/10 19:09:29 peter diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 8f15574f90..055fbf5461 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -291,11 +291,6 @@ implementation (nf_varargs_para in flags)) then internalerror(200304242); - { push from left to right if specified } - if assigned(right) and - (aktcallnode.procdefinition.proccalloption in pushleftright_pocalls) then - tcallparanode(right).secondcallparan; - { Skip nothingn nodes which are used after disabling a parameter } if (left.nodetype<>nothingn) then @@ -393,9 +388,8 @@ implementation location_copy(aktcallnode.location,left.location); end; - { push from right to left } - if assigned(right) and - not(aktcallnode.procdefinition.proccalloption in pushleftright_pocalls) then + { next parameter } + if assigned(right) then tcallparanode(right).secondcallparan; end; @@ -667,20 +661,10 @@ implementation end; begin - if not assigned(procdefinition) then + if not assigned(procdefinition) or + not procdefinition.has_paraloc_info then internalerror(200305264); - { calculate the parameter info for the procdef } - if not procdefinition.has_paraloc_info then - begin - paramanager.create_paraloc_info(procdefinition,callerside); - procdefinition.has_paraloc_info:=true; - end; - - { calculate the parameter info for varargs } - if assigned(varargsparas) then - paramanager.create_varargs_paraloc_info(procdefinition,varargsparas); - if resulttype.def.needs_inittable and not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and not assigned(funcretnode) then @@ -1138,7 +1122,12 @@ begin end. { $Log$ - Revision 1.139 2003-11-10 22:02:52 peter + Revision 1.140 2003-11-23 17:05:15 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.139 2003/11/10 22:02:52 peter * cross unit inlining fixed Revision 1.138 2003/11/07 15:58:32 florian diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index a4f877d997..2f8fafecb3 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -1391,28 +1391,30 @@ implementation if (not is_void(current_procinfo.procdef.rettype.def)) and (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then begin - if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc<>LOC_REFERENCE then - internalerror(2003091812); - if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then + if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then begin - list.concat(Tai_stabs.Create(strpnew( - '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); - if (m_result in aktmodeswitches) then - list.concat(Tai_stabs.Create(strpnew( - '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))) - end - else - begin - list.concat(Tai_stabs.Create(strpnew( - '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); - if (m_result in aktmodeswitches) then - list.concat(Tai_stabs.Create(strpnew( - '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); - end; +{$warning Need to add gdb support for ret in param register calling} + if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then + begin + list.concat(Tai_stabs.Create(strpnew( + '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + if (m_result in aktmodeswitches) then + list.concat(Tai_stabs.Create(strpnew( + '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))) + end + else + begin + list.concat(Tai_stabs.Create(strpnew( + '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + if (m_result in aktmodeswitches) then + list.concat(Tai_stabs.Create(strpnew( + '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + end; + end; end; mangled_length:=length(current_procinfo.procdef.mangledname); getmem(p,2*mangled_length+50); @@ -1976,7 +1978,12 @@ implementation end. { $Log$ - Revision 1.168 2003-11-22 00:31:25 jonas + Revision 1.169 2003-11-23 17:05:15 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.168 2003/11/22 00:31:25 jonas + extra allocations of function result regs for the optimiser Revision 1.167 2003/11/11 21:10:12 peter diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 07c312e949..27a64f8518 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -113,7 +113,11 @@ implementation include(vs.varoptions,vo_is_funcret); include(vs.varoptions,vo_regable); pd.parast.insert(vs); - pd.insertpara(vs.vartype,vs,nil,true); + { For left to right add it at the end to be delphi compatible } + if pd.proccalloption in pushleftright_pocalls then + pd.concatpara(nil,vs.vartype,vs,nil,true) + else + pd.insertpara(vs.vartype,vs,nil,true); { Store the this symbol as funcretsym for procedures } if pd.deftype=procdef then tprocdef(pd).funcretsym:=vs; @@ -1773,9 +1777,6 @@ const { insert parentfp parameter if required } insert_parentfp_para(pd); - if pd.proccalloption=pocall_pascal then - tparaitem(pd.para.first):=reverseparaitems(tparaitem(pd.para.first)); - currpara:=tparaitem(pd.para.first); while assigned(currpara) do begin @@ -2151,7 +2152,12 @@ const end. { $Log$ - Revision 1.154 2003-11-12 15:49:06 peter + Revision 1.155 2003-11-23 17:05:15 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.154 2003/11/12 15:49:06 peter * virtual conflicts with override Revision 1.153 2003/11/10 19:09:29 peter diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 74ed8b6583..491b7bb17d 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -186,11 +186,22 @@ implementation the symbols of the types } oldsymtablestack:=symtablestack; symtablestack:=symtablestack.next; - read_type(tt,'',true); + read_type(tt,'',false); symtablestack:=oldsymtablestack; end else - read_type(tt,'',true); + read_type(tt,'',false); + { Process procvar directives } + if (tt.def.deftype=procvardef) and + (tt.def.typesym=nil) and + is_proc_directive(token,true) then + begin + newtype:=ttypesym.create('unnamed',tt); + parse_var_proc_directives(tsym(newtype)); + newtype.restype.def:=nil; + tt.def.typesym:=nil; + newtype.free; + end; { types that use init/final are not allowed in variant parts, but classes are allowed } if (variantrecordlevel>0) and @@ -373,10 +384,11 @@ implementation consume(_SEMICOLON); end; end; - { Parse procvar directives after ; } + { Add calling convention for procvars } if (tt.def.deftype=procvardef) and (tt.def.typesym=nil) then begin + { Parse procvar directives after ; } if is_proc_directive(token,true) then begin newtype:=ttypesym.create('unnamed',tt); @@ -387,7 +399,8 @@ implementation end; { Add calling convention for procvar } handle_calling_convention(tprocvardef(tt.def)); - end; + calc_parast(tprocvardef(tt.def)); + end; { Check for variable directives } if not symdone and (token=_ID) then begin @@ -646,7 +659,12 @@ implementation end. { $Log$ - Revision 1.57 2003-10-28 15:36:01 peter + Revision 1.58 2003-11-23 17:05:15 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.57 2003/10/28 15:36:01 peter * absolute to object field supported, fixes tb0458 Revision 1.56 2003/10/05 12:55:37 peter diff --git a/compiler/psub.pas b/compiler/psub.pas index adc1f22139..a0a382d699 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -608,6 +608,7 @@ implementation oldaktmaxfpuregisters:=aktmaxfpuregisters; current_procinfo:=self; + aktfilepos:=entrypos; { get new labels } aktbreaklabel:=nil; @@ -1314,7 +1315,12 @@ implementation end. { $Log$ - Revision 1.172 2003-11-22 00:40:19 jonas + Revision 1.173 2003-11-23 17:05:16 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.172 2003/11/22 00:40:19 jonas * fixed optimiser so it compiles again * fixed several bugs which were in there already for a long time, but which only popped up now :) -O2/-O3 will now optimise less than in diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 08b223bb0e..24d649436c 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -350,9 +350,7 @@ const pocall_cdecl,pocall_cppdecl,pocall_palmossyscall ]; - pushleftright_pocalls = [ - pocall_pascal - ]; + pushleftright_pocalls : tproccalloptions = [pocall_register,pocall_pascal]; SymTypeName : array[tsymtyp] of string[12] = ( 'abstractsym','variable','type','proc','unit', @@ -374,10 +372,19 @@ const implementation +initialization + if pocall_default in [pocall_register,pocall_internproc] then + include(pushleftright_pocalls,pocall_compilerproc); + end. { $Log$ - Revision 1.70 2003-11-07 15:58:32 florian + Revision 1.71 2003-11-23 17:05:16 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.70 2003/11/07 15:58:32 florian * Florian's culmutative nr. 1; contains: - invalid calling conventions for a certain cpu are rejected - arm softfloat calling conventions diff --git a/compiler/symsym.pas b/compiler/symsym.pas index b1c1a7313c..f9a758371b 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -1124,11 +1124,17 @@ implementation currpara:=tparaitem(currpara.next); if assigned(currpara) then begin - if (currpara.next=nil) and - equal_defs(currpara.paratype.def,firstpara) then + if equal_defs(currpara.paratype.def,firstpara) then begin - search_procdef_unary_operator:=pd^.def; - break; + { This must be the last not hidden parameter } + currpara:=tparaitem(currpara.next); + while assigned(currpara) and (currpara.is_hidden) do + currpara:=tparaitem(currpara.next); + if currpara=nil then + begin + search_procdef_unary_operator:=pd^.def; + break; + end; end; end; pd:=pd^.next; @@ -2683,7 +2689,12 @@ implementation end. { $Log$ - Revision 1.134 2003-10-30 16:23:13 peter + Revision 1.135 2003-11-23 17:05:16 peter + * register calling is left-right + * parameter ordering + * left-right calling inserts result parameter last + + Revision 1.134 2003/10/30 16:23:13 peter * don't search for overloads in parents for constructors Revision 1.133 2003/10/29 21:56:28 peter