From 5acc8b44a8e6cb9beb7d9cda7ed47af8c31a14e3 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Wed, 1 Nov 2006 12:48:53 +0000 Subject: [PATCH] * activated internal get_frame for x86 * turn off stackframe optimizations on x86 if get_frame is called in the current routine, or if the address of a nested function is taken in the current routine + test for the above * this fixes the IDE when compiled with stackframe optimizations on x86 git-svn-id: trunk@5146 - --- .gitattributes | 1 + compiler/globtype.pas | 4 +++- compiler/ncginl.pas | 2 ++ compiler/ncnv.pas | 5 +++++ compiler/ninl.pas | 1 + compiler/options.pas | 2 +- compiler/pexpr.pas | 2 +- compiler/psub.pas | 3 ++- compiler/psystem.pas | 3 +++ rtl/i386/i386.inc | 2 +- rtl/inc/systemh.inc | 9 +++++++-- rtl/x86_64/x86_64.inc | 3 ++- tests/tbs/tb0508.pp | 39 +++++++++++++++++++++++++++++++++++++++ 13 files changed, 68 insertions(+), 8 deletions(-) create mode 100644 tests/tbs/tb0508.pp diff --git a/.gitattributes b/.gitattributes index 874f71f01a..6fb87d17a4 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6044,6 +6044,7 @@ tests/tbs/tb0504.pp svneol=native#text/plain tests/tbs/tb0505.pp svneol=native#text/plain tests/tbs/tb0506.pp svneol=native#text/plain tests/tbs/tb0507.pp svneol=native#text/plain +tests/tbs/tb0508.pp svneol=native#text/plain tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain tests/tbs/ub0119.pp svneol=native#text/plain diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 76f9bf2475..4f26057031 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -300,7 +300,9 @@ interface { set if the procedure has at least one got } pi_has_goto, { calls itself recursive } - pi_is_recursive + pi_is_recursive, + { stack frame optimization not possible (only on x86 probably) } + pi_needs_stackframe ); tprocinfoflags=set of tprocinfoflag; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index a0257e7159..86c7b34657 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -682,12 +682,14 @@ implementation procedure Tcginlinenode.second_get_frame; begin +{$ifdef x86} if current_procinfo.framepointer=NR_STACK_POINTER_REG then begin location_reset(location,LOC_CONSTANT,OS_ADDR); location.value:=0; end else +{$endif x86} begin location_reset(location,LOC_CREGISTER,OS_ADDR); location.register:=current_procinfo.framepointer; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index d84dceae0f..a0dbd74d3e 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -2235,6 +2235,11 @@ implementation function ttypeconvnode.first_proc_to_procvar : tnode; begin first_proc_to_procvar:=nil; + { if we take the address of a nested function, it'll } + { probably be used in a foreach() construct and then } + { the parent needs a stackframe } + if (tprocdef(left.resultdef).parast.symtablelevel>=normal_function_level) then + include(current_procinfo.flags,pi_needs_stackframe); if tabstractprocdef(resultdef).is_addressonly then begin registersint:=left.registersint; diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 3cddb53dee..ad8be297f8 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -2533,6 +2533,7 @@ implementation end; in_get_frame: begin + include(current_procinfo.flags,pi_needs_stackframe); expectloc:=LOC_CREGISTER; end; in_get_caller_frame: diff --git a/compiler/options.pas b/compiler/options.pas index 058b5bd332..5941c09b02 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -1900,7 +1900,7 @@ begin def_system_macro('FPC_HASFIXED64BITVARIANT'); def_system_macro('FPC_HASINTERNALOLEVARIANT2VARIANTCAST'); {$ifdef x86} -{ def_system_macro('INTERNAL_BACKTRACE');} + def_system_macro('INTERNAL_BACKTRACE'); {$endif} def_system_macro('STR_CONCAT_PROCS'); if pocall_default = pocall_register then diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index db841b8872..89cfee4515 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -858,11 +858,11 @@ implementation statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil))); consume(_RKLAMMER); end; -(* in_get_frame: begin statement_syssym:=geninlinenode(l,false,nil); end; +(* in_get_caller_frame: begin if try_to_consume(_LKLAMMER) then diff --git a/compiler/psub.pas b/compiler/psub.pas index 192751aa32..cfc2de3214 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -759,7 +759,8 @@ implementation if (cs_opt_stackframe in current_settings.optimizerswitches) and not(po_assembler in procdef.procoptions) and ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler, - pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter])=[]) then + pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter, + pi_needs_stackframe])=[]) then begin { we need the parameter info here to determine if the procedure gets parameters on the stack diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 31a4d35fc8..2a176306fe 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -93,6 +93,9 @@ implementation systemunit.insert(tsyssym.create('Length',in_length_x)); systemunit.insert(tsyssym.create('New',in_new_x)); systemunit.insert(tsyssym.create('Dispose',in_dispose_x)); +{$ifdef x86} + systemunit.insert(tsyssym.create('Get_Frame',in_get_frame)); +{$endif x86} {$ifdef SUPPORT_UNALIGNED} systemunit.insert(tsyssym.create('Unaligned',in_unaligned_x)); {$endif SUPPORT_UNALIGNED} diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index 5afbe44022..761b0581d0 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -958,6 +958,7 @@ function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$ asm movl %ebp,%eax end ['EAX']; +{$ENDIF not INTERNAL_BACKTRACE} {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} @@ -984,7 +985,6 @@ asm movl (%eax),%eax .Lgnf_null: end ['EAX']; -{$ENDIF} {**************************************************************************** Math diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index da049c2d5e..521957ee17 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -655,14 +655,19 @@ Procedure getdir(drivenr:byte;var dir:ansistring); { os independent calls to allow backtraces } {$IFDEF INTERNAL_BACKTRACE} -function get_frame:pointer;[INTERNPROC:fpc_in_get_frame]; +// inserted in compiler/psystem.pas +//function get_frame:pointer;[INTERNPROC:fpc_in_get_frame]; +(* +// still defined externally function get_caller_addr(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_addr]; function get_caller_frame(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_frame]; +*) {$ELSE} function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif} +{$ENDIF} + function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif} function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif} -{$ENDIF} Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif} Function Sptr:Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_ptr]; diff --git a/rtl/x86_64/x86_64.inc b/rtl/x86_64/x86_64.inc index 09e6a5aeea..8d0d618dc3 100644 --- a/rtl/x86_64/x86_64.inc +++ b/rtl/x86_64/x86_64.inc @@ -41,6 +41,7 @@ function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} asm movq %rbp,%rax end ['RAX']; +{$ENDIF not INTERNAL_BACKTRACE} {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} @@ -75,7 +76,7 @@ asm {$endif win64} .Lg_a_null: end ['RAX']; -{$ENDIF} + (* {$define FPC_SYSTEM_HAS_MOVE} procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; diff --git a/tests/tbs/tb0508.pp b/tests/tbs/tb0508.pp new file mode 100644 index 0000000000..c9eb8aa6e6 --- /dev/null +++ b/tests/tbs/tb0508.pp @@ -0,0 +1,39 @@ +type + PointerLocal = procedure(_EBP: Pointer); + +procedure proccall(p: pointer); +begin + PointerLocal(p)(get_caller_frame(get_frame)); +end; + +procedure t1; +var + l : longint; + + procedure t2; + + procedure t3; + + procedure t4; + begin + l := 5; + end; + + begin { t3 } + proccall(@t4); + end; + + begin { t2 } + t3; + end; + + begin { t1 } + l := 0; + t2; + if (l <> 5) then + halt(1); + end; + +begin + t1; +end.