mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-14 10:29:50 +02:00
+ generic FPC_HELP_FAIL
+ generic FPC_HELP_DESTRUCTOR instated (original from Pierre) + generic FPC_DISPOSE_CLASS + TEST_GENERIC define
This commit is contained in:
carl
parent
4669fcc7e2
commit
33b79c188a
@ -328,7 +328,7 @@ unit cgobj;
|
||||
procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
|
||||
procedure g_call_constructor_helper(list : taasmoutput);virtual;
|
||||
procedure g_call_destructor_helper(list : taasmoutput);virtual;
|
||||
procedure g_call_fail_helper(list : taasmoutput);virtual;abstract;
|
||||
procedure g_call_fail_helper(list : taasmoutput);virtual;
|
||||
procedure g_save_standard_registers(list : taasmoutput);virtual;abstract;
|
||||
procedure g_restore_standard_registers(list : taasmoutput);virtual;abstract;
|
||||
procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
|
||||
@ -1135,7 +1135,7 @@ unit cgobj;
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
|
||||
hregister:=get_scratch_reg_address(list);
|
||||
a_loadaddr_ref_reg(list, href, hregister);
|
||||
a_param_reg(list, OS_ADDR,hregister,1);
|
||||
a_param_reg(list, OS_ADDR,hregister,2);
|
||||
free_scratch_reg(list, hregister);
|
||||
{ parameter 1 : address of self pointer }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
|
||||
@ -1153,8 +1153,94 @@ unit cgobj;
|
||||
|
||||
|
||||
procedure tcg.g_call_destructor_helper(list : taasmoutput);
|
||||
begin
|
||||
end;
|
||||
var
|
||||
nofinal : tasmlabel;
|
||||
href : treference;
|
||||
hregister : tregister;
|
||||
begin
|
||||
if is_class(procinfo^._class) then
|
||||
begin
|
||||
{ 2nd parameter : flag }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset+POINTER_SIZE);
|
||||
a_param_ref(list, OS_ADDR,href,2);
|
||||
{ 1st parameter to destructor : self }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
|
||||
a_param_ref(list, OS_ADDR,href,1);
|
||||
a_call_name(list,'FPC_DISPOSE_CLASS')
|
||||
end
|
||||
else if is_object(procinfo^._class) then
|
||||
begin
|
||||
{ must the object be finalized ? }
|
||||
if procinfo^._class.needs_inittable then
|
||||
begin
|
||||
getlabel(nofinal);
|
||||
reference_reset_base(href,procinfo^.framepointer,target_info.first_parm_offset);
|
||||
a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
|
||||
reference_reset_base(href,SELF_POINTER_REG,0);
|
||||
g_finalize(list,procinfo^._class,href,false);
|
||||
a_label(list,nofinal);
|
||||
end;
|
||||
{ actually call destructor }
|
||||
{ parameter 3 :vmt_offset }
|
||||
a_param_const(list, OS_32, procinfo^._class.vmt_offset, 3);
|
||||
{ parameter 2 : pointer to vmt }
|
||||
{ this is the first parameter which was pushed to the destructor }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
|
||||
a_param_ref(list, OS_ADDR, href ,2);
|
||||
{ parameter 1 : address of self pointer }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
|
||||
hregister:=get_scratch_reg_address(list);
|
||||
a_loadaddr_ref_reg(list, href, hregister);
|
||||
a_param_reg(list, OS_ADDR,hregister,1);
|
||||
free_scratch_reg(list, hregister);
|
||||
a_call_name(list,'FPC_HELP_DESTRUCTOR');
|
||||
end
|
||||
else
|
||||
internalerror(200006162);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg.g_call_fail_helper(list : taasmoutput);
|
||||
var
|
||||
href : treference;
|
||||
hregister : tregister;
|
||||
begin
|
||||
if is_class(procinfo^._class) then
|
||||
begin
|
||||
{$warning todo}
|
||||
{ Should simply casll FPC_DISPOSE_CLASS and then set the
|
||||
SELF_POINTER_REGISTER to NIL
|
||||
}
|
||||
internalerror(20020523);
|
||||
{ reference_reset_base(href,procinfo^.framepointer,8);
|
||||
a_load_ref_reg(list,OS_ADDR,href,R_ESI);
|
||||
a_call_name(list,'FPC_HELP_FAIL_CLASS');}
|
||||
end
|
||||
else if is_object(procinfo^._class) then
|
||||
begin
|
||||
{ parameter 3 :vmt_offset }
|
||||
a_param_const(list, OS_32, procinfo^._class.vmt_offset, 3);
|
||||
{ parameter 2 : address of pointer to vmt }
|
||||
{ this is the first(?) parameter which was pushed to the constructor }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
|
||||
hregister:=get_scratch_reg_address(list);
|
||||
a_loadaddr_ref_reg(list, href, hregister);
|
||||
a_param_reg(list, OS_ADDR,hregister,2);
|
||||
free_scratch_reg(list, hregister);
|
||||
{ parameter 1 : address of self pointer }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
|
||||
hregister:=get_scratch_reg_address(list);
|
||||
a_loadaddr_ref_reg(list, href, hregister);
|
||||
a_param_reg(list, OS_ADDR,hregister,1);
|
||||
free_scratch_reg(list, hregister);
|
||||
a_call_name(list,'FPC_HELP_FAIL');
|
||||
{ SET SELF TO NIL }
|
||||
a_load_const_reg(list,OS_ADDR,0,SELF_POINTER_REG);
|
||||
end
|
||||
else
|
||||
internalerror(200006163);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
|
||||
begin
|
||||
@ -1179,7 +1265,13 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2002-05-20 13:30:40 carl
|
||||
Revision 1.27 2002-05-22 19:02:16 carl
|
||||
+ generic FPC_HELP_FAIL
|
||||
+ generic FPC_HELP_DESTRUCTOR instated (original from Pierre)
|
||||
+ generic FPC_DISPOSE_CLASS
|
||||
+ TEST_GENERIC define
|
||||
|
||||
Revision 1.26 2002/05/20 13:30:40 carl
|
||||
* bugfix of hdisponen (base must be set, not index)
|
||||
* more portability fixes
|
||||
|
||||
|
||||
@ -115,9 +115,11 @@ unit cgcpu;
|
||||
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
|
||||
procedure g_restore_frame_pointer(list : taasmoutput);override;
|
||||
procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
|
||||
{$ifndef TEST_GENERIC}
|
||||
procedure g_call_constructor_helper(list : taasmoutput);override;
|
||||
procedure g_call_destructor_helper(list : taasmoutput);override;
|
||||
procedure g_call_fail_helper(list : taasmoutput);override;
|
||||
{$endif}
|
||||
procedure g_save_standard_registers(list : taasmoutput);override;
|
||||
procedure g_restore_standard_registers(list : taasmoutput);override;
|
||||
procedure g_save_all_registers(list : taasmoutput);override;
|
||||
@ -1623,6 +1625,7 @@ unit cgcpu;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifndef TEST_GENERIC}
|
||||
procedure tcg386.g_call_constructor_helper(list : taasmoutput);
|
||||
begin
|
||||
if is_class(procinfo^._class) then
|
||||
@ -1672,7 +1675,6 @@ unit cgcpu;
|
||||
internalerror(200006162);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg386.g_call_fail_helper(list : taasmoutput);
|
||||
var
|
||||
href : treference;
|
||||
@ -1695,6 +1697,7 @@ unit cgcpu;
|
||||
else
|
||||
internalerror(200006163);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
procedure tcg386.g_save_standard_registers(list : taasmoutput);
|
||||
@ -1778,7 +1781,13 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2002-05-20 13:30:40 carl
|
||||
Revision 1.22 2002-05-22 19:02:16 carl
|
||||
+ generic FPC_HELP_FAIL
|
||||
+ generic FPC_HELP_DESTRUCTOR instated (original from Pierre)
|
||||
+ generic FPC_DISPOSE_CLASS
|
||||
+ TEST_GENERIC define
|
||||
|
||||
Revision 1.21 2002/05/20 13:30:40 carl
|
||||
* bugfix of hdisponen (base must be set, not index)
|
||||
* more portability fixes
|
||||
|
||||
|
||||
@ -42,6 +42,8 @@ program pp;
|
||||
NOAG386NSM no NASM output
|
||||
NOAG386BIN leaves out the binary writer, default for TP
|
||||
NORA386DIR No direct i386 assembler reader
|
||||
TEST_GENERIC Test Generic version of code generator
|
||||
(uses generic RTL calls)
|
||||
-----------------------------------------------------------------
|
||||
|
||||
Required switches for a i386 compiler be compiled by Free Pascal Compiler:
|
||||
@ -168,7 +170,13 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2002-05-18 13:34:13 peter
|
||||
Revision 1.14 2002-05-22 19:02:16 carl
|
||||
+ generic FPC_HELP_FAIL
|
||||
+ generic FPC_HELP_DESTRUCTOR instated (original from Pierre)
|
||||
+ generic FPC_DISPOSE_CLASS
|
||||
+ TEST_GENERIC define
|
||||
|
||||
Revision 1.13 2002/05/18 13:34:13 peter
|
||||
* readded missing revisions
|
||||
|
||||
Revision 1.12 2002/05/16 19:46:43 carl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user