paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 03:39:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* integrated the transformation of an Objective-C method call into a call

Browse Source 
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:
Jonas Maebe 2009-10-01 12:05:11 +00:00
parent 97ba8de56c
commit 3660bf7f98
6 changed files with 195 additions and 301 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

201
compiler/ncal.pas
View File

@ -46,7 +46,8 @@ interface
cnf_dispose_call,
cnf_member_call, { called with implicit methodpointer tree }
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;
@ -73,7 +74,8 @@ interface
procedure check_inlining;
function pass1_normal:tnode;
procedure register_created_object_types;
protected
procedure objc_convert_to_message_send;virtual;
private
{ inlining support }
@ -87,6 +89,10 @@ interface
function pass1_inline:tnode;
protected
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
{ the symbol containing the definition of the procedure }
{ to call }
@ -150,6 +156,8 @@ interface
{ 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 }
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;
private
AbstractMethodsList : TFPHashList;
@ -211,6 +219,7 @@ implementation
symconst,defutil,defcmp,
htypechk,pass_1,
ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
objcutil,
procinfo,cpuinfo,
cgbase,
wpobase
@ -996,6 +1005,7 @@ implementation
funcretnode.free;
if assigned(varargsparas) then
varargsparas.free;
stringdispose(fobjcforcedprocname);
inherited destroy;
end;
@ -1275,7 +1285,7 @@ implementation
(hp.nodetype=typeconvn) and
(ttypeconvnode(hp).convtype=tc_equal) do
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
not(may_be_in_reg) then
case hp.nodetype of
@ -1499,12 +1509,17 @@ implementation
selftree:=nil;
{ 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
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 }
if (cnf_inherited in callnodeflags) then
else if (cnf_inherited in callnodeflags) then
begin
selftree:=load_self_node;
{ we can call an inherited class static/method from a regular method
@ -1670,6 +1685,146 @@ implementation
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;
var
vmttree : tnode;
@ -2029,7 +2184,12 @@ implementation
if vo_is_overflow_check in para.parasym.varoptions then
begin
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;
if not assigned(para.left) then
internalerror(200709084);
@ -2849,19 +3009,26 @@ implementation
if (procdefinition.typ=procdef) and
(po_objc in tprocdef(procdefinition).procoptions) then
begin
result:=cobjcmessagesendnode.create(self.getcopy);
exit;
if not(cnf_objc_processed in callnodeflags) then
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;
{ 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
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

5
compiler/ncgcal.pas
View File

@ -1024,9 +1024,12 @@ implementation
{$endif vtentry}
name_to_call:='';
if assigned(fobjcforcedprocname) then
name_to_call:=fobjcforcedprocname^;
{ When methodpointer is typen we don't need (and can't) load
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
(methodpointer.nodetype<>typen) and
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then

276
compiler/nobjc.pas
View File

@ -50,17 +50,8 @@ type
end;
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
cobjcselectornode : tobjcselectornodeclass;
cobjcmessagesendnode : tobjcmessagesendnodeclass;
cobjcprotocolnode : tobjcprotocolnodeclass;
implementation
@ -170,272 +161,5 @@ function tobjcprotocolnode.pass_1: tnode;
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.

2
compiler/node.pas
View File

@ -111,7 +111,6 @@ interface
loadparentfpn, { Load the framepointer of the parent for nested procedures }
dataconstn, { node storing some binary data }
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) }
);
@ -195,7 +194,6 @@ interface
'loadparentfpn',
'dataconstn',
'objcselectorn',
'objcmessagesendn',
'objcprotocoln');
type

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 102;
CurrentPPUVersion = 103;
{ buffer sizes }
maxentrysize = 1024;

10
tests/test/tobjc20.pp
View File

@ -19,7 +19,7 @@ type
function getss: shortstring ; message 'getss';
function getsspara(l1,l2: longint): shortstring ; message 'getss: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';
end;
@ -48,10 +48,12 @@ begin
end;
function MyObject.getdouble(l1,l2: longint): double;
function MyObject.getdouble(l1,l2: longint; d: double): double;
begin
writeln(d);
if (l1<>1) or
(l2<>2) then
(l2<>2) or
(d<>1.5) then
halt(3);
result:=fdouble;
end;
@ -78,7 +80,7 @@ begin
halt(5);
if m.getsingle(1,2)<>123.625 then
halt(6);
if m.getdouble(1,2)<>9876.0625 then
if m.getdouble(1,2,1.5)<>9876.0625 then
halt(7);
m.fbool:=true;