Browse Source

* 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 -

Jonas Maebe 16 years ago
parent
commit
3660bf7f98
6 changed files with 195 additions and 301 deletions
  1. 184 17
      compiler/ncal.pas
  2. 4 1
      compiler/ncgcal.pas
  3. 0 276
      compiler/nobjc.pas
  4. 0 2
      compiler/node.pas
  5. 1 1
      compiler/ppu.pas
  6. 6 4
      tests/test/tobjc20.pp

+ 184 - 17
compiler/ncal.pas

@@ -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);
-             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;
            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

+ 4 - 1
compiler/ncgcal.pas

@@ -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

+ 0 - 276
compiler/nobjc.pas

@@ -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.
 
 

+ 0 - 2
compiler/node.pas

@@ -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

+ 1 - 1
compiler/ppu.pas

@@ -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;

+ 6 - 4
tests/test/tobjc20.pp

@@ -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;