* fix the handling of value parameters in cdecl function

compiler/README

@@ -84,3 +84,4 @@ Changes in the syntax or semantic of FPC:
              type, check the directive HASFIXED  (FK)
   29/02/00   ORDERSOURCES released => PPU version change
              this allows for a more correct include file hunting order.
+  01/04/00   fix the handling of value parameters in cdecl function

compiler/cg386cal.pas

@@ -32,7 +32,7 @@ interface
       symtable,tree;
 
     procedure secondcallparan(var p : ptree;defcoll : pparaitem;
-                push_from_left_to_right,inlined : boolean;para_alignment,para_offset : longint);
+                push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
     procedure secondcalln(var p : ptree);
     procedure secondprocinline(var p : ptree);
 
@@ -55,7 +55,7 @@ implementation
 *****************************************************************************}
 
     procedure secondcallparan(var p : ptree;defcoll : pparaitem;
-                push_from_left_to_right,inlined : boolean;para_alignment,para_offset : longint);
+                push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
 
       procedure maybe_push_high;
         begin
@@ -68,7 +68,7 @@ implementation
                 begin
                   secondpass(p^.hightree);
                   { this is a longint anyway ! }
-                  push_value_para(p^.hightree,inlined,para_offset,4);
+                  push_value_para(p^.hightree,inlined,false,para_offset,4);
                 end
                else
                 internalerror(432645);
@@ -88,7 +88,7 @@ implementation
          { push from left to right if specified }
          if push_from_left_to_right and assigned(p^.right) then
            secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
-             inlined,para_alignment,para_offset);
+             inlined,is_cdecl,para_alignment,para_offset);
          otlabel:=truelabel;
          oflabel:=falselabel;
          getlabel(truelabel);
@@ -175,9 +175,10 @@ implementation
               { open array must always push the address, this is needed to
                 also push addr of small arrays (PFV) }
 
-              if (assigned(defcoll^.paratype.def) and
+              if ((assigned(defcoll^.paratype.def) and
                   is_open_array(defcoll^.paratype.def)) or
-                 push_addr_param(p^.resulttype) then
+                 push_addr_param(p^.resulttype)) and
+                 not is_cdecl then
                 begin
                    maybe_push_high;
                    inc(pushedparasize,4);
@@ -200,7 +201,8 @@ implementation
                 end
               else
                 begin
-                   push_value_para(p^.left,inlined,para_offset,para_alignment);
+                   push_value_para(p^.left,inlined,is_cdecl,
+                     para_offset,para_alignment);
                 end;
            end;
          truelabel:=otlabel;
@@ -208,7 +210,7 @@ implementation
          { push from right to left }
          if not push_from_left_to_right and assigned(p^.right) then
            secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
-             inlined,para_alignment,para_offset);
+             inlined,is_cdecl,para_alignment,para_offset);
       end;
 
 
@@ -405,12 +407,14 @@ implementation
                 para_offset:=0;
               if assigned(p^.right) then
                 secondcallparan(p^.left,pparaitem(pabstractprocdef(p^.right^.resulttype)^.para^.first),
-                  (pocall_leftright in p^.procdefinition^.proccalloptions),
-                  inlined,para_alignment,para_offset)
+                  (pocall_leftright in p^.procdefinition^.proccalloptions),inlined,
+                  (pocall_cdecl in p^.procdefinition^.proccalloptions),
+                  para_alignment,para_offset)
               else
                 secondcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first),
-                  (pocall_leftright in p^.procdefinition^.proccalloptions),
-                  inlined,para_alignment,para_offset);
+                  (pocall_leftright in p^.procdefinition^.proccalloptions),inlined,
+                  (pocall_cdecl in p^.procdefinition^.proccalloptions),
+                  para_alignment,para_offset);
            end;
          params:=p^.left;
          p^.left:=nil;
@@ -1409,7 +1413,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.129  2000-03-19 08:17:36  peter
+  Revision 1.130  2000-03-31 22:56:45  pierre
+    * fix the handling of value parameters in cdecl function
+
+  Revision 1.129  2000/03/19 08:17:36  peter
     * tp7 fix
 
   Revision 1.128  2000/03/16 15:18:13  pierre

compiler/cg386cnv.pas

@@ -59,7 +59,7 @@ implementation
            hightree:=genloadnode(pvarsym(srsym),p^.symtable);
            firstpass(hightree);
            secondpass(hightree);
-           push_value_para(hightree,false,0,4);
+           push_value_para(hightree,false,false,0,4);
            disposetree(hightree);
          end
         else
@@ -1536,7 +1536,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.103  2000-02-19 10:12:47  florian
+  Revision 1.104  2000-03-31 22:56:45  pierre
+    * fix the handling of value parameters in cdecl function
+
+  Revision 1.103  2000/02/19 10:12:47  florian
     * fixed one more internalerror 10
 
   Revision 1.102  2000/02/09 13:22:46  peter

compiler/cg386inl.pas

@@ -338,7 +338,7 @@ implementation
                         else
                           if (is_chararray(hp^.resulttype)) then
                             dummycoll.paratype.setdef(openchararraydef);
-                        secondcallparan(hp,@dummycoll,false,false,0,0);
+                        secondcallparan(hp,@dummycoll,false,false,false,0,0);
                         if ft=ft_typed then
                           never_copy_const_param:=false;
                       end;
@@ -382,7 +382,7 @@ implementation
                                    hp^.right:=nil;
                                    dummycoll.paratype.setdef(hp^.resulttype);
                                    dummycoll.paratyp:=vs_value;
-                                   secondcallparan(hp,@dummycoll,false,false,0,0);
+                                   secondcallparan(hp,@dummycoll,false,false,false,0,0);
                                    hp^.right:=node;
                                    if codegenerror then
                                      exit;
@@ -400,7 +400,7 @@ implementation
                                    hp^.right:=nil;
                                    dummycoll.paratype.setdef(hp^.resulttype);
                                    dummycoll.paratyp:=vs_value;
-                                   secondcallparan(hp,@dummycoll,false,false,0,0);
+                                   secondcallparan(hp,@dummycoll,false,false,false,0,0);
                                    hp^.right:=node;
                                    if pararesult^.deftype<>floatdef then
                                      CGMessage(parser_e_illegal_colon_qualifier);
@@ -562,7 +562,7 @@ implementation
            else
              dummycoll.paratype.setdef(hp^.resulttype);
            procedureprefix:='FPC_'+pstringdef(hp^.resulttype)^.stringtypname+'_';
-           secondcallparan(hp,@dummycoll,false,false,0,0);
+           secondcallparan(hp,@dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -584,7 +584,7 @@ implementation
              begin
                 dummycoll.paratype.setdef(hp^.resulttype);
                 dummycoll.paratyp:=vs_value;
-                secondcallparan(hp,@dummycoll,false,false,0,0);
+                secondcallparan(hp,@dummycoll,false,false,false,0,0);
                 if codegenerror then
                   exit;
                 disposetree(hp);
@@ -601,7 +601,7 @@ implementation
              begin
                 dummycoll.paratype.setdef(hp^.resulttype);
                 dummycoll.paratyp:=vs_value;
-                secondcallparan(hp,@dummycoll,false,false,0,0);
+                secondcallparan(hp,@dummycoll,false,false,false,0,0);
                 if codegenerror then
                   exit;
                 disposetree(hp);
@@ -625,7 +625,7 @@ implementation
            { last arg longint or real }
            dummycoll.paratype.setdef(hp^.resulttype);
            dummycoll.paratyp:=vs_value;
-           secondcallparan(hp,@dummycoll,false,false,0,0);
+           secondcallparan(hp,@dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -695,7 +695,7 @@ implementation
           {load and push the address of the destination}
            dummycoll.paratyp:=vs_var;
            dummycoll.paratype.setdef(dest_para^.resulttype);
-           secondcallparan(dest_para,@dummycoll,false,false,0,0);
+           secondcallparan(dest_para,@dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -709,7 +709,7 @@ implementation
              Begin
                dummycoll.paratyp:=vs_var;
                dummycoll.paratype.setdef(code_para^.resulttype);
-               secondcallparan(code_para,@dummycoll,false,false,0,0);
+               secondcallparan(code_para,@dummycoll,false,false,false,0,0);
                if codegenerror then
                  exit;
                Disposetree(code_para);
@@ -724,7 +724,7 @@ implementation
           {node = first parameter = string}
            dummycoll.paratyp:=vs_const;
            dummycoll.paratype.setdef(node^.resulttype);
-           secondcallparan(node,@dummycoll,false,false,0,0);
+           secondcallparan(node,@dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -1511,7 +1511,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.95  2000-03-21 16:24:43  florian
+  Revision 1.96  2000-03-31 22:56:46  pierre
+    * fix the handling of value parameters in cdecl function
+
+  Revision 1.95  2000/03/21 16:24:43  florian
     * fixed bug 881: for the include/exclude instruction sometimes wrong
       code was generated
 

compiler/cgai386.pas

@@ -104,7 +104,8 @@ unit cgai386;
     procedure emitpushreferenceaddr(const ref : treference);
     procedure pushsetelement(p : ptree);
     procedure restore(p : ptree;isint64 : boolean);
-    procedure push_value_para(p:ptree;inlined:boolean;para_offset:longint;alignment : longint);
+    procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
+                              para_offset:longint;alignment : longint);
 
 {$ifdef TEMPS_NOT_PUSH}
     { does the same as restore/, but uses temp. space instead of pushing }
@@ -1371,7 +1372,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
       end;
 {$endif TEMPS_NOT_PUSH}
 
-      procedure push_value_para(p:ptree;inlined:boolean;para_offset:longint;alignment : longint);
+      procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
+                                para_offset:longint;alignment : longint);
         var
           tempreference : treference;
           r : preference;
@@ -1810,6 +1812,15 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                                 end;
                            end
                          { call by value open array ? }
+                         else if is_cdecl then
+                           begin
+                             { push on stack }
+                             size:=align(p^.resulttype^.size,alignment);
+                             inc(pushedparasize,size);
+                             emit_const_reg(A_SUB,S_L,size,R_ESP);
+                             r:=new_reference(R_ESP,0);
+                             concatcopy(tempreference,r^,size,false,false);
+                           end
                          else
                            internalerror(8954);
                       end;
@@ -3327,7 +3338,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         end;
 
       { generate copies of call by value parameters }
-      if not(po_assembler in aktprocsym^.definition^.procoptions) then
+      if not(po_assembler in aktprocsym^.definition^.procoptions) and
+         not (pocall_cdecl in aktprocsym^.definition^.proccalloptions) then
         aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
 
       { initialisize local data like ansistrings }
@@ -3843,7 +3855,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.90  2000-03-28 22:31:46  pierre
+  Revision 1.91  2000-03-31 22:56:46  pierre
+    * fix the handling of value parameters in cdecl function
+
+  Revision 1.90  2000/03/28 22:31:46  pierre
    * fix for problem in tbs0299 for 4 byte stack alignment
 
   Revision 1.89  2000/03/21 23:36:46  pierre

compiler/psub.pas

@@ -669,10 +669,25 @@ begin
 end;
 
 
+procedure resetvaluepara(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+var
+  vs : pvarsym;
+  s  : string;
+begin
+  if psym(p)^.typ=varsym then
+    with pvarsym(p)^ do
+       if copy(name,1,3)='val' then
+          aktprocsym^.definition^.parast^.symsearch^.rename(name,copy(name,4,length(name)));
+end;
+
 procedure pd_cdecl(const procnames:Tstringcontainer);
 begin
   if aktprocsym^.definition^.deftype<>procvardef then
     aktprocsym^.definition^.setmangledname(target_os.Cprefix+realname);
+  { do not copy on local !! }
+  if (aktprocsym^.definition^.deftype=procdef) and
+     assigned(aktprocsym^.definition^.parast) then
+    aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}resetvaluepara);
 end;
 
 
@@ -1999,7 +2014,10 @@ end.
 
 {
   $Log$
-  Revision 1.55  2000-03-27 11:57:22  pierre
+  Revision 1.56  2000-03-31 22:56:47  pierre
+    * fix the handling of value parameters in cdecl function
+
+  Revision 1.55  2000/03/27 11:57:22  pierre
    * fix for bug 890
 
   Revision 1.54  2000/03/23 22:17:51  pierre