mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-03 22:30:27 +02:00
* handle the loading of VMT entries at the node level, so it's done in a
type-safe way (for LLVM, and also internal consistency checking between
the VMT as generated in nobj.pas and ncgvmt.pas)
o also converted the VMT validity checking to the node level
git-svn-id: trunk@30950 -
This commit is contained in:
Jonas Maebe
parent
822b943d08
commit
3f736f6114
@ -348,7 +348,6 @@ unit cgobj;
|
||||
procedure optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);virtual;
|
||||
|
||||
|
||||
procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
|
||||
{# This should emit the opcode to copy len bytes from the source
|
||||
to destination.
|
||||
|
||||
@ -2185,52 +2184,6 @@ implementation
|
||||
{$endif cpuflags}
|
||||
|
||||
|
||||
procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
|
||||
var
|
||||
hrefvmt : treference;
|
||||
cgpara1,cgpara2 : TCGPara;
|
||||
pd: tprocdef;
|
||||
begin
|
||||
cgpara1.init;
|
||||
cgpara2.init;
|
||||
if (cs_check_object in current_settings.localswitches) then
|
||||
begin
|
||||
pd:=search_system_proc('fpc_check_object_ext');
|
||||
paramanager.getintparaloc(list,pd,1,cgpara1);
|
||||
paramanager.getintparaloc(list,pd,2,cgpara2);
|
||||
reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname,AT_DATA),0,sizeof(pint));
|
||||
if pd.is_pushleftright then
|
||||
begin
|
||||
a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
|
||||
a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
|
||||
a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
|
||||
end;
|
||||
paramanager.freecgpara(list,cgpara1);
|
||||
paramanager.freecgpara(list,cgpara2);
|
||||
allocallcpuregisters(list);
|
||||
a_call_name(list,'fpc_check_object_ext',false);
|
||||
deallocallcpuregisters(list);
|
||||
end
|
||||
else
|
||||
if (cs_check_range in current_settings.localswitches) then
|
||||
begin
|
||||
pd:=search_system_proc('fpc_check_object');
|
||||
paramanager.getintparaloc(list,pd,1,cgpara1);
|
||||
a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
|
||||
paramanager.freecgpara(list,cgpara1);
|
||||
allocallcpuregisters(list);
|
||||
a_call_name(list,'fpc_check_object',false);
|
||||
deallocallcpuregisters(list);
|
||||
end;
|
||||
cgpara1.done;
|
||||
cgpara2.done;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Entry/Exit Code Functions
|
||||
*****************************************************************************}
|
||||
|
||||
@ -50,6 +50,7 @@ interface
|
||||
procedure extra_post_call_code; override;
|
||||
function dispatch_procvar: tnode;
|
||||
procedure remove_hidden_paras;
|
||||
procedure gen_vmt_entry_load; override;
|
||||
public
|
||||
function pass_typecheck: tnode; override;
|
||||
function pass_1: tnode; override;
|
||||
@ -492,6 +493,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tjvmcallnode.gen_vmt_entry_load;
|
||||
begin
|
||||
{ nothing to do }
|
||||
end;
|
||||
|
||||
|
||||
function tjvmcallnode.pass_typecheck: tnode;
|
||||
begin
|
||||
result:=inherited pass_typecheck;
|
||||
|
||||
@ -84,6 +84,7 @@ interface
|
||||
procedure register_created_object_types;
|
||||
function get_expect_loc: tcgloc;
|
||||
protected
|
||||
procedure gen_vmt_entry_load; virtual;
|
||||
procedure gen_syscall_para(para: tcallparanode); virtual;
|
||||
procedure objc_convert_to_message_send;virtual;
|
||||
|
||||
@ -123,6 +124,8 @@ interface
|
||||
procdefinitionderef : tderef;
|
||||
{ tree that contains the pointer to the object for this method }
|
||||
methodpointer : tnode;
|
||||
{ tree representing the VMT entry to call (if any) }
|
||||
vmt_entry : tnode;
|
||||
{ tree that contains the self/vmt parameter when this node was created
|
||||
(so it's still valid when this node is processed in an inline
|
||||
context)
|
||||
@ -1484,6 +1487,7 @@ implementation
|
||||
varargsparas.free;
|
||||
call_self_node.free;
|
||||
call_vmt_node.free;
|
||||
vmt_entry.free;
|
||||
{$ifndef symansistr}
|
||||
stringdispose(fforcedprocname);
|
||||
{$endif symansistr}
|
||||
@ -2323,6 +2327,36 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tcallnode.gen_vmt_entry_load;
|
||||
var
|
||||
vmt_def: trecorddef;
|
||||
begin
|
||||
if not assigned(right) and
|
||||
(forcedprocname='') and
|
||||
(po_virtualmethod in procdefinition.procoptions) and
|
||||
not is_objectpascal_helper(tprocdef(procdefinition).struct) and
|
||||
assigned(methodpointer) and
|
||||
(methodpointer.nodetype<>typen) then
|
||||
begin
|
||||
vmt_entry:=load_vmt_for_self_node(methodpointer.getcopy);
|
||||
{ get the right entry in the VMT }
|
||||
vmt_entry:=cderefnode.create(vmt_entry);
|
||||
typecheckpass(vmt_entry);
|
||||
vmt_def:=trecorddef(vmt_entry.resultdef);
|
||||
{ tobjectdef(tprocdef(procdefinition).struct) can be a parent of the
|
||||
methodpointer's resultdef, but the vmtmethodoffset of the method
|
||||
in that objectdef is obviously the same as in any child class }
|
||||
vmt_entry:=csubscriptnode.create(
|
||||
trecordsymtable(vmt_def.symtable).findfieldbyoffset(
|
||||
tobjectdef(tprocdef(procdefinition).struct).vmtmethodoffset(tprocdef(procdefinition).extnumber)
|
||||
),
|
||||
vmt_entry
|
||||
);
|
||||
firstpass(vmt_entry);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcallnode.gen_syscall_para(para: tcallparanode);
|
||||
begin
|
||||
{ unsupported }
|
||||
@ -4093,6 +4127,9 @@ implementation
|
||||
end
|
||||
else
|
||||
expectloc:=LOC_VOID;
|
||||
|
||||
{ create tree for VMT entry if required }
|
||||
gen_vmt_entry_load;
|
||||
end;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
|
||||
@ -890,8 +890,7 @@ implementation
|
||||
href : treference;
|
||||
pop_size : longint;
|
||||
vmtoffset : aint;
|
||||
pvreg,
|
||||
vmtreg : tregister;
|
||||
pvreg : tregister;
|
||||
oldaktcallnode : tcallnode;
|
||||
retlocitem: pcgparalocation;
|
||||
pd : tprocdef;
|
||||
@ -1001,37 +1000,26 @@ implementation
|
||||
if tprocdef(procdefinition).extnumber=$ffff then
|
||||
internalerror(200304021);
|
||||
|
||||
secondpass(methodpointer);
|
||||
{ load the VMT entry (address of the virtual method) }
|
||||
secondpass(vmt_entry);
|
||||
|
||||
{ Load VMT from self }
|
||||
if methodpointer.resultdef.typ=objectdef then
|
||||
gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(methodpointer.resultdef),methodpointer.location,vmtreg)
|
||||
else
|
||||
begin
|
||||
{ Load VMT value in register }
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,methodpointer.location,methodpointer.resultdef,methodpointer.resultdef,false);
|
||||
vmtreg:=methodpointer.location.register;
|
||||
{ test validity of VMT }
|
||||
if not(is_interface(tprocdef(procdefinition).struct)) and
|
||||
not(is_cppclass(tprocdef(procdefinition).struct)) then
|
||||
cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tobjectdef(tprocdef(procdefinition).struct));
|
||||
end;
|
||||
|
||||
{ Call through VMT, generate a VTREF symbol to notify the linker }
|
||||
vmtoffset:=tobjectdef(tprocdef(procdefinition).struct).vmtmethodoffset(tprocdef(procdefinition).extnumber);
|
||||
{ register call for WPO }
|
||||
if (not assigned(current_procinfo) or
|
||||
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
|
||||
tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
|
||||
|
||||
reference_reset_base(href,vmtreg,vmtoffset,proc_addr_voidptrdef.alignment);
|
||||
if not(vmt_entry.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
|
||||
internalerror(2015052502);
|
||||
href:=vmt_entry.location.reference;
|
||||
pvreg:=NR_NO;
|
||||
|
||||
callref:=can_call_ref(href);
|
||||
if not callref then
|
||||
begin
|
||||
pvreg:=get_call_reg(current_asmdata.CurrAsmList);
|
||||
cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,href,pvreg);
|
||||
hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,
|
||||
vmt_entry.resultdef,vmt_entry.resultdef,
|
||||
href,pvreg);
|
||||
end;
|
||||
|
||||
{ Load parameters that are in temporary registers in the
|
||||
|
||||
@ -138,11 +138,8 @@ implementation
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ left contains self, load vmt from self }
|
||||
secondpass(left);
|
||||
gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(left.resultdef),left.location,location.register);
|
||||
end;
|
||||
{ should be handled in pass 1 }
|
||||
internalerror(2015052801);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -85,7 +85,6 @@ interface
|
||||
procedure gen_load_para_value(list:TAsmList);
|
||||
|
||||
procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
|
||||
procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
|
||||
|
||||
procedure get_used_regvars(n: tnode; var rv: tusedregvars);
|
||||
{ adds the regvars used in n and its children to rv.allregvars,
|
||||
@ -1899,73 +1898,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
|
||||
var
|
||||
href : treference;
|
||||
selfdef: tdef;
|
||||
begin
|
||||
if is_object(objdef) then
|
||||
begin
|
||||
case selfloc.loc of
|
||||
LOC_CREFERENCE,
|
||||
LOC_REFERENCE:
|
||||
begin
|
||||
hlcg.reference_reset_base(href,voidpointertype,hlcg.getaddressregister(list,voidpointertype),objdef.vmt_offset,voidpointertype.size);
|
||||
hlcg.a_loadaddr_ref_reg(list,voidpointertype,voidpointertype,selfloc.reference,href.base);
|
||||
selfdef:=getpointerdef(objdef);
|
||||
end;
|
||||
else
|
||||
internalerror(200305056);
|
||||
end;
|
||||
end
|
||||
else
|
||||
{ This is also valid for Objective-C classes: vmt_offset is 0 there,
|
||||
and the first "field" of an Objective-C class instance is a pointer
|
||||
to its "meta-class". }
|
||||
begin
|
||||
selfdef:=objdef;
|
||||
case selfloc.loc of
|
||||
LOC_REGISTER:
|
||||
begin
|
||||
{$ifdef cpu_uses_separate_address_registers}
|
||||
if getregtype(selfloc.register)<>R_ADDRESSREGISTER then
|
||||
begin
|
||||
reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
|
||||
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base);
|
||||
end
|
||||
else
|
||||
{$endif cpu_uses_separate_address_registers}
|
||||
hlcg.reference_reset_base(href,voidpointertype,selfloc.register,objdef.vmt_offset,voidpointertype.size);
|
||||
end;
|
||||
LOC_CONSTANT,
|
||||
LOC_CREGISTER,
|
||||
LOC_CREFERENCE,
|
||||
LOC_REFERENCE,
|
||||
LOC_CSUBSETREG,
|
||||
LOC_SUBSETREG,
|
||||
LOC_CSUBSETREF,
|
||||
LOC_SUBSETREF:
|
||||
begin
|
||||
hlcg.reference_reset_base(href,voidpointertype,hlcg.getaddressregister(list,voidpointertype),objdef.vmt_offset,voidpointertype.size);
|
||||
{ todo: pass actual vmt pointer type to hlcg }
|
||||
hlcg.a_load_loc_reg(list,voidpointertype,voidpointertype,selfloc,href.base);
|
||||
end;
|
||||
else
|
||||
internalerror(200305057);
|
||||
end;
|
||||
end;
|
||||
vmtreg:=hlcg.getaddressregister(list,voidpointertype);
|
||||
hlcg.g_maybe_testself(list,selfdef,href.base);
|
||||
hlcg.a_load_ref_reg(list,voidpointertype,voidpointertype,href,vmtreg);
|
||||
|
||||
{ test validity of VMT }
|
||||
if not(is_interface(objdef)) and
|
||||
not(is_cppclass(objdef)) and
|
||||
not(is_objc_class_or_protocol(objdef)) then
|
||||
cg.g_maybe_testvmt(list,vmtreg,objdef);
|
||||
end;
|
||||
|
||||
|
||||
function getprocalign : shortint;
|
||||
begin
|
||||
{ gprof uses 16 byte granularity }
|
||||
|
||||
@ -1086,7 +1086,9 @@ implementation
|
||||
genintmsgtab(tcb,intmessagetable,intmessagetabledef);
|
||||
end;
|
||||
|
||||
tcb.begin_anonymous_record('',voidpointertype.alignment,
|
||||
{ reuse the type created in nobj, so we get internal consistency
|
||||
checking for free }
|
||||
tcb.begin_anonymous_record('$vmtdef$'+_class.mangledparaname,voidpointertype.alignment,
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
|
||||
|
||||
@ -260,11 +260,11 @@ implementation
|
||||
end
|
||||
else
|
||||
result:=objcloadbasefield(left,'ISA');
|
||||
{ reused }
|
||||
left:=nil;
|
||||
end
|
||||
else
|
||||
firstpass(left);
|
||||
result:=ctypeconvnode.create_internal(load_vmt_for_self_node(left),resultdef);
|
||||
{ reused }
|
||||
left:=nil;
|
||||
end
|
||||
else if not is_objcclass(left.resultdef) and
|
||||
not is_objcclassref(left.resultdef) then
|
||||
|
||||
@ -46,6 +46,7 @@ interface
|
||||
procedure prot_get_procdefs_recursive(ImplProt:TImplementedInterface;ProtDef:TObjectDef);
|
||||
procedure intf_optimize_vtbls;
|
||||
procedure intf_allocate_vtbls;
|
||||
procedure generate_vmt_def;
|
||||
public
|
||||
constructor create(c:tobjectdef);
|
||||
procedure generate_vmt;
|
||||
@ -57,9 +58,9 @@ implementation
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
globals,verbose,systems,
|
||||
globals,verbose,systems,fmodule,
|
||||
node,
|
||||
symbase,symtable,symconst,symtype,defcmp,
|
||||
symbase,symtable,symconst,symtype,defcmp,defutil,
|
||||
symcpu,
|
||||
dbgbase,
|
||||
wpobase
|
||||
@ -786,6 +787,90 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure TVMTBuilder.generate_vmt_def;
|
||||
var
|
||||
i: longint;
|
||||
vmtdef: trecorddef;
|
||||
systemvmt: tdef;
|
||||
sym: tsym;
|
||||
symtab: tsymtable;
|
||||
begin
|
||||
{ these types don't have an actual VMT, we only use the other methods
|
||||
in TVMTBuilder to determine duplicates/overrides }
|
||||
if _class.objecttype in [
|
||||
odt_helper,
|
||||
odt_objcclass,
|
||||
odt_objccategory,
|
||||
odt_objcprotocol,
|
||||
odt_javaclass,
|
||||
odt_interfacecom_property,
|
||||
odt_interfacecom_function,
|
||||
odt_interfacejava] then
|
||||
exit;
|
||||
|
||||
{ todo in the future }
|
||||
if _class.objecttype = odt_cppclass then
|
||||
exit;
|
||||
|
||||
{ the VMT definition may already exist in case of generics }
|
||||
if searchsym_in_module(current_module,'vmtdef$'+_class.mangledparaname,sym,symtab) then
|
||||
exit;
|
||||
{ create VMT type definition }
|
||||
vmtdef:=crecorddef.create_global_internal(
|
||||
'$vmtdef$'+_class.mangledparaname,
|
||||
0,
|
||||
target_info.alignment.recordalignmin,
|
||||
target_info.alignment.maxCrecordalign);
|
||||
{ standard VMT fields }
|
||||
case _Class.objecttype of
|
||||
odt_class:
|
||||
begin
|
||||
systemvmt:=search_system_type('TVMT').typedef;
|
||||
{ does the TVMT type look like we expect? (so that this code is
|
||||
easily triggered in case the definition of the VMT would
|
||||
change) }
|
||||
if (systemvmt.typ<>recorddef) or
|
||||
(trecorddef(systemvmt).symtable.SymList.count<>25) then
|
||||
internalerror(2015052601);
|
||||
{ system.tvmt is a record that represents the VMT of TObject,
|
||||
including its virtual methods. We only want the non-method
|
||||
fields, as the methods will be added automatically based on
|
||||
the VMT we generated here only add the 12 first fields }
|
||||
for i:=0 to 11 do
|
||||
begin
|
||||
sym:=tsym(trecorddef(systemvmt).symtable.SymList[i]);
|
||||
if sym.typ<>fieldvarsym then
|
||||
internalerror(2015052602);
|
||||
vmtdef.add_field_by_def(tfieldvarsym(sym).vardef);
|
||||
end;
|
||||
end;
|
||||
odt_interfacecom,odt_interfacecorba,odt_dispinterface:
|
||||
{ nothing }
|
||||
;
|
||||
odt_object:
|
||||
begin
|
||||
{ size, -size, parent vmt [, dmt ] }
|
||||
vmtdef.add_field_by_def(ptrsinttype);
|
||||
vmtdef.add_field_by_def(ptrsinttype);
|
||||
vmtdef.add_field_by_def(voidpointertype);
|
||||
{$ifdef WITHDMT}
|
||||
vmtdef.add_field_by_def(voidpointertype);
|
||||
{$endif WITHDMT}
|
||||
end;
|
||||
else
|
||||
internalerror(2015052605);
|
||||
end;
|
||||
|
||||
{ now add the methods }
|
||||
for i:=0 to _class.vmtentries.count-1 do
|
||||
vmtdef.add_field_by_def(
|
||||
getprocaddressprocvar(pvmtentry(_class.vmtentries[i])^.procdef)
|
||||
);
|
||||
{ the VMT ends with a nil pointer }
|
||||
vmtdef.add_field_by_def(voidcodepointertype);
|
||||
end;
|
||||
|
||||
|
||||
procedure TVMTBuilder.generate_vmt;
|
||||
var
|
||||
i : longint;
|
||||
@ -829,7 +914,7 @@ implementation
|
||||
{ Allocate interface tables }
|
||||
intf_allocate_vtbls;
|
||||
end;
|
||||
|
||||
generate_vmt_def;
|
||||
current_structdef:=old_current_structdef;
|
||||
end;
|
||||
|
||||
|
||||
@ -76,6 +76,9 @@ interface
|
||||
function load_self_pointer_node:tnode;
|
||||
function load_vmt_pointer_node:tnode;
|
||||
function is_self_node(p:tnode):boolean;
|
||||
{ create a tree that loads the VMT based on a self-node of an object/class/
|
||||
interface }
|
||||
function load_vmt_for_self_node(self_node: tnode): tnode;
|
||||
|
||||
function node_complexity(p: tnode): cardinal;
|
||||
function node_resources_fpu(p: tnode): cardinal;
|
||||
@ -150,7 +153,7 @@ implementation
|
||||
uses
|
||||
cutils,verbose,globals,
|
||||
symconst,symdef,
|
||||
defutil,defcmp,
|
||||
defutil,defcmp,htypechk,
|
||||
nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
|
||||
cpubase,cgbase,procinfo,
|
||||
pass_1;
|
||||
@ -554,6 +557,123 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function load_vmt_for_self_node(self_node: tnode): tnode;
|
||||
var
|
||||
self_resultdef: tdef;
|
||||
obj_def: tobjectdef;
|
||||
self_temp,
|
||||
vmt_temp: ttempcreatenode;
|
||||
check_self: tnode;
|
||||
stat: tstatementnode;
|
||||
block: tblocknode;
|
||||
paras: tcallparanode;
|
||||
docheck: boolean;
|
||||
begin
|
||||
self_resultdef:=self_node.resultdef;
|
||||
case self_resultdef.typ of
|
||||
classrefdef:
|
||||
obj_def:=tobjectdef(tclassrefdef(self_resultdef).pointeddef);
|
||||
objectdef:
|
||||
obj_def:=tobjectdef(self_resultdef);
|
||||
else
|
||||
internalerror(2015052701);
|
||||
end;
|
||||
if is_classhelper(obj_def) then
|
||||
obj_def:=tobjectdef(tobjectdef(obj_def).extendeddef);
|
||||
docheck:=
|
||||
not(is_interface(obj_def)) and
|
||||
not(is_cppclass(obj_def)) and
|
||||
not(is_objc_class_or_protocol(obj_def)) and
|
||||
(([cs_check_object,cs_check_range]*current_settings.localswitches)<>[]);
|
||||
|
||||
block:=nil;
|
||||
stat:=nil;
|
||||
if docheck then
|
||||
begin
|
||||
{ check for nil self-pointer }
|
||||
block:=internalstatements(stat);
|
||||
self_temp:=ctempcreatenode.create_value(
|
||||
self_resultdef,self_resultdef.size,tt_persistent,true,
|
||||
self_node);
|
||||
addstatement(stat,self_temp);
|
||||
|
||||
{ in case of an object, self can only be nil if it's a dereferenced
|
||||
node somehow
|
||||
}
|
||||
if not is_object(self_resultdef) or
|
||||
(actualtargetnode(@self_node)^.nodetype=derefn) then
|
||||
begin
|
||||
check_self:=ctemprefnode.create(self_temp);
|
||||
if is_object(self_resultdef) then
|
||||
check_self:=caddrnode.create(check_self);
|
||||
addstatement(stat,cifnode.create(
|
||||
caddnode.create(equaln,
|
||||
ctypeconvnode.create_explicit(
|
||||
check_self,
|
||||
voidpointertype
|
||||
),
|
||||
cnilnode.create),
|
||||
ccallnode.createintern('fpc_objecterror',nil),
|
||||
nil)
|
||||
);
|
||||
end;
|
||||
addstatement(stat,ctempdeletenode.create_normal_temp(self_temp));
|
||||
self_node:=ctemprefnode.create(self_temp);
|
||||
end;
|
||||
{ get the VMT field in case of a class/object }
|
||||
if (self_resultdef.typ=objectdef) and
|
||||
assigned(tobjectdef(self_resultdef).vmt_field) then
|
||||
result:=csubscriptnode.create(tobjectdef(self_resultdef).vmt_field,self_node)
|
||||
{ in case of a classref, the "instance" is a pointer
|
||||
to pointer to a VMT and there is no vmt field }
|
||||
else if self_resultdef.typ=classrefdef then
|
||||
result:=self_node
|
||||
{ in case of an interface, the "instance" is a pointer to a pointer
|
||||
to a VMT -> dereference once already }
|
||||
else
|
||||
{ in case of an interface/classref, the "instance" is a pointer
|
||||
to pointer to a VMT and there is no vmt field }
|
||||
result:=cderefnode.create(
|
||||
ctypeconvnode.create_explicit(
|
||||
self_node,
|
||||
getpointerdef(voidpointertype)
|
||||
)
|
||||
);
|
||||
result:=ctypeconvnode.create_explicit(
|
||||
result,
|
||||
getpointerdef(obj_def.vmt_def));
|
||||
typecheckpass(result);
|
||||
if docheck then
|
||||
begin
|
||||
{ add a vmt validity check }
|
||||
vmt_temp:=ctempcreatenode.create_value(result.resultdef,result.resultdef.size,tt_persistent,true,result);
|
||||
addstatement(stat,vmt_temp);
|
||||
paras:=ccallparanode.create(ctemprefnode.create(vmt_temp),nil);
|
||||
if cs_check_object in current_settings.localswitches then
|
||||
begin
|
||||
paras:=ccallparanode.create(
|
||||
cloadvmtaddrnode.create(ctypenode.create(obj_def)),
|
||||
paras
|
||||
);
|
||||
addstatement(stat,
|
||||
ccallnode.createintern(
|
||||
'fpc_check_object_ext',paras
|
||||
)
|
||||
);
|
||||
end
|
||||
else
|
||||
addstatement(stat,
|
||||
ccallnode.createintern(
|
||||
'fpc_check_object',paras
|
||||
)
|
||||
);
|
||||
addstatement(stat,ctempdeletenode.create_normal_temp(vmt_temp));
|
||||
addstatement(stat,ctemprefnode.create(vmt_temp));
|
||||
result:=block;
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
{ this function must return a very high value ("infinity") for }
|
||||
{ trees containing a call, the rest can be balanced more or less }
|
||||
{ at will, probably best mainly in terms of required memory }
|
||||
|
||||
@ -430,6 +430,7 @@ interface
|
||||
function needs_separate_initrtti : boolean;override;
|
||||
function rtti_mangledname(rt:trttitype):string;override;
|
||||
function vmt_mangledname : TSymStr;
|
||||
function vmt_def: trecorddef;
|
||||
procedure check_forwards; override;
|
||||
procedure insertvmt;
|
||||
function vmt_offset: asizeint;
|
||||
@ -6644,6 +6645,19 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tobjectdef.vmt_def: trecorddef;
|
||||
var
|
||||
vmttypesym: tsym;
|
||||
begin
|
||||
vmttypesym:=tsym(get_top_level_symtable.Find('vmtdef$'+mangledparaname));
|
||||
if not assigned(vmttypesym) or
|
||||
(vmttypesym.typ<>symconst.typesym) or
|
||||
(ttypesym(vmttypesym).typedef.typ<>recorddef) then
|
||||
internalerror(2015052501);
|
||||
result:=trecorddef(ttypesym(vmttypesym).typedef);
|
||||
end;
|
||||
|
||||
|
||||
function tobjectdef.needs_inittable : boolean;
|
||||
var
|
||||
hp : tobjectdef;
|
||||
|
||||
@ -89,6 +89,7 @@ interface
|
||||
function needs_separate_initrtti:boolean;virtual;abstract;
|
||||
procedure ChangeOwner(st:TSymtable);
|
||||
procedure register_created_object_type;virtual;
|
||||
function get_top_level_symtable: tsymtable;
|
||||
end;
|
||||
|
||||
{************************************************
|
||||
@ -356,6 +357,15 @@ implementation
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function tdef.get_top_level_symtable: tsymtable;
|
||||
begin
|
||||
result:=owner;
|
||||
while assigned(result) and
|
||||
assigned(result.defowner) do
|
||||
result:=tdef(result.defowner).owner;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TSYM (base for all symtypes)
|
||||
****************************************************************************}
|
||||
|
||||
@ -711,6 +711,7 @@ procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint); compilerpr
|
||||
procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint); compilerproc;
|
||||
{$endif LARGESETS}
|
||||
|
||||
procedure fpc_objecterror; compilerproc;
|
||||
procedure fpc_rangeerror; compilerproc;
|
||||
procedure fpc_divbyzero; compilerproc;
|
||||
procedure fpc_overflow; compilerproc;
|
||||
|
||||
@ -736,6 +736,10 @@ begin
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_STACKINFO}
|
||||
|
||||
procedure fpc_objecterror; compilerproc;
|
||||
begin
|
||||
HandleErrorAddrFrameInd(210,get_pc_addr,get_frame);
|
||||
end;
|
||||
|
||||
procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; compilerproc;
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user