mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 13:45:58 +02:00
* an exception in a construcor calls now the destructor (this applies only
to classes)
This commit is contained in:
florian
parent
b24d42f9be
commit
a0cc4f970b
@ -551,7 +551,7 @@ implementation
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
{ if an inherited con- or destructor should be }
|
||||
{ called in a con- or destructor then a warning }
|
||||
{ will be made }
|
||||
{ will be made }
|
||||
{ con- and destructors need a pointer to the vmt }
|
||||
if is_con_or_destructor and
|
||||
not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) and
|
||||
@ -561,12 +561,18 @@ implementation
|
||||
[potype_constructor,potype_destructor]) then
|
||||
CGMessage(cg_w_member_cd_call_from_method);
|
||||
end;
|
||||
{ class destructors get there flag below }
|
||||
{ class destructors get there flag above }
|
||||
{ constructor flags ? }
|
||||
if is_con_or_destructor and
|
||||
not(pobjectdef(p^.methodpointer^.resulttype)^.is_class and
|
||||
assigned(aktprocsym) and
|
||||
(aktprocsym^.definition^.proctypeoption=potype_destructor)) then
|
||||
push_int(0);
|
||||
begin
|
||||
{ a constructor needs also a flag }
|
||||
if pobjectdef(p^.methodpointer^.resulttype)^.is_class then
|
||||
push_int(0);
|
||||
push_int(0);
|
||||
end;
|
||||
end;
|
||||
hnewn:
|
||||
begin
|
||||
@ -643,7 +649,7 @@ implementation
|
||||
emit_ref_reg(A_MOV,S_L,r,R_ESI);
|
||||
end;
|
||||
|
||||
{ direct call to destructor: don't remove data! }
|
||||
{ direct call to destructor: remove data }
|
||||
if (p^.procdefinition^.proctypeoption=potype_destructor) and
|
||||
(p^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||
(pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
|
||||
@ -653,9 +659,19 @@ implementation
|
||||
if (p^.procdefinition^.proctypeoption=potype_constructor) and
|
||||
(p^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||
(pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
|
||||
emit_const(A_PUSH,S_L,0)
|
||||
begin
|
||||
emit_const(A_PUSH,S_L,0);
|
||||
emit_const(A_PUSH,S_L,0);
|
||||
end
|
||||
else
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
begin
|
||||
{ constructor call via classreference => allocate memory }
|
||||
if (p^.procdefinition^.proctypeoption=potype_constructor) and
|
||||
(p^.methodpointer^.resulttype^.deftype=classrefdef) and
|
||||
(pobjectdef(pclassrefdef(p^.methodpointer^.resulttype)^.pointertype.def)^.is_class) then
|
||||
emit_const(A_PUSH,S_L,1);
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
end;
|
||||
end;
|
||||
|
||||
if is_con_or_destructor then
|
||||
@ -671,7 +687,7 @@ implementation
|
||||
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname));
|
||||
end
|
||||
{ destructors haven't to dispose the instance, if this is }
|
||||
{ a direct call }
|
||||
{ a direct call }
|
||||
else
|
||||
push_int(0);
|
||||
end;
|
||||
@ -709,7 +725,10 @@ implementation
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
end
|
||||
else if (p^.procdefinition^.proctypeoption=potype_constructor) then
|
||||
emit_const(A_PUSH,S_L,0)
|
||||
begin
|
||||
emit_const(A_PUSH,S_L,0);
|
||||
emit_const(A_PUSH,S_L,0);
|
||||
end
|
||||
else
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
end
|
||||
@ -1332,7 +1351,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.123 2000-01-26 15:03:59 peter
|
||||
Revision 1.124 2000-02-04 20:00:21 florian
|
||||
* an exception in a construcor calls now the destructor (this applies only
|
||||
to classes)
|
||||
|
||||
Revision 1.123 2000/01/26 15:03:59 peter
|
||||
* fixed pop_size included twice with clearstack
|
||||
|
||||
Revision 1.122 2000/01/26 12:02:29 peter
|
||||
@ -1465,4 +1488,4 @@ end.
|
||||
Revision 1.90.2.3 1999/06/22 13:30:08 peter
|
||||
* fixed return with packenum
|
||||
|
||||
}
|
||||
}
|
||||
@ -3089,9 +3089,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
{ a constructor needs a help procedure }
|
||||
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
|
||||
begin
|
||||
{!!!! not yet procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;}
|
||||
if procinfo^._class^.is_class then
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
|
||||
exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
|
||||
emitinsertcall('FPC_NEW_CLASS');
|
||||
end
|
||||
@ -3404,12 +3404,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
mangled_length : longint;
|
||||
p : pchar;
|
||||
{$endif GDB}
|
||||
nofinal,okexitlabel,noreraiselabel : pasmlabel;
|
||||
nofinal,okexitlabel,noreraiselabel,nodestroycall : pasmlabel;
|
||||
hr : treference;
|
||||
oldexprasmlist : paasmoutput;
|
||||
ai : paicpu;
|
||||
pd : pprocdef;
|
||||
r : preference;
|
||||
|
||||
begin
|
||||
oldexprasmlist:=exprasmlist;
|
||||
@ -3477,30 +3476,39 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
emitjmp(C_E,noreraiselabel);
|
||||
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
|
||||
begin
|
||||
{
|
||||
if assigned(procinfo^._class) then
|
||||
begin
|
||||
pd:=procinfo^._class^.searchdestructor;
|
||||
if procinfo^._class^.is_class then
|
||||
begin
|
||||
emit_const(A_PUSH,S_L,1);
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
end
|
||||
else
|
||||
begin
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
emit_sym(A_PUSH,S_L,newasmsymbol(procinfo._class^.vmt_mangledname);
|
||||
end;
|
||||
if (po_virtualmethod in pd^.procoptions) then
|
||||
begin
|
||||
emit_ref_reg(A_MOV,S_L,ref,R_EDI)
|
||||
emit_ref(A_CALL,S_NO,ref);
|
||||
end
|
||||
else
|
||||
if assigned(pd) then
|
||||
begin
|
||||
getlabel(nodestroycall);
|
||||
emit_const_ref(A_CMP,S_L,0,new_reference(procinfo^.framepointer,
|
||||
procinfo^.selfpointer_offset));
|
||||
emitjmp(C_E,nodestroycall);
|
||||
if procinfo^._class^.is_class then
|
||||
begin
|
||||
emit_const(A_PUSH,S_L,1);
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
end
|
||||
else
|
||||
begin
|
||||
emit_reg(A_PUSH,S_L,R_ESI);
|
||||
emit_sym(A_PUSH,S_L,newasmsymbol(procinfo^._class^.vmt_mangledname));
|
||||
end;
|
||||
if (po_virtualmethod in pd^.procoptions) then
|
||||
begin
|
||||
emit_ref_reg(A_MOV,S_L,new_reference(R_ESI,0),R_EDI);
|
||||
emit_ref(A_CALL,S_NO,new_reference(R_EDI,procinfo^._class^.vmtmethodoffset(pd^.extnumber)));
|
||||
end
|
||||
else
|
||||
emitcall(pd^.mangledname);
|
||||
{ not necessary because the result is never assigned in the
|
||||
case of an exception (FK) }
|
||||
emit_const_reg(A_MOV,S_L,0,R_ESI);
|
||||
emit_const_ref(A_MOV,S_L,0,new_reference(procinfo^.framepointer,8));
|
||||
emitlab(nodestroycall);
|
||||
end;
|
||||
end
|
||||
}
|
||||
end
|
||||
else
|
||||
{ must be the return value finalized before reraising the exception? }
|
||||
@ -3724,7 +3732,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.76 2000-02-04 14:29:57 pierre
|
||||
Revision 1.77 2000-02-04 20:00:21 florian
|
||||
* an exception in a construcor calls now the destructor (this applies only
|
||||
to classes)
|
||||
|
||||
Revision 1.76 2000/02/04 14:29:57 pierre
|
||||
+ add pseudo local var parent_ebp for local procs
|
||||
|
||||
Revision 1.75 2000/01/25 08:46:03 pierre
|
||||
|
||||
@ -310,10 +310,10 @@ begin
|
||||
inc(paramoffset,target_os.size_of_pointer);
|
||||
end;
|
||||
|
||||
{ destructor flag ? }
|
||||
{ con/-destructor flag ? }
|
||||
if assigned (procinfo^._Class) and
|
||||
procinfo^._class^.is_class and
|
||||
(pd^.proctypeoption=potype_destructor) then
|
||||
(pd^.proctypeoption in [potype_destructor,potype_constructor]) then
|
||||
inc(paramoffset,target_os.size_of_pointer);
|
||||
|
||||
procinfo^.para_offset:=paramoffset;
|
||||
@ -1969,7 +1969,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.45 2000-02-04 14:54:17 jonas
|
||||
Revision 1.46 2000-02-04 20:00:22 florian
|
||||
* an exception in a construcor calls now the destructor (this applies only
|
||||
to classes)
|
||||
|
||||
Revision 1.45 2000/02/04 14:54:17 jonas
|
||||
* moved call to resetusableregs to compile_proc_body (put it right before the
|
||||
reset of the temp generator) so the optimizer can know which registers are
|
||||
regvars
|
||||
|
||||
@ -3342,6 +3342,53 @@ Const local_symtable_index : longint = $8001;
|
||||
is_related:=false;
|
||||
end;
|
||||
|
||||
var
|
||||
sd : pprocdef;
|
||||
|
||||
procedure _searchdestructor(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
|
||||
|
||||
var
|
||||
p : pprocdef;
|
||||
|
||||
begin
|
||||
{ if we found already a destructor, then we exit }
|
||||
if assigned(sd) then
|
||||
exit;
|
||||
if psym(sym)^.typ=procsym then
|
||||
begin
|
||||
p:=pprocsym(sym)^.definition;
|
||||
while assigned(p) do
|
||||
begin
|
||||
if p^.proctypeoption=potype_destructor then
|
||||
begin
|
||||
sd:=p;
|
||||
exit;
|
||||
end;
|
||||
p:=p^.nextoverloaded;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function tobjectdef.searchdestructor : pprocdef;
|
||||
|
||||
var
|
||||
o : pobjectdef;
|
||||
|
||||
begin
|
||||
searchdestructor:=nil;
|
||||
o:=@self;
|
||||
sd:=nil;
|
||||
while assigned(o) do
|
||||
begin
|
||||
symtable^.foreach({$ifndef TP}@{$endif}_searchdestructor);
|
||||
if assigned(sd) then
|
||||
begin
|
||||
searchdestructor:=sd;
|
||||
exit;
|
||||
end;
|
||||
o:=o^.childof;
|
||||
end;
|
||||
end;
|
||||
|
||||
function tobjectdef.size : longint;
|
||||
begin
|
||||
@ -3868,7 +3915,11 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.191 2000-01-30 23:29:06 peter
|
||||
Revision 1.192 2000-02-04 20:00:22 florian
|
||||
* an exception in a construcor calls now the destructor (this applies only
|
||||
to classes)
|
||||
|
||||
Revision 1.191 2000/01/30 23:29:06 peter
|
||||
* fixed dup rtti writing for classes
|
||||
|
||||
Revision 1.190 2000/01/28 23:17:53 florian
|
||||
|
||||
@ -174,6 +174,8 @@
|
||||
{$endif GDB}
|
||||
end;
|
||||
|
||||
pprocdef = ^tprocdef;
|
||||
|
||||
pobjectdef = ^tobjectdef;
|
||||
tobjectdef = object(tdef)
|
||||
childof : pobjectdef;
|
||||
@ -200,6 +202,7 @@
|
||||
function next_free_name_index : longint;
|
||||
procedure insertvmt;
|
||||
procedure set_parent(c : pobjectdef);
|
||||
function searchdestructor : pprocdef;
|
||||
{ debug }
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;virtual;
|
||||
@ -381,7 +384,6 @@
|
||||
1 : (i : longint);
|
||||
end;
|
||||
|
||||
pprocdef = ^tprocdef;
|
||||
tprocdef = object(tabstractprocdef)
|
||||
private
|
||||
_mangledname : pchar;
|
||||
@ -528,7 +530,11 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.51 2000-01-26 12:02:30 peter
|
||||
Revision 1.52 2000-02-04 20:00:22 florian
|
||||
* an exception in a construcor calls now the destructor (this applies only
|
||||
to classes)
|
||||
|
||||
Revision 1.51 2000/01/26 12:02:30 peter
|
||||
* abstractprocdef.para_size needs alignment parameter
|
||||
* secondcallparan gets para_alignment size instead of dword_align
|
||||
|
||||
@ -646,4 +652,4 @@
|
||||
position info
|
||||
* Removed comp warnings
|
||||
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user