* Internal implementations of get_frame, get_caller_frame and get_caller_addr.

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

View File

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

View File

@ -47,6 +47,9 @@ interface
procedure second_cos_real; virtual;
procedure second_sin_real; 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;
end;
@ -79,77 +82,49 @@ implementation
case inlinenumber of
in_assert_x_y:
begin
second_Assert;
end;
second_Assert;
in_sizeof_x,
in_typeof_x :
begin
second_SizeofTypeOf;
end;
second_SizeofTypeOf;
in_length_x :
begin
second_Length;
end;
second_Length;
in_pred_x,
in_succ_x:
begin
second_PredSucc;
end;
second_PredSucc;
in_dec_x,
in_inc_x :
begin
second_IncDec;
end;
second_IncDec;
in_typeinfo_x:
begin
second_TypeInfo;
end;
second_TypeInfo;
in_include_x_y,
in_exclude_x_y:
begin
second_IncludeExclude;
end;
second_IncludeExclude;
in_pi_real:
begin
second_pi;
end;
second_pi;
in_sin_real:
begin
second_sin_real;
end;
second_sin_real;
in_arctan_real:
begin
second_arctan_real;
end;
second_arctan_real;
in_abs_real:
begin
second_abs_real;
end;
second_abs_real;
in_sqr_real:
begin
second_sqr_real;
end;
second_sqr_real;
in_sqrt_real:
begin
second_sqrt_real;
end;
second_sqrt_real;
in_ln_real:
begin
second_ln_real;
end;
second_ln_real;
in_cos_real:
begin
second_cos_real;
end;
second_cos_real;
in_prefetch_var:
begin
second_prefetch;
end;
second_prefetch;
in_assigned_x:
begin
second_assigned;
end;
second_assigned;
in_get_frame:
second_get_frame;
in_get_caller_frame:
second_get_caller_frame;
in_get_caller_addr:
second_get_caller_addr;
{$ifdef SUPPORT_UNALIGNED}
in_unaligned_x:
begin
@ -700,6 +675,69 @@ implementation
location_reset(location,LOC_JUMP,OS_NO);
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
cinlinenode:=tcginlinenode;

View File

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

View File

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

View File

@ -827,6 +827,24 @@ 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
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
internalerror(15);