From fd2ad837e273e7fce18a0bbd687a87cd59c14b8e Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 24 Jan 2002 18:25:48 +0000 Subject: [PATCH] * implicit result variable generation for assembler routines * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead --- compiler/globals.pas | 12 ++- compiler/globtype.pas | 11 ++- compiler/i386/cga.pas | 83 +++++++++-------- compiler/i386/ra386.pas | 58 +----------- compiler/i386/ra386att.pas | 10 +- compiler/i386/ra386int.pas | 10 +- compiler/ncal.pas | 92 +++++++++++++----- compiler/ninl.pas | 8 +- compiler/pdecobj.pas | 13 ++- compiler/pdecsub.pas | 8 +- compiler/pexpr.pas | 12 ++- compiler/pmodules.pas | 8 +- compiler/pstatmnt.pas | 186 +++++++++++++++++++++++++------------ compiler/ptconst.pas | 16 ++-- compiler/ptype.pas | 10 +- compiler/rautils.pas | 16 +++- compiler/scanner.pas | 8 +- compiler/symtable.pas | 12 ++- compiler/types.pas | 8 +- 19 files changed, 355 insertions(+), 226 deletions(-) diff --git a/compiler/globals.pas b/compiler/globals.pas index 58518673cf..b5fff7dbd4 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -56,9 +56,9 @@ interface {$endif Splitheap} delphimodeswitches : tmodeswitches= - [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar, + [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar, m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring, - m_out,m_default_para,m_hintdirective]; + m_out,m_default_para,m_hintdirective,m_duplicate_names]; fpcmodeswitches : tmodeswitches= [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward, m_cvar_support,m_initfinal,m_add_pointer]; @@ -66,7 +66,7 @@ interface [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment, m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para]; tpmodeswitches : tmodeswitches= - [m_tp7,m_tp,m_all,m_tp_procvar]; + [m_tp7,m_all,m_tp_procvar,m_duplicate_names]; gpcmodeswitches : tmodeswitches= [m_gpc,m_all]; @@ -1453,7 +1453,11 @@ begin end. { $Log$ - Revision 1.50 2001-12-06 17:57:33 florian + Revision 1.51 2002-01-24 18:25:48 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.50 2001/12/06 17:57:33 florian + parasym to tparaitem added Revision 1.49 2001/10/25 21:22:32 peter diff --git a/compiler/globtype.pas b/compiler/globtype.pas index b4af222f9d..1f301a224d 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -125,7 +125,7 @@ interface { Switches which can be changed by a mode (fpc,tp7,delphi) } tmodeswitch = (m_none,m_all, { needed for keyword } { generic } - m_fpc,m_objfpc,m_delphi,m_tp,m_tp7,m_gpc, + m_fpc,m_objfpc,m_delphi,m_tp7,m_gpc, { more specific } m_class, { delphi class model } m_objpas, { load objpas unit } @@ -143,7 +143,8 @@ interface m_default_ansistring, { ansistring turned on by default } m_out, { support the calling convention OUT } m_default_para, { support default parameters } - m_hintdirective { support hint directives } + m_hintdirective, { support hint directives } + m_duplicate_names { allow locals/paras to have duplicate names of globals } ); tmodeswitches = set of tmodeswitch; @@ -245,7 +246,11 @@ implementation end. { $Log$ - Revision 1.19 2001-10-25 21:22:32 peter + Revision 1.20 2002-01-24 18:25:48 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.19 2001/10/25 21:22:32 peter * calling convention rewrite Revision 1.18 2001/10/24 11:46:06 marco diff --git a/compiler/i386/cga.pas b/compiler/i386/cga.pas index b256a3d146..191a4a9eaa 100644 --- a/compiler/i386/cga.pas +++ b/compiler/i386/cga.pas @@ -2677,50 +2677,55 @@ implementation emitcall('FPC_DO_EXIT'); end; - { handle return value } + { handle return value, this is not done for assembler routines when + they didn't reference the result variable } uses_eax:=false; uses_edx:=false; uses_esi:=false; - if not(po_assembler in aktprocdef.procoptions) then + if not(po_assembler in aktprocdef.procoptions) or + (assigned(aktprocdef.funcretsym) and + (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then + begin if (aktprocdef.proctypeoption<>potype_constructor) then handle_return_value(inlined,uses_eax,uses_edx) else - begin - { successful constructor deletes the zero flag } - { and returns self in eax } - { eax must be set to zero if the allocation failed !!! } - getlabel(okexitlabel); - emitjmp(C_NONE,okexitlabel); - emitlab(faillabel); - if is_class(procinfo^._class) then - begin - emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI); - emitcall('FPC_HELP_FAIL_CLASS'); - end - else if is_object(procinfo^._class) then - begin - emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI); - getexplicitregister32(R_EDI); - emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI); - emitcall('FPC_HELP_FAIL'); - ungetregister32(R_EDI); - end - else - Internalerror(200006161); + begin + { successful constructor deletes the zero flag } + { and returns self in eax } + { eax must be set to zero if the allocation failed !!! } + getlabel(okexitlabel); + emitjmp(C_NONE,okexitlabel); + emitlab(faillabel); + if is_class(procinfo^._class) then + begin + emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI); + emitcall('FPC_HELP_FAIL_CLASS'); + end + else if is_object(procinfo^._class) then + begin + emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI); + getexplicitregister32(R_EDI); + emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI); + emitcall('FPC_HELP_FAIL'); + ungetregister32(R_EDI); + end + else + Internalerror(200006161); - emitlab(okexitlabel); + emitlab(okexitlabel); - { for classes this is done after the call to } - { AfterConstruction } - if is_object(procinfo^._class) then - begin - exprasmList.concat(Tairegalloc.Alloc(R_EAX)); - emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX); - uses_eax:=true; - end; - emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI); - uses_esi:=true; - end; + { for classes this is done after the call to } + { AfterConstruction } + if is_object(procinfo^._class) then + begin + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX); + uses_eax:=true; + end; + emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI); + uses_esi:=true; + end; + end; if aktexit2label.is_used and not aktexit2label.is_set then emitlab(aktexit2label); @@ -2982,7 +2987,11 @@ implementation end. { $Log$ - Revision 1.14 2002-01-19 14:21:17 peter + Revision 1.15 2002-01-24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.14 2002/01/19 14:21:17 peter * fixed init/final for value parameters Revision 1.13 2001/12/30 17:24:45 jonas diff --git a/compiler/i386/ra386.pas b/compiler/i386/ra386.pas index ba41761859..5795bc0d5e 100644 --- a/compiler/i386/ra386.pas +++ b/compiler/i386/ra386.pas @@ -39,7 +39,6 @@ Procedure FWaitWarning; type T386Operand=class(TOperand) Procedure SetCorrectSize(opcode:tasmop);override; - Function SetupResult : boolean;override; end; T386Instruction=class(TInstruction) @@ -185,57 +184,6 @@ begin end; end; -Function T386Operand.SetupResult:boolean; -var - Res : boolean; -Begin - Res:=inherited setupResult; - { replace by ref by register if not place was - reserved on stack } - if res and (procinfo^.return_offset=0) then - begin - opr.typ:=OPR_REGISTER; - if is_fpu(aktprocdef.rettype.def) then - begin - opr.reg:=R_ST0; - case tfloatdef(aktprocdef.rettype.def).typ of - s32real : size:=S_FS; - s64real : size:=S_FL; - s80real : size:=S_FX; - s64comp : size:=S_IQ; - else - begin - Message(asmr_e_cannot_use_RESULT_here); - res:=false; - end; - end; - end - else if ret_in_acc(aktprocdef.rettype.def) then - case aktprocdef.rettype.def.size of - 1 : begin - opr.reg:=R_AL; - size:=S_B; - end; - 2 : begin - opr.reg:=R_AX; - size:=S_W; - end; - 3,4 : begin - opr.reg:=R_EAX; - size:=S_L; - end; - else - begin - Message(asmr_e_cannot_use_RESULT_here); - res:=false; - end; - end; - Message1(asmr_h_RESULT_is_reg,reg2str(opr.reg)); - end; - SetupResult:=res; -end; - - {***************************************************************************** T386Instruction @@ -683,7 +631,11 @@ end; end. { $Log$ - Revision 1.13 2001-11-02 22:58:11 peter + Revision 1.14 2002-01-24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.13 2001/11/02 22:58:11 peter * procsym definition rewrite Revision 1.12 2001/08/26 13:37:01 florian diff --git a/compiler/i386/ra386att.pas b/compiler/i386/ra386att.pas index c6dc4f3405..df55241b4a 100644 --- a/compiler/i386/ra386att.pas +++ b/compiler/i386/ra386att.pas @@ -1892,10 +1892,6 @@ Var Begin Message1(asmr_d_start_reading,'AT&T'); firsttoken:=TRUE; - if assigned(aktprocdef.funcretsym) and - (is_fpu(aktprocdef.rettype.def) or - ret_in_acc(aktprocdef.rettype.def)) then - tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned; { sets up all opcode and register tables in uppercase } if not _asmsorted then Begin @@ -2139,7 +2135,11 @@ finalization end. { $Log$ - Revision 1.15 2001-11-02 22:58:11 peter + Revision 1.16 2002-01-24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.15 2001/11/02 22:58:11 peter * procsym definition rewrite Revision 1.14 2001/08/26 13:37:02 florian diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index eeb6339e21..612a754110 100644 --- a/compiler/i386/ra386int.pas +++ b/compiler/i386/ra386int.pas @@ -1847,10 +1847,6 @@ Begin Message1(asmr_d_start_reading,'intel'); inexpression:=FALSE; firsttoken:=TRUE; - if assigned(aktprocdef.funcretsym) and - (is_fpu(aktprocdef.rettype.def) or - ret_in_acc(aktprocdef.rettype.def)) then - tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned; { sets up all opcode and register tables in uppercase } if not _asmsorted then Begin @@ -1968,7 +1964,11 @@ finalization end. { $Log$ - Revision 1.19 2001-11-02 22:58:11 peter + Revision 1.20 2002-01-24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.19 2001/11/02 22:58:11 peter * procsym definition rewrite Revision 1.18 2001/09/17 21:29:14 peter diff --git a/compiler/ncal.pas b/compiler/ncal.pas index f1397219fa..858a4bf548 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -780,8 +780,11 @@ implementation var i : longint; + found, is_const : boolean; bestord : torddef; + srprocsym : tprocsym; + srsymtable : tsymtable; begin result:=nil; @@ -878,36 +881,73 @@ implementation pd:=pd^.next; end; -{$ifdef CROSSUNIT} { when the definition has overload directive set, we search for - overloaded definitions in the other used units unitsymtable. The found - entries are only added to the procs list and not the procsym } + overloaded definitions in the symtablestack. The found + entries are only added to the procs list and not the procsym, because + the list can change in every situation } if (po_overload in symtableprocentry.defs^.def.procoptions) and (symtableprocentry.owner.symtabletype<>objectsymtable) then begin - - - srpdl:=srsym.defs; - while assigned(srpdl) do - begin - found:=false; - pdl:=aprocsym.defs; - while assigned(pdl) do - begin - if equal_paras(pdl^.def.para,srpdl^.def.para,cp_value_equal_const) then + srsymtable:=symtableprocentry.owner.next; + while assigned(srsymtable) do begin - found:=true; - break; + if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then + begin + srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue)); + { process only visible procsyms } + if assigned(srprocsym) and + (srprocsym.typ=procsym) and + srprocsym.is_visible_for_proc(aktprocdef) then + begin + { if this procedure doesn't have overload we can stop + searching } + if not(po_overload in srprocsym.defs^.def.procoptions) then + break; + { process all overloaded definitions } + pd:=srprocsym.defs; + while assigned(pd) do + begin + { only when the # of parameter are supported by the + procedure } + if (paralength>=pd^.def.minparacount) and + ((po_varargs in pd^.def.procoptions) or { varargs } + (paralength<=pd^.def.maxparacount)) then + begin + found:=false; + hp:=procs; + while assigned(hp) do + begin + if equal_paras(hp^.data.para,pd^.def.para,cp_value_equal_const) then + begin + found:=true; + break; + end; + hp:=hp^.next; + end; + if not found then + begin + new(hp); + hp^.data:=pd^.def; + hp^.next:=procs; + hp^.firstpara:=tparaitem(pd^.def.Para.first); + if not(po_varargs in pd^.def.procoptions) then + begin + { if not all parameters are given, then skip the + default parameters } + for i:=1 to pd^.def.maxparacount-paralength do + hp^.firstpara:=tparaitem(hp^.firstPara.next); + end; + hp^.nextpara:=hp^.firstpara; + procs:=hp; + end; + end; + pd:=pd^.next; + end; + end; + end; + srsymtable:=srsymtable.next; end; - pdl:=pdl^.next; end; - if not found then - aprocsym.addprocdef(srpdl^.def); - srpdl:=srpdl^.next; - end; - - end; -{$endif CROSSUNIT} { no procedures found? then there is something wrong with the parameter size } @@ -1796,7 +1836,11 @@ begin end. { $Log$ - Revision 1.63 2002-01-24 12:33:52 jonas + Revision 1.64 2002-01-24 18:25:48 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.63 2002/01/24 12:33:52 jonas * adapted ranges of native types to int64 (e.g. high cardinal is no longer longint($ffffffff), but just $fffffff in psystem) * small additional fix in 64bit rangecheck code generation for 32 bit diff --git a/compiler/ninl.pas b/compiler/ninl.pas index d81ca41d30..aac5c98476 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -1299,7 +1299,7 @@ implementation begin { give warning for incompatibility with tp and delphi } if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and - ((m_tp in aktmodeswitches) or + ((m_tp7 in aktmodeswitches) or (m_delphi in aktmodeswitches)) then CGMessage(type_w_maybe_wrong_hi_lo); { constant folding } @@ -2341,7 +2341,11 @@ begin end. { $Log$ - Revision 1.68 2002-01-19 11:53:56 peter + Revision 1.69 2002-01-24 18:25:48 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.68 2002/01/19 11:53:56 peter * constant evaluation for assinged added Revision 1.67 2001/12/28 14:09:21 jonas diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 30de5d0ffd..8b7189a704 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -577,7 +577,7 @@ implementation include(aktclass.objectoptions,oo_has_destructor); consume(_SEMICOLON); if not(aktprocdef.Para.empty) then - if not (m_tp in aktmodeswitches) then + if (m_fpc in aktmodeswitches) then Message(parser_e_no_paras_for_destructor); { no return value } aktprocdef.rettype:=voidtype; @@ -905,9 +905,8 @@ implementation Message(parser_e_no_local_objects); storetypecanbeforward:=typecanbeforward; - { for tp mode don't allow forward types } - if (m_tp in aktmodeswitches) and - not (m_delphi in aktmodeswitches) then + { for tp7 don't allow forward types } + if (m_tp7 in aktmodeswitches) then typecanbeforward:=false; if not(readobjecttype) then @@ -1111,7 +1110,11 @@ implementation end. { $Log$ - Revision 1.36 2002-01-06 12:08:15 peter + Revision 1.37 2002-01-24 18:25:48 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.36 2002/01/06 12:08:15 peter * removed uauto from orddef, use new range_to_basetype generating the correct ordinal type for a range diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 2f4ab6bbbd..94b53f9ec1 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -538,7 +538,7 @@ implementation begin { when the other symbol is a unit symbol then hide the unit symbol. Only in tp mode because it's bad programming } - if (m_tp in aktmodeswitches) and + if (m_duplicate_names in aktmodeswitches) and (aktprocsym.typ=unitsym) then begin aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name); @@ -2014,7 +2014,11 @@ const end. { $Log$ - Revision 1.45 2002-01-09 07:38:03 michael + Revision 1.46 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.45 2002/01/09 07:38:03 michael + Patch from peter for library imports Revision 1.44 2002/01/06 21:54:07 peter diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 4c2cc654ef..6467bc9759 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -301,7 +301,7 @@ implementation do_member_read(false,sym,p2,again) else begin - if (m_tp in aktmodeswitches) then + if not(m_fpc in aktmodeswitches) then do_member_read(false,sym,p2,again) else begin @@ -357,7 +357,7 @@ implementation if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then begin - if (m_tp in aktmodeswitches) or + if (m_tp7 in aktmodeswitches) or (m_delphi in aktmodeswitches) then Message(parser_w_no_new_dispose_on_void_pointers) else @@ -1189,7 +1189,7 @@ implementation ((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and (not is_void(p^.procdef.rettype.def)) and (token<>_LKLAMMER) and - (not ((m_tp in aktmodeswitches) and (afterassignment or in_args))) + (not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args))) ) then begin if ((tvarsym(sym)=otsym) and @@ -2483,7 +2483,11 @@ implementation end. { $Log$ - Revision 1.54 2002-01-06 21:47:32 peter + Revision 1.55 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.54 2002/01/06 21:47:32 peter * removed getprocvar, use only getprocvardef Revision 1.53 2001/12/31 16:59:42 peter diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 7e100485bc..325a774260 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -621,7 +621,7 @@ implementation if (m_delphi in aktmodeswitches) then current_scanner.def_macro('FPC_DELPHI') else - if (m_tp in aktmodeswitches) then + if (m_tp7 in aktmodeswitches) then current_scanner.def_macro('FPC_TP') else if (m_objfpc in aktmodeswitches) then @@ -1349,7 +1349,11 @@ implementation end. { $Log$ - Revision 1.50 2001-12-09 03:34:58 carl + Revision 1.51 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.50 2001/12/09 03:34:58 carl + Stack checking for solaris Revision 1.49 2001/11/02 23:16:51 peter diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 997091410e..2989d7e375 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -42,7 +42,7 @@ implementation cutils, { global } globtype,globals,verbose, - systems,cpuinfo, + systems,cpuinfo,cpuasm, { aasm } cpubase,aasm, { symtable } @@ -1044,7 +1044,76 @@ implementation function assembler_block : tnode; + procedure OptimizeFramePointer(p:tasmnode); + var + hp : tai; + parafixup, + i : longint; begin + { replace framepointer with stackpointer } + procinfo^.framepointer:=stack_pointer; + { set the right value for parameters } + dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer); + dec(procinfo^.para_offset,target_info.size_of_pointer); + { replace all references to parameters in the instructions, + the parameters can be identified by the parafixup option + that is set. For normal user coded [ebp+4] this field is not + set } + parafixup:=aktprocdef.parast.address_fixup; + hp:=tai(p.p_asm.first); + while assigned(hp) do + begin + if hp.typ=ait_instruction then + begin + { fixup the references } + for i:=1 to taicpu(hp).ops do + begin + with taicpu(hp).oper[i-1] do + if typ=top_ref then + begin + case ref^.options of + ref_parafixup : + begin + ref^.offsetfixup:=parafixup; + ref^.base:=stack_pointer; + end; + end; + end; + end; + end; + hp:=tai(hp.next); + end; + end; + +{$ifdef CHECKFORPUSH} + function UsesPush(p:tasmnode):boolean; + var + hp : tai; + begin + hp:=tai(p.p_asm.first); + while assigned(hp) do + begin + if (hp.typ=ait_instruction) and + (taicpu(hp).opcode=A_PUSH) then + begin + UsesPush:=true; + exit; + end; + hp:=tai(hp.next); + end; + UsesPush:=false; + end; +{$endif CHECKFORPUSH} + + var + p : tnode; + haslocals,hasparas : boolean; + begin + { retrieve info about locals and paras before a result + is inserted in the symtable } + haslocals:=(aktprocdef.localst.datasize>0); + hasparas:=(aktprocdef.parast.datasize>0); + { temporary space is set, while the BEGIN of the procedure } if symtablestack.symtabletype=localsymtable then procinfo^.firsttemp_offset := -symtablestack.datasize @@ -1053,75 +1122,74 @@ implementation { assembler code does not allocate } { space for the return value } - if not is_void(aktprocdef.rettype.def) then + if not is_void(aktprocdef.rettype.def) then begin aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype); - if ret_in_acc(aktprocdef.rettype.def) then - begin - { in assembler code the result should be directly in %eax - procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size; - procinfo^.firsttemp:=procinfo^.retoffset; } - -{$ifndef newcg} -{$ifdef i386} - usedinproc:=usedinproc or ($80 shr byte(R_EAX)) -{$else} -{$ifdef POWERPC} - usedinproc:=0; -{$else POWERPC} - usedinproc:=usedinproc + [accumulator]; -{$endif POWERPC} -{$endif i386} -{$endif newcg} - end - { - else if not is_fpu(procinfo^.retdef) then - should we allow assembler functions of big elements ? - YES (FK)!! - Message(parser_e_asm_incomp_with_function_return); - } - end; - { set the framepointer to esp for assembler functions } - { but only if the are no local variables } - { added no parameter also (PM) } - { disable for methods, because self pointer is expected } - { at -8(%ebp) (JM) } - { why if se use %esp then self is still at the correct address PM } - if {not(assigned(procinfo^._class)) and} - (po_assembler in aktprocdef.procoptions) and - (aktprocdef.localst.datasize=0) and - (aktprocdef.parast.datasize=0) and - not(ret_in_param(aktprocdef.rettype.def)) then - begin - procinfo^.framepointer:=stack_pointer; - { set the right value for parameters } - dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer); - dec(procinfo^.para_offset,target_info.size_of_pointer); - end; - { only insert now in the symtable, otherwise the } - { "aktprocdef.localst.datasize=0" check above will } - { always fail (JM) } - if not is_void(aktprocdef.rettype.def) then - begin { insert in local symtable } { but with another name, so that recursive calls are possible } symtablestack.insert(aktprocdef.funcretsym); symtablestack.rename(aktprocdef.funcretsym.name,'$result'); + { set the used flag for the return } + if ret_in_acc(aktprocdef.rettype.def) then + begin +{$ifdef i386} + usedinproc:=usedinproc or ($80 shr byte(R_EAX)) +{$else} + {$ifdef POWERPC} + usedinproc:=0; + {$else POWERPC} + usedinproc:=usedinproc + [accumulator]; + {$endif POWERPC} +{$endif i386} + end; end; - { force the asm statement } - if token<>_ASM then - consume(_ASM); - procinfo^.Flags := procinfo^.Flags Or pi_is_assembler; - assembler_block:=_asm_statement; - { becuase the END is already read we need to get the - last_endtoken_filepos here (PFV) } - last_endtoken_filepos:=akttokenpos; - end; + { force the asm statement } + if token<>_ASM then + consume(_ASM); + procinfo^.Flags := procinfo^.Flags Or pi_is_assembler; + p:=_asm_statement; + + + { set the framepointer to esp for assembler functions when the + following conditions are met: + - if the are no local variables + - no reference to the result variable (refcount<=1) + - result is not stored as parameter } + if (po_assembler in aktprocdef.procoptions) and + (not haslocals) and + (not hasparas) and + (aktprocdef.owner.symtabletype<>objectsymtable) and + (not assigned(aktprocdef.funcretsym) or + (tfuncretsym(aktprocdef.funcretsym).refcount<=1)) and + not(ret_in_param(aktprocdef.rettype.def)) +{$ifdef CHECKFORPUSH} + and not(UsesPush(tasmnode(p))) +{$endif CHECKFORPUSH} + then + OptimizeFramePointer(tasmnode(p)); + + { Flag the result as assigned when it is returned in the + accumulator or on the fpu stack } + if assigned(aktprocdef.funcretsym) and + (is_fpu(aktprocdef.rettype.def) or + ret_in_acc(aktprocdef.rettype.def)) then + tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned; + + { because the END is already read we need to get the + last_endtoken_filepos here (PFV) } + last_endtoken_filepos:=akttokenpos; + + assembler_block:=p; + end; end. { $Log$ - Revision 1.44 2001-11-09 10:06:56 jonas + Revision 1.45 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.44 2001/11/09 10:06:56 jonas * allow recursive calls again in assembler procedure Revision 1.43 2001/11/02 22:58:05 peter diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index b6e0488af4..3d1e57f52e 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -291,7 +291,7 @@ implementation begin len:=tstringconstnode(p).len; { For tp7 the maximum lentgh can be 255 } - if (m_tp in aktmodeswitches) and + if (m_tp7 in aktmodeswitches) and (len>255) then len:=255; getmem(ca,len+2); @@ -624,7 +624,7 @@ implementation begin len:=tstringconstnode(p).len; { For tp7 the maximum lentgh can be 255 } - if (m_tp in aktmodeswitches) and + if (m_tp7 in aktmodeswitches) and (len>255) then len:=255; ca:=tstringconstnode(p).value_str; @@ -872,7 +872,7 @@ implementation end { for objects we allow it only if it doesn't contain a vmt } else if (oo_has_vmt in tobjectdef(t.def).objectoptions) and - not(m_tp in aktmodeswitches) then + (m_fpc in aktmodeswitches) then Message(parser_e_type_const_not_possible) else begin @@ -910,7 +910,7 @@ implementation Message(parser_e_invalid_record_const); { check in VMT needs to be added for TP mode } - if (m_tp in aktmodeswitches) and + if not(m_fpc in aktmodeswitches) and (oo_has_vmt in tobjectdef(t.def).objectoptions) and (tobjectdef(t.def).vmt_offset=aktpos) then begin @@ -970,7 +970,11 @@ implementation end. { $Log$ - Revision 1.40 2002-01-06 21:47:32 peter + Revision 1.41 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.40 2002/01/06 21:47:32 peter * removed getprocvar, use only getprocvardef Revision 1.39 2001/12/06 17:57:38 florian diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 5e38d6eb30..1770d96e5f 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -218,8 +218,8 @@ implementation old_object_option:=current_object_option; current_object_option:=[sp_public]; storetypecanbeforward:=typecanbeforward; - { for tp mode don't allow forward types } - if m_tp in aktmodeswitches then + { for tp7 don't allow forward types } + if m_tp7 in aktmodeswitches then typecanbeforward:=false; read_var_decs(true,false,false); consume(_END); @@ -612,7 +612,11 @@ implementation end. { $Log$ - Revision 1.33 2002-01-15 16:13:34 jonas + Revision 1.34 2002-01-24 18:25:49 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.33 2002/01/15 16:13:34 jonas * fixed web bugs 1758 and 1760 Revision 1.32 2002/01/06 12:08:15 peter diff --git a/compiler/rautils.pas b/compiler/rautils.pas index 55405f5104..d74cbed784 100644 --- a/compiler/rautils.pas +++ b/compiler/rautils.pas @@ -728,8 +728,8 @@ Begin { replace by correct offset. } if (not is_void(aktprocdef.rettype.def)) then begin - if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or - (m_delphi in aktmodeswitches)) then + if (m_tp7 in aktmodeswitches) and + ret_in_acc(aktprocdef.rettype.def) then begin Message(asmr_e_cannot_use_RESULT_here); exit; @@ -739,6 +739,9 @@ Begin opr.ref.options:=ref_parafixup; { always assume that the result is valid. } tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned; + { increase reference count, this is also used to check + if the result variable is actually used or not } + inc(tfuncretsym(aktprocdef.funcretsym).refcount); SetupResult:=true; end else @@ -806,7 +809,8 @@ Begin register is still free, and loading it first is also not possible, because this could break code } { Be TP/Delphi compatible in Delphi or TP modes } - if (m_tp in aktmodeswitches) then + if (m_tp7 in aktmodeswitches) or + (m_delphi in aktmodeswitches) then begin opr.typ:=OPR_CONSTANT; opr.val:=tvarsym(sym).address; @@ -1581,7 +1585,11 @@ end; end. { $Log$ - Revision 1.25 2001-11-02 22:58:06 peter + Revision 1.26 2002-01-24 18:25:50 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.25 2001/11/02 22:58:06 peter * procsym definition rewrite Revision 1.24 2001/09/02 21:18:28 peter diff --git a/compiler/scanner.pas b/compiler/scanner.pas index e6989861dd..f69725928e 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -1981,7 +1981,7 @@ implementation '%' : begin - if (m_tp in aktmodeswitches) then + if not(m_fpc in aktmodeswitches) then Illegal_Char(c) else begin @@ -2656,7 +2656,11 @@ exit_label: end. { $Log$ - Revision 1.27 2001-10-22 20:25:49 peter + Revision 1.28 2002-01-24 18:25:50 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.27 2001/10/22 20:25:49 peter * fixed previous commit Revision 1.26 2001/10/22 19:55:44 peter diff --git a/compiler/symtable.pas b/compiler/symtable.pas index a3d5cdd1e4..0bcf9cf17a 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -554,7 +554,7 @@ implementation same name as the function, the function is then hidden for the user. (Under delphi it can still be accessed using result), but don't allow hiding of RESULT } - if (m_tp in aktmodeswitches) and + if (m_duplicate_names in aktmodeswitches) and (hsym.typ=funcretsym) and not((m_result in aktmodeswitches) and (hsym.name='RESULT')) then @@ -1195,7 +1195,7 @@ implementation begin { a parameter and the function can have the same name in TP and Delphi, but RESULT not } - if (m_tp in aktmodeswitches) and + if (m_duplicate_names in aktmodeswitches) and (sym.typ=funcretsym) and not((m_result in aktmodeswitches) and (sym.name='RESULT')) then @@ -1577,7 +1577,7 @@ implementation { Delphi you can have a symbol with the same name as the unit, the unit can then not be accessed anymore using ., so we can hide the symbol } - if (m_tp in aktmodeswitches) and + if (m_duplicate_names in aktmodeswitches) and (hsym.typ=symconst.unitsym) then hsym.owner.rename(hsym.name,'hidden'+hsym.name) else @@ -2023,7 +2023,11 @@ implementation end. { $Log$ - Revision 1.51 2001-12-31 16:59:43 peter + Revision 1.52 2002-01-24 18:25:50 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.51 2001/12/31 16:59:43 peter * protected/private symbols parsing fixed Revision 1.50 2001/11/18 18:43:17 peter diff --git a/compiler/types.pas b/compiler/types.pas index a7128379e2..d7e1a92fdb 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -1239,7 +1239,7 @@ implementation end else begin - b:=not(m_tp in aktmodeswitches) and + b:=not(m_tp7 in aktmodeswitches) and not(m_delphi in aktmodeswitches) and (tarraydef(def1).lowrange=tarraydef(def2).lowrange) and (tarraydef(def1).highrange=tarraydef(def2).highrange) and @@ -1953,7 +1953,11 @@ implementation end. { $Log$ - Revision 1.63 2002-01-24 12:33:53 jonas + Revision 1.64 2002-01-24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + + Revision 1.63 2002/01/24 12:33:53 jonas * adapted ranges of native types to int64 (e.g. high cardinal is no longer longint($ffffffff), but just $fffffff in psystem) * small additional fix in 64bit rangecheck code generation for 32 bit