mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 21:46:00 +02:00
* integrated the transformation of an Objective-C method call into a call
to objc_msgSend* into the callnode. This allows reusing the current call node rather than having to create a new one, and is in particular necessary because even though the objc_msgSend* functions are declared as varargs, you're supposed to typecast them to the function type describing the method before calling them (so they should *not* use varargs calling conventions!) * for the above, a field called fobjcforcedprocname has been added to the callnode, which can be set to a string that will be used as the (mangled) name of the function to call instead of the mangled name of the procsym -> fixes calling obj-c methods with floating point arguments on ppc git-svn-id: branches/objc@13783 -
This commit is contained in:
parent
97ba8de56c
commit
3660bf7f98
@ -46,7 +46,8 @@ interface
|
|||||||
cnf_dispose_call,
|
cnf_dispose_call,
|
||||||
cnf_member_call, { called with implicit methodpointer tree }
|
cnf_member_call, { called with implicit methodpointer tree }
|
||||||
cnf_uses_varargs, { varargs are used in the declaration }
|
cnf_uses_varargs, { varargs are used in the declaration }
|
||||||
cnf_create_failed { exception thrown in constructor -> don't call beforedestruction }
|
cnf_create_failed, { exception thrown in constructor -> don't call beforedestruction }
|
||||||
|
cnf_objc_processed { the procedure name has been set to the appropriate objc_msgSend* variant -> don't process again }
|
||||||
);
|
);
|
||||||
tcallnodeflags = set of tcallnodeflag;
|
tcallnodeflags = set of tcallnodeflag;
|
||||||
|
|
||||||
@ -73,7 +74,8 @@ interface
|
|||||||
procedure check_inlining;
|
procedure check_inlining;
|
||||||
function pass1_normal:tnode;
|
function pass1_normal:tnode;
|
||||||
procedure register_created_object_types;
|
procedure register_created_object_types;
|
||||||
|
protected
|
||||||
|
procedure objc_convert_to_message_send;virtual;
|
||||||
|
|
||||||
private
|
private
|
||||||
{ inlining support }
|
{ inlining support }
|
||||||
@ -87,6 +89,10 @@ interface
|
|||||||
function pass1_inline:tnode;
|
function pass1_inline:tnode;
|
||||||
protected
|
protected
|
||||||
pushedparasize : longint;
|
pushedparasize : longint;
|
||||||
|
{ Objective-C support: force the call node to call the routine with
|
||||||
|
this name rather than the name of symtableprocentry (don't store
|
||||||
|
to ppu, is set while processing the node) }
|
||||||
|
fobjcforcedprocname: pshortstring;
|
||||||
public
|
public
|
||||||
{ the symbol containing the definition of the procedure }
|
{ the symbol containing the definition of the procedure }
|
||||||
{ to call }
|
{ to call }
|
||||||
@ -150,6 +156,8 @@ interface
|
|||||||
{ checks if there are any parameters which end up at the stack, i.e.
|
{ checks if there are any parameters which end up at the stack, i.e.
|
||||||
which have LOC_REFERENCE and set pi_has_stackparameter if this applies }
|
which have LOC_REFERENCE and set pi_has_stackparameter if this applies }
|
||||||
procedure check_stack_parameters;
|
procedure check_stack_parameters;
|
||||||
|
{ force the name of the to-be-called routine to a particular string,
|
||||||
|
used for Objective-C message sending. }
|
||||||
property parameters : tnode read left write left;
|
property parameters : tnode read left write left;
|
||||||
private
|
private
|
||||||
AbstractMethodsList : TFPHashList;
|
AbstractMethodsList : TFPHashList;
|
||||||
@ -211,6 +219,7 @@ implementation
|
|||||||
symconst,defutil,defcmp,
|
symconst,defutil,defcmp,
|
||||||
htypechk,pass_1,
|
htypechk,pass_1,
|
||||||
ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
|
ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
|
||||||
|
objcutil,
|
||||||
procinfo,cpuinfo,
|
procinfo,cpuinfo,
|
||||||
cgbase,
|
cgbase,
|
||||||
wpobase
|
wpobase
|
||||||
@ -996,6 +1005,7 @@ implementation
|
|||||||
funcretnode.free;
|
funcretnode.free;
|
||||||
if assigned(varargsparas) then
|
if assigned(varargsparas) then
|
||||||
varargsparas.free;
|
varargsparas.free;
|
||||||
|
stringdispose(fobjcforcedprocname);
|
||||||
inherited destroy;
|
inherited destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1275,7 +1285,7 @@ implementation
|
|||||||
(hp.nodetype=typeconvn) and
|
(hp.nodetype=typeconvn) and
|
||||||
(ttypeconvnode(hp).convtype=tc_equal) do
|
(ttypeconvnode(hp).convtype=tc_equal) do
|
||||||
hp:=tunarynode(hp).left;
|
hp:=tunarynode(hp).left;
|
||||||
result:=(hp.nodetype in [typen,loadvmtaddrn,loadn,temprefn,arrayconstructorn]);
|
result:=(hp.nodetype in [typen,loadvmtaddrn,loadn,temprefn,arrayconstructorn,addrn]);
|
||||||
if result and
|
if result and
|
||||||
not(may_be_in_reg) then
|
not(may_be_in_reg) then
|
||||||
case hp.nodetype of
|
case hp.nodetype of
|
||||||
@ -1499,12 +1509,17 @@ implementation
|
|||||||
selftree:=nil;
|
selftree:=nil;
|
||||||
|
|
||||||
{ When methodpointer was a callnode we must load it first into a
|
{ When methodpointer was a callnode we must load it first into a
|
||||||
temp to prevent the processing callnode twice }
|
temp to prevent processing the callnode twice }
|
||||||
if (methodpointer.nodetype=calln) then
|
if (methodpointer.nodetype=calln) then
|
||||||
internalerror(200405121);
|
internalerror(200405121);
|
||||||
|
|
||||||
|
{ Objective-C: objc_convert_to_message_send() already did all necessary
|
||||||
|
transformation on the methodpointer }
|
||||||
|
if (procdefinition.typ=procdef) and
|
||||||
|
(po_objc in tprocdef(procdefinition).procoptions) then
|
||||||
|
selftree:=methodpointer.getcopy
|
||||||
{ inherited }
|
{ inherited }
|
||||||
if (cnf_inherited in callnodeflags) then
|
else if (cnf_inherited in callnodeflags) then
|
||||||
begin
|
begin
|
||||||
selftree:=load_self_node;
|
selftree:=load_self_node;
|
||||||
{ we can call an inherited class static/method from a regular method
|
{ we can call an inherited class static/method from a regular method
|
||||||
@ -1670,6 +1685,146 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcallnode.objc_convert_to_message_send;
|
||||||
|
var
|
||||||
|
block,
|
||||||
|
selftree : tnode;
|
||||||
|
statements : tstatementnode;
|
||||||
|
field : tfieldvarsym;
|
||||||
|
temp : ttempcreatenode;
|
||||||
|
selfrestype,
|
||||||
|
objcsupertype : tdef;
|
||||||
|
srsym : tsym;
|
||||||
|
srsymtable : tsymtable;
|
||||||
|
msgsendname : string;
|
||||||
|
begin
|
||||||
|
{ typecheck pass must already have run on the call node,
|
||||||
|
because pass1 calls this method
|
||||||
|
}
|
||||||
|
|
||||||
|
{ default behaviour: call objc_msgSend and friends;
|
||||||
|
64 bit targets for Mac OS X can override this as they
|
||||||
|
can call messages via an indirect function call similar to
|
||||||
|
dynamically linked functions, ARM maybe as well (not checked)
|
||||||
|
|
||||||
|
Which variant of objc_msgSend is used depends on the
|
||||||
|
result type, and on whether or not it's an inherited call.
|
||||||
|
}
|
||||||
|
|
||||||
|
{ make sure we don't perform this transformation twice in case
|
||||||
|
firstpass would be called multiple times }
|
||||||
|
include(callnodeflags,cnf_objc_processed);
|
||||||
|
|
||||||
|
{ A) set the appropriate objc_msgSend* variant to call }
|
||||||
|
|
||||||
|
{ record returned via implicit pointer }
|
||||||
|
if paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
|
||||||
|
begin
|
||||||
|
if not(cnf_inherited in callnodeflags) then
|
||||||
|
msgsendname:='OBJC_MSGSEND_STRET'
|
||||||
|
{$if defined(onlymacosx10_6) or defined(arm) }
|
||||||
|
else if (target_info.system in system_objc_nfabi) then
|
||||||
|
msgsendname:='OBJC_MSGSENDSUPER2_STRET'
|
||||||
|
{$endif onlymacosx10_6 or arm}
|
||||||
|
else
|
||||||
|
msgsendname:='OBJC_MSGSENDSUPER_STRET'
|
||||||
|
end
|
||||||
|
{$ifdef i386}
|
||||||
|
{ special case for fpu results on i386 for non-inherited calls }
|
||||||
|
{ TODO: also for x86_64 "extended" results }
|
||||||
|
else if (resultdef.typ=floatdef) and
|
||||||
|
not(cnf_inherited in callnodeflags) then
|
||||||
|
msgsendname:='OBJC_MSGSEND_FPRET'
|
||||||
|
{$endif}
|
||||||
|
{ default }
|
||||||
|
else if not(cnf_inherited in callnodeflags) then
|
||||||
|
msgsendname:='OBJC_MSGSEND'
|
||||||
|
{$if defined(onlymacosx10_6) or defined(arm) }
|
||||||
|
else if (target_info.system in system_objc_nfabi) then
|
||||||
|
msgsendname:='OBJC_MSGSENDSUPER2'
|
||||||
|
{$endif onlymacosx10_6 or arm}
|
||||||
|
else
|
||||||
|
msgsendname:='OBJC_MSGSENDSUPER';
|
||||||
|
|
||||||
|
{ get the mangled name }
|
||||||
|
if not searchsym_in_named_module('OBJC',msgsendname,srsym,srsymtable) or
|
||||||
|
(srsym.typ<>procsym) or
|
||||||
|
(tprocsym(srsym).ProcdefList.count<>1) then
|
||||||
|
Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname);
|
||||||
|
fobjcforcedprocname:=stringdup(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname);
|
||||||
|
|
||||||
|
{ B) Handle self }
|
||||||
|
{ 1) in case of sending a message to a superclass, self is a pointer to
|
||||||
|
an objc_super record
|
||||||
|
}
|
||||||
|
if (cnf_inherited in callnodeflags) then
|
||||||
|
begin
|
||||||
|
block:=internalstatements(statements);
|
||||||
|
objcsupertype:=search_named_unit_globaltype('OBJC','OBJC_SUPER').typedef;
|
||||||
|
if (objcsupertype.typ<>recorddef) then
|
||||||
|
internalerror(2009032901);
|
||||||
|
{ temp for the for the objc_super record }
|
||||||
|
temp:=ctempcreatenode.create(objcsupertype,objcsupertype.size,tt_persistent,false);
|
||||||
|
addstatement(statements,temp);
|
||||||
|
{ initialize objc_super record }
|
||||||
|
selftree:=load_self_node;
|
||||||
|
|
||||||
|
{ we can call an inherited class static/method from a regular method
|
||||||
|
-> self node must change from instance pointer to vmt pointer)
|
||||||
|
}
|
||||||
|
if (po_classmethod in procdefinition.procoptions) and
|
||||||
|
(selftree.resultdef.typ<>classrefdef) then
|
||||||
|
begin
|
||||||
|
selftree:=cloadvmtaddrnode.create(selftree);
|
||||||
|
typecheckpass(selftree);
|
||||||
|
end;
|
||||||
|
selfrestype:=selftree.resultdef;
|
||||||
|
field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('RECEIVER'));
|
||||||
|
if not assigned(field) then
|
||||||
|
internalerror(2009032902);
|
||||||
|
{ first the destination object/class instance }
|
||||||
|
addstatement(statements,
|
||||||
|
cassignmentnode.create(
|
||||||
|
csubscriptnode.create(field,ctemprefnode.create(temp)),
|
||||||
|
selftree
|
||||||
|
)
|
||||||
|
);
|
||||||
|
{ and secondly, the class type in which the selector must be looked
|
||||||
|
up (the parent class in case of an instance method, the parent's
|
||||||
|
metaclass in case of a class method) }
|
||||||
|
field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('_CLASS'));
|
||||||
|
if not assigned(field) then
|
||||||
|
internalerror(2009032903);
|
||||||
|
addstatement(statements,
|
||||||
|
cassignmentnode.create(
|
||||||
|
csubscriptnode.create(field,ctemprefnode.create(temp)),
|
||||||
|
objcsuperclassnode(selftree.resultdef)
|
||||||
|
)
|
||||||
|
);
|
||||||
|
{ result of this block is the address of this temp }
|
||||||
|
addstatement(statements,ctypeconvnode.create_internal(
|
||||||
|
caddrnode.create_internal(ctemprefnode.create(temp)),selfrestype)
|
||||||
|
);
|
||||||
|
{ replace the method pointer with the address of this temp }
|
||||||
|
methodpointer.free;
|
||||||
|
methodpointer:=block;
|
||||||
|
typecheckpass(block);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ 2) regular call (not inherited) }
|
||||||
|
begin
|
||||||
|
{ a) If we're calling a class method, use a class ref. }
|
||||||
|
if (po_classmethod in procdefinition.procoptions) and
|
||||||
|
((methodpointer.nodetype=typen) or
|
||||||
|
(methodpointer.resultdef.typ<>classrefdef)) then
|
||||||
|
begin
|
||||||
|
methodpointer:=cloadvmtaddrnode.create(methodpointer);
|
||||||
|
firstpass(methodpointer);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function tcallnode.gen_vmt_tree:tnode;
|
function tcallnode.gen_vmt_tree:tnode;
|
||||||
var
|
var
|
||||||
vmttree : tnode;
|
vmttree : tnode;
|
||||||
@ -2029,7 +2184,12 @@ implementation
|
|||||||
if vo_is_overflow_check in para.parasym.varoptions then
|
if vo_is_overflow_check in para.parasym.varoptions then
|
||||||
begin
|
begin
|
||||||
para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),booltype,false);
|
para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),booltype,false);
|
||||||
end;
|
end
|
||||||
|
else
|
||||||
|
if vo_is_msgsel in para.parasym.varoptions then
|
||||||
|
begin
|
||||||
|
para.left:=cobjcselectornode.create(cstringconstnode.createstr(tprocdef(procdefinition).messageinf.str^));
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
if not assigned(para.left) then
|
if not assigned(para.left) then
|
||||||
internalerror(200709084);
|
internalerror(200709084);
|
||||||
@ -2849,19 +3009,26 @@ implementation
|
|||||||
if (procdefinition.typ=procdef) and
|
if (procdefinition.typ=procdef) and
|
||||||
(po_objc in tprocdef(procdefinition).procoptions) then
|
(po_objc in tprocdef(procdefinition).procoptions) then
|
||||||
begin
|
begin
|
||||||
result:=cobjcmessagesendnode.create(self.getcopy);
|
if not(cnf_objc_processed in callnodeflags) then
|
||||||
exit;
|
objc_convert_to_message_send;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ The following don't apply to obj-c: obj-c methods can never be
|
||||||
|
inlined because they're always virtual and the destination can
|
||||||
|
change at run, and for the same reason we also can't perform
|
||||||
|
WPO on them (+ they have no constructors) }
|
||||||
|
|
||||||
|
{ Check if the call can be inlined, sets the cnf_do_inline flag }
|
||||||
|
check_inlining;
|
||||||
|
|
||||||
|
{ must be called before maybe_load_in_temp(methodpointer), because
|
||||||
|
it converts the methodpointer into a temp in case it's a call
|
||||||
|
(and we want to know the original call)
|
||||||
|
}
|
||||||
|
register_created_object_types;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ Check if the call can be inlined, sets the cnf_do_inline flag }
|
|
||||||
check_inlining;
|
|
||||||
|
|
||||||
{ must be called before maybe_load_in_temp(methodpointer), because
|
|
||||||
it converts the methodpointer into a temp in case it's a call
|
|
||||||
(and we want to know the original call)
|
|
||||||
}
|
|
||||||
register_created_object_types;
|
|
||||||
|
|
||||||
{ Maybe optimize the loading of the methodpointer using a temp. When the methodpointer
|
{ Maybe optimize the loading of the methodpointer using a temp. When the methodpointer
|
||||||
is a calln this is even required to not execute the calln twice.
|
is a calln this is even required to not execute the calln twice.
|
||||||
This needs to be done after the resulttype pass, because in the resulttype we can still convert the
|
This needs to be done after the resulttype pass, because in the resulttype we can still convert the
|
||||||
|
@ -1024,9 +1024,12 @@ implementation
|
|||||||
{$endif vtentry}
|
{$endif vtentry}
|
||||||
|
|
||||||
name_to_call:='';
|
name_to_call:='';
|
||||||
|
if assigned(fobjcforcedprocname) then
|
||||||
|
name_to_call:=fobjcforcedprocname^;
|
||||||
{ When methodpointer is typen we don't need (and can't) load
|
{ When methodpointer is typen we don't need (and can't) load
|
||||||
a pointer. We can directly call the correct procdef (PFV) }
|
a pointer. We can directly call the correct procdef (PFV) }
|
||||||
if (po_virtualmethod in procdefinition.procoptions) and
|
if (name_to_call='') and
|
||||||
|
(po_virtualmethod in procdefinition.procoptions) and
|
||||||
assigned(methodpointer) and
|
assigned(methodpointer) and
|
||||||
(methodpointer.nodetype<>typen) and
|
(methodpointer.nodetype<>typen) and
|
||||||
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
|
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
|
||||||
|
@ -50,17 +50,8 @@ type
|
|||||||
end;
|
end;
|
||||||
tobjcprotocolnodeclass = class of tobjcprotocolnode;
|
tobjcprotocolnodeclass = class of tobjcprotocolnode;
|
||||||
|
|
||||||
tobjcmessagesendnode = class(tunarynode)
|
|
||||||
public
|
|
||||||
constructor create(forcall: tnode);
|
|
||||||
function pass_typecheck: tnode;override;
|
|
||||||
function pass_1: tnode;override;
|
|
||||||
end;
|
|
||||||
tobjcmessagesendnodeclass = class of tobjcmessagesendnode;
|
|
||||||
|
|
||||||
var
|
var
|
||||||
cobjcselectornode : tobjcselectornodeclass;
|
cobjcselectornode : tobjcselectornodeclass;
|
||||||
cobjcmessagesendnode : tobjcmessagesendnodeclass;
|
|
||||||
cobjcprotocolnode : tobjcprotocolnodeclass;
|
cobjcprotocolnode : tobjcprotocolnodeclass;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -170,272 +161,5 @@ function tobjcprotocolnode.pass_1: tnode;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
|
||||||
TOBJCMESSAGESENDNODE
|
|
||||||
*****************************************************************************}
|
|
||||||
|
|
||||||
constructor tobjcmessagesendnode.create(forcall: tnode);
|
|
||||||
begin
|
|
||||||
if (forcall.nodetype<>calln) then
|
|
||||||
internalerror(2009032502);
|
|
||||||
{ typecheck pass must already have run on the call node,
|
|
||||||
because pass1 of the callnode creates this node right
|
|
||||||
at the beginning
|
|
||||||
}
|
|
||||||
inherited create(objcmessagesendn,forcall);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function tobjcmessagesendnode.pass_typecheck: tnode;
|
|
||||||
begin
|
|
||||||
{ typecheckpass of left has already run, see constructor }
|
|
||||||
resultdef:=left.resultdef;
|
|
||||||
result:=nil;
|
|
||||||
expectloc:=left.expectloc;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function tobjcmessagesendnode.pass_1: tnode;
|
|
||||||
var
|
|
||||||
msgsendname: string;
|
|
||||||
newparas,
|
|
||||||
para: tcallparanode;
|
|
||||||
block,
|
|
||||||
selftree : tnode;
|
|
||||||
statements: tstatementnode;
|
|
||||||
temp,
|
|
||||||
tempresult: ttempcreatenode;
|
|
||||||
objcsupertype: tdef;
|
|
||||||
field: tfieldvarsym;
|
|
||||||
selfpara,
|
|
||||||
msgselpara,
|
|
||||||
respara,
|
|
||||||
|
|
||||||
prerespara,
|
|
||||||
prevpara: tcallparanode;
|
|
||||||
begin
|
|
||||||
{ typecheckpass of left has already run, see constructor }
|
|
||||||
|
|
||||||
{ default behaviour: call objc_msgSend and friends;
|
|
||||||
ppc64 and x86_64 for Mac OS X have to override this as they
|
|
||||||
call messages via an indirect function call similar to
|
|
||||||
dynamically linked functions, ARM maybe as well (not checked)
|
|
||||||
|
|
||||||
Which variant of objc_msgSend is used depends on the
|
|
||||||
result type, and on whether or not it's an inherited call.
|
|
||||||
}
|
|
||||||
|
|
||||||
tempresult:=nil;
|
|
||||||
newparas:=tcallparanode(tcallnode(left).left);
|
|
||||||
{ Find the self and msgsel parameters, and if we have var/out parameters
|
|
||||||
that normally aren't passed by reference in C, add addrnodes
|
|
||||||
}
|
|
||||||
para:=newparas;
|
|
||||||
selfpara:=nil;
|
|
||||||
msgselpara:=nil;
|
|
||||||
respara:=nil;
|
|
||||||
prevpara:=nil;
|
|
||||||
while assigned(para) do
|
|
||||||
begin
|
|
||||||
if (vo_is_self in para.parasym.varoptions) then
|
|
||||||
selfpara:=para
|
|
||||||
else if (vo_is_msgsel in para.parasym.varoptions) then
|
|
||||||
msgselpara:=para
|
|
||||||
else if (vo_is_funcret in para.parasym.varoptions) then
|
|
||||||
begin
|
|
||||||
prerespara:=prevpara;
|
|
||||||
respara:=para;
|
|
||||||
end
|
|
||||||
{ All parameters will be passed as varargs to objc_msg*, so make
|
|
||||||
sure that in case of var/out parameters, the address is passed. }
|
|
||||||
else if (para.parasym.varspez in [vs_var,vs_out]) and
|
|
||||||
not paramanager.push_addr_param(vs_value,para.parasym.vardef,pocall_cdecl) then
|
|
||||||
para.left:=caddrnode.create(para.left);
|
|
||||||
prevpara:=para;
|
|
||||||
para:=tcallparanode(para.right);
|
|
||||||
end;
|
|
||||||
if not assigned(selfpara) then
|
|
||||||
internalerror(2009051801);
|
|
||||||
if not assigned(msgselpara) then
|
|
||||||
internalerror(2009051802);
|
|
||||||
|
|
||||||
{ record returned via implicit pointer }
|
|
||||||
if paramanager.ret_in_param(left.resultdef,tcallnode(left).procdefinition.proccalloption) then
|
|
||||||
begin
|
|
||||||
if not assigned(respara) then
|
|
||||||
internalerror(2009091101);
|
|
||||||
{ Since the result parameter is also hidden in the routine we'll
|
|
||||||
call now, it will be inserted again by the callnode. So we have to
|
|
||||||
remove the old one, otherwise we'll have two result parameters.
|
|
||||||
}
|
|
||||||
if (tcallparanode(respara).left.nodetype<>nothingn) then
|
|
||||||
internalerror(2009091102);
|
|
||||||
if assigned(prerespara) then
|
|
||||||
tcallparanode(prerespara).right:=tcallparanode(respara).right
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
tcallnode(left).left:=tcallparanode(respara).right;
|
|
||||||
newparas:=tcallparanode(tcallnode(left).left);
|
|
||||||
end;
|
|
||||||
tcallparanode(respara).right:=nil;
|
|
||||||
respara.free;
|
|
||||||
if not(cnf_inherited in tcallnode(left).callnodeflags) then
|
|
||||||
msgsendname:='OBJC_MSGSEND_STRET'
|
|
||||||
{$if defined(onlymacosx10_6) or defined(arm) }
|
|
||||||
else if (target_info.system in system_objc_nfabi) then
|
|
||||||
msgsendname:='OBJC_MSGSENDSUPER2_STRET'
|
|
||||||
{$endif onlymacosx10_6 or arm}
|
|
||||||
else
|
|
||||||
msgsendname:='OBJC_MSGSENDSUPER_STRET'
|
|
||||||
end
|
|
||||||
{$ifdef i386}
|
|
||||||
{ special case for fpu results on i386 for non-inherited calls }
|
|
||||||
else if (left.resultdef.typ=floatdef) and
|
|
||||||
not(cnf_inherited in tcallnode(left).callnodeflags) then
|
|
||||||
msgsendname:='OBJC_MSGSEND_FPRET'
|
|
||||||
{$endif}
|
|
||||||
{ default }
|
|
||||||
else if not(cnf_inherited in tcallnode(left).callnodeflags) then
|
|
||||||
msgsendname:='OBJC_MSGSEND'
|
|
||||||
{$if defined(onlymacosx10_6) or defined(arm) }
|
|
||||||
else if (target_info.system in system_objc_nfabi) then
|
|
||||||
msgsendname:='OBJC_MSGSENDSUPER2'
|
|
||||||
{$endif onlymacosx10_6 or arm}
|
|
||||||
else
|
|
||||||
msgsendname:='OBJC_MSGSENDSUPER';
|
|
||||||
|
|
||||||
|
|
||||||
{ Handle self }
|
|
||||||
{ 1) in case of sending a message to a superclass, self is a pointer to
|
|
||||||
an objc_super record
|
|
||||||
}
|
|
||||||
if (cnf_inherited in tcallnode(left).callnodeflags) then
|
|
||||||
begin
|
|
||||||
block:=internalstatements(statements);
|
|
||||||
objcsupertype:=search_named_unit_globaltype('OBJC','OBJC_SUPER').typedef;
|
|
||||||
if (objcsupertype.typ<>recorddef) then
|
|
||||||
internalerror(2009032901);
|
|
||||||
{ temp for the for the objc_super record }
|
|
||||||
temp:=ctempcreatenode.create(objcsupertype,objcsupertype.size,tt_persistent,false);
|
|
||||||
addstatement(statements,temp);
|
|
||||||
{ initialize objc_super record }
|
|
||||||
selftree:=load_self_node;
|
|
||||||
|
|
||||||
{ we can call an inherited class static/method from a regular method
|
|
||||||
-> self node must change from instance pointer to vmt pointer)
|
|
||||||
}
|
|
||||||
if (po_classmethod in tcallnode(left).procdefinition.procoptions) and
|
|
||||||
(selftree.resultdef.typ<>classrefdef) then
|
|
||||||
begin
|
|
||||||
selftree:=cloadvmtaddrnode.create(selftree);
|
|
||||||
typecheckpass(selftree);
|
|
||||||
end;
|
|
||||||
field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('RECEIVER'));
|
|
||||||
if not assigned(field) then
|
|
||||||
internalerror(2009032902);
|
|
||||||
{ first the destination object/class instance }
|
|
||||||
addstatement(statements,
|
|
||||||
cassignmentnode.create(
|
|
||||||
csubscriptnode.create(field,ctemprefnode.create(temp)),
|
|
||||||
selftree
|
|
||||||
)
|
|
||||||
);
|
|
||||||
{ and secondly, the class type in which the selector must be looked
|
|
||||||
up (the parent class in case of an instance method, the parent's
|
|
||||||
metaclass in case of a class method) }
|
|
||||||
field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('_CLASS'));
|
|
||||||
if not assigned(field) then
|
|
||||||
internalerror(2009032903);
|
|
||||||
addstatement(statements,
|
|
||||||
cassignmentnode.create(
|
|
||||||
csubscriptnode.create(field,ctemprefnode.create(temp)),
|
|
||||||
objcsuperclassnode(selftree.resultdef)
|
|
||||||
)
|
|
||||||
);
|
|
||||||
{ result of this block is the address of this temp }
|
|
||||||
addstatement(statements,caddrnode.create_internal(ctemprefnode.create(temp)));
|
|
||||||
{ replace the method pointer with the address of this temp }
|
|
||||||
tcallnode(left).methodpointer.free;
|
|
||||||
tcallnode(left).methodpointer:=block;
|
|
||||||
typecheckpass(block);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ 2) regular call (not inherited) }
|
|
||||||
begin
|
|
||||||
{ a) If we're calling a class method, use a class ref. }
|
|
||||||
if (po_classmethod in tcallnode(left).procdefinition.procoptions) and
|
|
||||||
((tcallnode(left).methodpointer.nodetype=typen) or
|
|
||||||
(tcallnode(left).methodpointer.resultdef.typ<>classrefdef)) then
|
|
||||||
begin
|
|
||||||
tcallnode(left).methodpointer:=cloadvmtaddrnode.create(tcallnode(left).methodpointer);
|
|
||||||
firstpass(tcallnode(left).methodpointer);
|
|
||||||
end;
|
|
||||||
{ b) convert methodpointer parameter to match objc_MsgSend* signatures }
|
|
||||||
inserttypeconv_internal(tcallnode(left).methodpointer,objc_idtype);
|
|
||||||
end;
|
|
||||||
{ replace self parameter }
|
|
||||||
selfpara.left.free;
|
|
||||||
selfpara.left:=tcallnode(left).methodpointer;
|
|
||||||
{ replace selector parameter }
|
|
||||||
msgselpara.left.free;
|
|
||||||
msgselpara.left:=
|
|
||||||
cobjcselectornode.create(
|
|
||||||
cstringconstnode.createstr(tprocdef(tcallnode(left).procdefinition).messageinf.str^)
|
|
||||||
);
|
|
||||||
{ parameters are reused -> make sure they don't get freed }
|
|
||||||
tcallnode(left).left:=nil;
|
|
||||||
{ methodpointer is also reused }
|
|
||||||
tcallnode(left).methodpointer:=nil;
|
|
||||||
{ and now the call to the Objective-C rtl }
|
|
||||||
result:=ccallnode.createinternresfromunit('OBJC',msgsendname,newparas,left.resultdef);
|
|
||||||
{ record whether or not the function result is used (remains
|
|
||||||
the same for the new call).
|
|
||||||
}
|
|
||||||
if not(cnf_return_value_used in tcallnode(left).callnodeflags) then
|
|
||||||
exclude(tcallnode(result).callnodeflags,cnf_return_value_used);
|
|
||||||
{ in case an explicit function result was specified, keep it }
|
|
||||||
tcallnode(result).funcretnode:=tcallnode(left).funcretnode;
|
|
||||||
tcallnode(left).funcretnode:=nil;
|
|
||||||
{ keep variable paras }
|
|
||||||
tcallnode(result).varargsparas:=tcallnode(left).varargsparas;
|
|
||||||
tcallnode(left).varargsparas:=nil;
|
|
||||||
|
|
||||||
if (cnf_inherited in tcallnode(left).callnodeflags) then
|
|
||||||
begin
|
|
||||||
block:=internalstatements(statements);
|
|
||||||
{ temp for the result of the inherited call }
|
|
||||||
if not is_void(left.resultdef) and
|
|
||||||
(cnf_return_value_used in tcallnode(left).callnodeflags) then
|
|
||||||
begin
|
|
||||||
tempresult:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
|
|
||||||
addstatement(statements,tempresult);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ make sure we return the result, if any }
|
|
||||||
if not assigned(tempresult) then
|
|
||||||
addstatement(statements,result)
|
|
||||||
else
|
|
||||||
addstatement(statements,
|
|
||||||
cassignmentnode.create(ctemprefnode.create(tempresult),result));
|
|
||||||
{ free the objc_super temp after the call. We cannot use
|
|
||||||
ctempdeletenode.create_normal_temp before the call, because then
|
|
||||||
the temp will be released while evaluating the parameters, and thus
|
|
||||||
may be reused while evaluating another parameter
|
|
||||||
}
|
|
||||||
addstatement(statements,ctempdeletenode.create(temp));
|
|
||||||
if assigned(tempresult) then
|
|
||||||
begin
|
|
||||||
{ mark the result temp as "free after next use" and return it }
|
|
||||||
addstatement(statements,
|
|
||||||
ctempdeletenode.create_normal_temp(tempresult));
|
|
||||||
addstatement(statements,ctemprefnode.create(tempresult));
|
|
||||||
end;
|
|
||||||
typecheckpass(block);
|
|
||||||
result:=block;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
cobjcmessagesendnode:=tobjcmessagesendnode;
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -111,7 +111,6 @@ interface
|
|||||||
loadparentfpn, { Load the framepointer of the parent for nested procedures }
|
loadparentfpn, { Load the framepointer of the parent for nested procedures }
|
||||||
dataconstn, { node storing some binary data }
|
dataconstn, { node storing some binary data }
|
||||||
objcselectorn, { node for an Objective-C message selector }
|
objcselectorn, { node for an Objective-C message selector }
|
||||||
objcmessagesendn, { node for message sent to an Objective-C instance (similar to a method call) }
|
|
||||||
objcprotocoln { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
|
objcprotocoln { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
|
||||||
);
|
);
|
||||||
|
|
||||||
@ -195,7 +194,6 @@ interface
|
|||||||
'loadparentfpn',
|
'loadparentfpn',
|
||||||
'dataconstn',
|
'dataconstn',
|
||||||
'objcselectorn',
|
'objcselectorn',
|
||||||
'objcmessagesendn',
|
|
||||||
'objcprotocoln');
|
'objcprotocoln');
|
||||||
|
|
||||||
type
|
type
|
||||||
|
@ -43,7 +43,7 @@ type
|
|||||||
{$endif Test_Double_checksum}
|
{$endif Test_Double_checksum}
|
||||||
|
|
||||||
const
|
const
|
||||||
CurrentPPUVersion = 102;
|
CurrentPPUVersion = 103;
|
||||||
|
|
||||||
{ buffer sizes }
|
{ buffer sizes }
|
||||||
maxentrysize = 1024;
|
maxentrysize = 1024;
|
||||||
|
@ -19,7 +19,7 @@ type
|
|||||||
function getss: shortstring ; message 'getss';
|
function getss: shortstring ; message 'getss';
|
||||||
function getsspara(l1,l2: longint): shortstring ; message 'getss:l1:';
|
function getsspara(l1,l2: longint): shortstring ; message 'getss:l1:';
|
||||||
function getsingle(l1,l2: longint): single; message 'getsingle:l1:';
|
function getsingle(l1,l2: longint): single; message 'getsingle:l1:';
|
||||||
function getdouble(l1,l2: longint): double; message 'getdouble:l1:';
|
function getdouble(l1,l2: longint; d: double): double; message 'getdouble:l1:l2:';
|
||||||
|
|
||||||
function getbool: boolean; message 'getbool';
|
function getbool: boolean; message 'getbool';
|
||||||
end;
|
end;
|
||||||
@ -48,10 +48,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function MyObject.getdouble(l1,l2: longint): double;
|
function MyObject.getdouble(l1,l2: longint; d: double): double;
|
||||||
begin
|
begin
|
||||||
|
writeln(d);
|
||||||
if (l1<>1) or
|
if (l1<>1) or
|
||||||
(l2<>2) then
|
(l2<>2) or
|
||||||
|
(d<>1.5) then
|
||||||
halt(3);
|
halt(3);
|
||||||
result:=fdouble;
|
result:=fdouble;
|
||||||
end;
|
end;
|
||||||
@ -78,7 +80,7 @@ begin
|
|||||||
halt(5);
|
halt(5);
|
||||||
if m.getsingle(1,2)<>123.625 then
|
if m.getsingle(1,2)<>123.625 then
|
||||||
halt(6);
|
halt(6);
|
||||||
if m.getdouble(1,2)<>9876.0625 then
|
if m.getdouble(1,2,1.5)<>9876.0625 then
|
||||||
halt(7);
|
halt(7);
|
||||||
|
|
||||||
m.fbool:=true;
|
m.fbool:=true;
|
||||||
|
Loading…
Reference in New Issue
Block a user