paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 13:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Internal implementations of get_frame, get_caller_frame and get_caller_addr.

Browse Source 
Not yet activated.

git-svn-id: trunk@3517 -
This commit is contained in:
daniel 2006-05-14 08:39:19 +00:00
parent 281d6907d2
commit 4d37c919cc
5 changed files with 132 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/compinnr.inc
View File

@ -63,6 +63,9 @@ const
in_cycle = 52; {macpas} in_cycle = 52; {macpas}
in_slice_x = 53; in_slice_x = 53;
in_unaligned_x = 54; in_unaligned_x = 54;
in_get_frame = 56;
in_get_caller_addr = 57;
in_get_caller_frame = 58;
{ Internal constant functions } { Internal constant functions }
in_const_sqr = 100; in_const_sqr = 100;

140
compiler/ncginl.pas
View File

@ -47,6 +47,9 @@ interface
procedure second_cos_real; virtual; procedure second_cos_real; virtual;
procedure second_sin_real; virtual; procedure second_sin_real; virtual;
procedure second_assigned; virtual; procedure second_assigned; virtual;
procedure second_get_frame;virtual;
procedure second_get_caller_frame;virtual;
procedure second_get_caller_addr;virtual;
procedure second_prefetch; virtual; procedure second_prefetch; virtual;
end; end;
@ -79,77 +82,49 @@ implementation
case inlinenumber of case inlinenumber of
in_assert_x_y: in_assert_x_y:
begin second_Assert;
second_Assert;
end;
in_sizeof_x, in_sizeof_x,
in_typeof_x : in_typeof_x :
begin second_SizeofTypeOf;
second_SizeofTypeOf;
end;
in_length_x : in_length_x :
begin second_Length;
second_Length;
end;
in_pred_x, in_pred_x,
in_succ_x: in_succ_x:
begin second_PredSucc;
second_PredSucc;
end;
in_dec_x, in_dec_x,
in_inc_x : in_inc_x :
begin second_IncDec;
second_IncDec;
end;
in_typeinfo_x: in_typeinfo_x:
begin second_TypeInfo;
second_TypeInfo;
end;
in_include_x_y, in_include_x_y,
in_exclude_x_y: in_exclude_x_y:
begin second_IncludeExclude;
second_IncludeExclude;
end;
in_pi_real: in_pi_real:
begin second_pi;
second_pi;
end;
in_sin_real: in_sin_real:
begin second_sin_real;
second_sin_real;
end;
in_arctan_real: in_arctan_real:
begin second_arctan_real;
second_arctan_real;
end;
in_abs_real: in_abs_real:
begin second_abs_real;
second_abs_real;
end;
in_sqr_real: in_sqr_real:
begin second_sqr_real;
second_sqr_real;
end;
in_sqrt_real: in_sqrt_real:
begin second_sqrt_real;
second_sqrt_real;
end;
in_ln_real: in_ln_real:
begin second_ln_real;
second_ln_real;
end;
in_cos_real: in_cos_real:
begin second_cos_real;
second_cos_real;
end;
in_prefetch_var: in_prefetch_var:
begin second_prefetch;
second_prefetch;
end;
in_assigned_x: in_assigned_x:
begin second_assigned;
second_assigned; in_get_frame:
end; second_get_frame;
in_get_caller_frame:
second_get_caller_frame;
in_get_caller_addr:
second_get_caller_addr;
{$ifdef SUPPORT_UNALIGNED} {$ifdef SUPPORT_UNALIGNED}
in_unaligned_x: in_unaligned_x:
begin begin
@ -700,6 +675,69 @@ implementation
location_reset(location,LOC_JUMP,OS_NO); location_reset(location,LOC_JUMP,OS_NO);
end; end;
procedure Tcginlinenode.second_get_frame;
var frame_ref:Treference;
begin
if current_procinfo.framepointer=NR_STACK_POINTER_REG then
begin
location_reset(location,LOC_CONSTANT,OS_ADDR);
location.value:=0;
end
else
begin
location_reset(location,LOC_CREGISTER,OS_ADDR);
location.register:=current_procinfo.framepointer;
end;
end;
procedure Tcginlinenode.second_get_caller_frame;
var frame_ref:Treference;
begin
if current_procinfo.framepointer=NR_STACK_POINTER_REG then
begin
location_reset(location,LOC_CREGISTER,OS_ADDR);
location.register:=NR_FRAME_POINTER_REG;
{ location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=cg.getaddressregister(current_asmdata.currasmlist);
cg.a_load_reg_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,NR_FRAME_POINTER_REG,location.register);}
end
else
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=cg.getaddressregister(current_asmdata.currasmlist);
reference_reset_base(frame_ref,current_procinfo.framepointer,0);
cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
end;
end;
procedure Tcginlinenode.second_get_caller_addr;
var frame_ref:Treference;
begin
if current_procinfo.framepointer=NR_STACK_POINTER_REG then
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=cg.getaddressregister(current_asmdata.currasmlist);
reference_reset_base(frame_ref,NR_STACK_POINTER_REG,0);
cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
end
else
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=cg.getaddressregister(current_asmdata.currasmlist);
{$ifdef cpu64bit}
reference_reset_base(frame_ref,current_procinfo.framepointer,8);
{$else}
reference_reset_base(frame_ref,current_procinfo.framepointer,4);
{$endif}
cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
end;
end;
begin begin
cinlinenode:=tcginlinenode; cinlinenode:=tcginlinenode;

23
compiler/ninl.pas
View File

@ -2056,7 +2056,12 @@ implementation
else else
include(current_procinfo.flags,pi_do_call); include(current_procinfo.flags,pi_do_call);
end; end;
in_get_frame,
in_get_caller_frame,
in_get_caller_addr:
begin
resulttype:=voidpointertype;
end;
else else
internalerror(8); internalerror(8);
end; end;
@ -2410,6 +2415,20 @@ implementation
{ should be handled by det_resulttype } { should be handled by det_resulttype }
internalerror(200108234); internalerror(200108234);
end; end;
in_get_frame:
begin
expectloc:=LOC_CREGISTER;
end;
in_get_caller_frame:
begin
expectloc:=LOC_REGISTER;
registersint:=1;
end;
in_get_caller_addr:
begin
expectloc:=LOC_REGISTER;
registersint:=1;
end;
in_prefetch_var: in_prefetch_var:
begin begin
@ -2422,7 +2441,7 @@ implementation
end; end;
{$endif SUPPORT_UNALIGNED} {$endif SUPPORT_UNALIGNED}
else else
internalerror(8); internalerror(89);
end; end;
dec(parsing_para_level); dec(parsing_para_level);
end; end;

1
compiler/options.pas
View File

@ -1873,6 +1873,7 @@ begin
def_system_macro('PARAOUTFILE'); def_system_macro('PARAOUTFILE');
def_system_macro('RESSTRSECTIONS'); def_system_macro('RESSTRSECTIONS');
def_system_macro('FPC_HASFIXED64BITVARIANT'); def_system_macro('FPC_HASFIXED64BITVARIANT');
{ def_system_macro('INTERNAL_BACKTRACE');}
if pocall_default = pocall_register then if pocall_default = pocall_register then
def_system_macro('REGCALL'); def_system_macro('REGCALL');

18
compiler/pexpr.pas
View File

@ -827,6 +827,24 @@ implementation
statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil))); statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
consume(_RKLAMMER); consume(_RKLAMMER);
end; end;
in_get_frame:
begin
statement_syssym:=geninlinenode(l,false,nil);
end;
in_get_caller_frame:
begin
if try_to_consume(_LKLAMMER) then
begin
{You used to call get_caller_frame as get_caller_frame(get_frame),
however, as a stack frame may not exist, it does more harm than
good, so ignore it.}
in_args:=true;
p1:=comp_expr(true);
p1.destroy;
consume(_RKLAMMER);
end;
statement_syssym:=geninlinenode(l,false,nil);
end;
else else
internalerror(15); internalerror(15);