* register calling is left-right

  * parameter ordering
  * left-right calling inserts result parameter last

compiler/i386/cpupara.pas

@@ -327,20 +327,51 @@ unit cpupara;
               paraloc.size:=def_cgsize(hp.paratype.def);
             paraloc.loc:=LOC_REFERENCE;
             paraloc.alignment:=paraalign;
-            paraloc.reference.index:=NR_FRAME_POINTER_REG;
+            if side=callerside then
+              paraloc.reference.index:=NR_STACK_POINTER_REG
+            else
+              paraloc.reference.index:=NR_FRAME_POINTER_REG;
             l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
-            varalign:=size_2_align(l);
-            paraloc.reference.offset:=parasize+target_info.first_parm_offset;
-            varalign:=used_align(varalign,paraalign,paraalign);
+            varalign:=used_align(size_2_align(l),paraalign,paraalign);
+            paraloc.reference.offset:=parasize;
             parasize:=align(parasize+l,varalign);
-            if (side=callerside) then
-              begin
-                paraloc.reference.index:=NR_STACK_POINTER_REG;
-                dec(paraloc.reference.offset,POINTER_SIZE);
-              end;
             hp.paraloc[side]:=paraloc;
             hp:=tparaitem(hp.next);
           end;
+        { Adapt offsets, for right-to-left calling we need to reverse the
+          offsets for the caller. For left-to-right calling we need to
+          reverse the offsets in the callee }
+        if (side=callerside) then
+          begin
+            if not(p.proccalloption in pushleftright_pocalls) then
+              begin
+                hp:=tparaitem(p.para.first);
+                while assigned(hp) do
+                  begin
+                    l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                    varalign:=used_align(size_2_align(l),paraalign,paraalign);
+                    l:=align(l,varalign);
+                    hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
+                    hp:=tparaitem(hp.next);
+                  end;
+              end;
+          end
+        else
+          begin
+            hp:=tparaitem(p.para.first);
+            while assigned(hp) do
+              begin
+                if (p.proccalloption in pushleftright_pocalls) then
+                  begin
+                    l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                    varalign:=used_align(size_2_align(l),paraalign,paraalign);
+                    l:=align(l,varalign);
+                    hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
+                  end;
+                inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
+                hp:=tparaitem(hp.next);
+              end;
+          end;
         { We need to return the size allocated }
         result:=parasize;
       end;
@@ -385,6 +416,7 @@ unit cpupara;
             if (parareg<=high(parasupregs)) and
                not(
                    is_64bit or
+                   (hp.paratype.def.deftype=floatdef) or
                    ((hp.paratype.def.deftype in [floatdef,recorddef,arraydef]) and
                     (not pushaddr))
                   ) then
@@ -401,22 +433,37 @@ unit cpupara;
             else
               begin
                 paraloc.loc:=LOC_REFERENCE;
-                paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                if side=callerside then
+                  paraloc.reference.index:=NR_STACK_POINTER_REG
+                else
+                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
                 l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
                 varalign:=size_2_align(l);
-                paraloc.reference.offset:=parasize+target_info.first_parm_offset;
+                paraloc.reference.offset:=parasize;
                 varalign:=used_align(varalign,paraalign,paraalign);
                 parasize:=align(parasize+l,varalign);
               end;
-            if (side=callerside) and
-               (paraloc.loc=LOC_REFERENCE) then
-              begin
-                paraloc.reference.index:=NR_STACK_POINTER_REG;
-                dec(paraloc.reference.offset,POINTER_SIZE);
-              end;
             hp.paraloc[side]:=paraloc;
             hp:=tparaitem(hp.next);
           end;
+        { Register parameters are assigned from left-to-right, adapt offset
+          for calleeside to be reversed }
+        if (side=calleeside) then
+          begin
+            hp:=tparaitem(p.para.first);
+            while assigned(hp) do
+              begin
+                if (hp.paraloc[side].loc=LOC_REFERENCE) then
+                  begin
+                    l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                    varalign:=used_align(size_2_align(l),paraalign,paraalign);
+                    l:=align(l,varalign);
+                    hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l+
+                        target_info.first_parm_offset;
+                  end;
+                hp:=tparaitem(hp.next);
+              end;
+          end;
         { We need to return the size allocated }
         result:=parasize;
       end;
@@ -450,7 +497,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2003-11-11 21:11:23  peter
+  Revision 1.44  2003-11-23 17:05:16  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.43  2003/11/11 21:11:23  peter
     * check for push_addr
 
   Revision 1.42  2003/10/19 01:34:30  florian

compiler/ncal.pas

@@ -75,6 +75,7 @@ interface
           _funcretnode    : tnode;
           procedure setfuncretnode(const returnnode: tnode);
           procedure convert_carg_array_of_const;
+          procedure order_parameters;
        public
           { the symbol containing the definition of the procedure }
           { to call                                               }
@@ -2335,6 +2336,68 @@ type
       end;
 
 
+    procedure tcallnode.order_parameters;
+      var
+        hp,hpcurr,hpnext,hpfirst,hpprev : tcallparanode;
+        currloc : tcgloc;
+      begin
+        hpfirst:=nil;
+        hpcurr:=tcallparanode(left);
+        while assigned(hpcurr) do
+          begin
+            { pull out }
+            hpnext:=tcallparanode(hpcurr.right);
+            { pull in at the correct place.
+              Used order:
+                1. LOC_REFERENCE with smallest offset (x86 only)
+                2. LOC_REFERENCE with most registers
+                3. LOC_REGISTER with most registers }
+            currloc:=hpcurr.paraitem.paraloc[callerside].loc;
+            hpprev:=nil;
+            hp:=hpfirst;
+            while assigned(hp) do
+              begin
+                case currloc of
+                  LOC_REFERENCE :
+                    begin
+                      case hp.paraitem.paraloc[callerside].loc of
+                        LOC_REFERENCE :
+                          begin
+                            if (hpcurr.registers32>hp.registers32)
+{$ifdef x86}
+                               or (hpcurr.paraitem.paraloc[callerside].reference.offset<hp.paraitem.paraloc[callerside].reference.offset)
+{$endif x86}
+                               then
+                              break;
+                          end;
+                        LOC_REGISTER,
+                        LOC_FPUREGISTER :
+                          break;
+                      end;
+                    end;
+                  LOC_FPUREGISTER,
+                  LOC_REGISTER :
+                    begin
+                      if (hp.paraitem.paraloc[callerside].loc=currloc) and
+                         (hpcurr.registers32>hp.registers32) then
+                        break;
+                    end;
+                end;
+                hpprev:=hp;
+                hp:=tcallparanode(hp.right);
+              end;
+            hpcurr.right:=hp;
+            if assigned(hpprev) then
+              hpprev.right:=hpcurr
+            else
+              hpfirst:=hpcurr;
+            { next }
+            hpcurr:=hpnext;
+          end;
+        left:=hpfirst;
+      end;
+
+
     function tcallnode.pass_1 : tnode;
 {$ifdef m68k}
       var
@@ -2345,10 +2408,24 @@ type
       begin
          result:=nil;
 
+         { calculate the parameter info for the procdef }
+         if not procdefinition.has_paraloc_info then
+           begin
+             paramanager.create_paraloc_info(procdefinition,callerside);
+             procdefinition.has_paraloc_info:=true;
+           end;
+
+         { calculate the parameter info for varargs }
+         if assigned(varargsparas) then
+           paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
+
          { work trough all parameters to get the register requirements }
          if assigned(left) then
            tcallparanode(left).det_registers;
 
+         { order parameters }
+         order_parameters;
+
          { function result node }
          if assigned(_funcretnode) then
            firstpass(_funcretnode);
@@ -2608,7 +2685,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.207  2003-11-10 22:02:52  peter
+  Revision 1.208  2003-11-23 17:05:15  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.207  2003/11/10 22:02:52  peter
     * cross unit inlining fixed
 
   Revision 1.206  2003/11/10 19:09:29  peter

compiler/ncgcal.pas

@@ -291,11 +291,6 @@ implementation
                 (nf_varargs_para in flags)) then
            internalerror(200304242);
 
-         { push from left to right if specified }
-         if assigned(right) and
-            (aktcallnode.procdefinition.proccalloption in pushleftright_pocalls) then
-           tcallparanode(right).secondcallparan;
-
          { Skip nothingn nodes which are used after disabling
            a parameter }
          if (left.nodetype<>nothingn) then
@@ -393,9 +388,8 @@ implementation
                location_copy(aktcallnode.location,left.location);
            end;
 
-         { push from right to left }
-         if assigned(right) and
-            not(aktcallnode.procdefinition.proccalloption in pushleftright_pocalls) then
+         { next parameter }
+         if assigned(right) then
            tcallparanode(right).secondcallparan;
       end;
 
@@ -667,20 +661,10 @@ implementation
          end;
 
       begin
-         if not assigned(procdefinition) then
+         if not assigned(procdefinition) or
+            not procdefinition.has_paraloc_info then
            internalerror(200305264);
 
-         { calculate the parameter info for the procdef }
-         if not procdefinition.has_paraloc_info then
-           begin
-             paramanager.create_paraloc_info(procdefinition,callerside);
-             procdefinition.has_paraloc_info:=true;
-           end;
-
-         { calculate the parameter info for varargs }
-         if assigned(varargsparas) then
-           paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
-
          if resulttype.def.needs_inittable and
             not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and
             not assigned(funcretnode) then
@@ -1138,7 +1122,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.139  2003-11-10 22:02:52  peter
+  Revision 1.140  2003-11-23 17:05:15  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.139  2003/11/10 22:02:52  peter
     * cross unit inlining fixed
 
   Revision 1.138  2003/11/07 15:58:32  florian

compiler/ncgutil.pas

@@ -1391,28 +1391,30 @@ implementation
             if (not is_void(current_procinfo.procdef.rettype.def)) and
                (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
               begin
-                if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc<>LOC_REFERENCE then
-                  internalerror(2003091812);
-                if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                  begin
-                    list.concat(Tai_stabs.Create(strpnew(
-                       '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
-                    if (m_result in aktmodeswitches) then
-                      list.concat(Tai_stabs.Create(strpnew(
-                         '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                         tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
-                  end
-                else
+                if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
                   begin
-                    list.concat(Tai_stabs.Create(strpnew(
-                       '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
-                    if (m_result in aktmodeswitches) then
-                      list.concat(Tai_stabs.Create(strpnew(
-                         '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                         tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
-                   end;
+{$warning Need to add gdb support for ret in param register calling}
+                    if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+                      begin
+                        list.concat(Tai_stabs.Create(strpnew(
+                           '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                           tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                        if (m_result in aktmodeswitches) then
+                          list.concat(Tai_stabs.Create(strpnew(
+                             '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                             tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
+                      end
+                    else
+                      begin
+                        list.concat(Tai_stabs.Create(strpnew(
+                           '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                           tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                        if (m_result in aktmodeswitches) then
+                          list.concat(Tai_stabs.Create(strpnew(
+                             '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                             tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                       end;
+                  end;
               end;
             mangled_length:=length(current_procinfo.procdef.mangledname);
             getmem(p,2*mangled_length+50);
@@ -1976,7 +1978,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.168  2003-11-22 00:31:25  jonas
+  Revision 1.169  2003-11-23 17:05:15  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.168  2003/11/22 00:31:25  jonas
     + extra allocations of function result regs for the optimiser
 
   Revision 1.167  2003/11/11 21:10:12  peter

compiler/pdecsub.pas

@@ -113,7 +113,11 @@ implementation
            include(vs.varoptions,vo_is_funcret);
            include(vs.varoptions,vo_regable);
            pd.parast.insert(vs);
-           pd.insertpara(vs.vartype,vs,nil,true);
+           { For left to right add it at the end to be delphi compatible }
+           if pd.proccalloption in pushleftright_pocalls then
+             pd.concatpara(nil,vs.vartype,vs,nil,true)
+           else
+             pd.insertpara(vs.vartype,vs,nil,true);
            { Store the this symbol as funcretsym for procedures }
            if pd.deftype=procdef then
             tprocdef(pd).funcretsym:=vs;
@@ -1773,9 +1777,6 @@ const
         { insert parentfp parameter if required }
         insert_parentfp_para(pd);
 
-        if pd.proccalloption=pocall_pascal then
-          tparaitem(pd.para.first):=reverseparaitems(tparaitem(pd.para.first));
-
         currpara:=tparaitem(pd.para.first);
         while assigned(currpara) do
          begin
@@ -2151,7 +2152,12 @@ const
 end.
 {
   $Log$
-  Revision 1.154  2003-11-12 15:49:06  peter
+  Revision 1.155  2003-11-23 17:05:15  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.154  2003/11/12 15:49:06  peter
     * virtual conflicts with override
 
   Revision 1.153  2003/11/10 19:09:29  peter

compiler/pdecvar.pas

@@ -186,11 +186,22 @@ implementation
                   the symbols of the types }
                 oldsymtablestack:=symtablestack;
                 symtablestack:=symtablestack.next;
-                read_type(tt,'',true);
+                read_type(tt,'',false);
                 symtablestack:=oldsymtablestack;
               end
              else
-              read_type(tt,'',true);
+              read_type(tt,'',false);
+             { Process procvar directives }
+             if (tt.def.deftype=procvardef) and
+                (tt.def.typesym=nil) and
+                is_proc_directive(token,true) then
+               begin
+                  newtype:=ttypesym.create('unnamed',tt);
+                  parse_var_proc_directives(tsym(newtype));
+                  newtype.restype.def:=nil;
+                  tt.def.typesym:=nil;
+                  newtype.free;
+               end;
              { types that use init/final are not allowed in variant parts, but
                classes are allowed }
              if (variantrecordlevel>0) and
@@ -373,10 +384,11 @@ implementation
                      consume(_SEMICOLON);
                    end;
                end;
-             { Parse procvar directives after ; }
+             { Add calling convention for procvars }
              if (tt.def.deftype=procvardef) and
                 (tt.def.typesym=nil) then
                begin
+                 { Parse procvar directives after ; }
                  if is_proc_directive(token,true) then
                    begin
                      newtype:=ttypesym.create('unnamed',tt);
@@ -387,7 +399,8 @@ implementation
                    end;
                  { Add calling convention for procvar }
                  handle_calling_convention(tprocvardef(tt.def));
-              end;
+                 calc_parast(tprocvardef(tt.def));
+               end;
              { Check for variable directives }
              if not symdone and (token=_ID) then
               begin
@@ -646,7 +659,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  2003-10-28 15:36:01  peter
+  Revision 1.58  2003-11-23 17:05:15  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.57  2003/10/28 15:36:01  peter
     * absolute to object field supported, fixes tb0458
 
   Revision 1.56  2003/10/05 12:55:37  peter

compiler/psub.pas

@@ -608,6 +608,7 @@ implementation
         oldaktmaxfpuregisters:=aktmaxfpuregisters;
 
         current_procinfo:=self;
+        aktfilepos:=entrypos;
 
         { get new labels }
         aktbreaklabel:=nil;
@@ -1314,7 +1315,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.172  2003-11-22 00:40:19  jonas
+  Revision 1.173  2003-11-23 17:05:16  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.172  2003/11/22 00:40:19  jonas
     * fixed optimiser so it compiles again
     * fixed several bugs which were in there already for a long time, but
       which only popped up now :) -O2/-O3 will now optimise less than in

compiler/symconst.pas

@@ -350,9 +350,7 @@ const
      pocall_cdecl,pocall_cppdecl,pocall_palmossyscall
    ];
 
-   pushleftright_pocalls = [
-     pocall_pascal
-   ];
+   pushleftright_pocalls : tproccalloptions = [pocall_register,pocall_pascal];
 
      SymTypeName : array[tsymtyp] of string[12] = (
        'abstractsym','variable','type','proc','unit',
@@ -374,10 +372,19 @@ const
 
 implementation
 
+initialization
+  if pocall_default in [pocall_register,pocall_internproc] then
+    include(pushleftright_pocalls,pocall_compilerproc);
+
 end.
 {
   $Log$
-  Revision 1.70  2003-11-07 15:58:32  florian
+  Revision 1.71  2003-11-23 17:05:16  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.70  2003/11/07 15:58:32  florian
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions

compiler/symsym.pas

@@ -1124,11 +1124,17 @@ implementation
              currpara:=tparaitem(currpara.next);
             if assigned(currpara) then
              begin
-               if (currpara.next=nil) and
-                  equal_defs(currpara.paratype.def,firstpara) then
+               if equal_defs(currpara.paratype.def,firstpara) then
                  begin
-                   search_procdef_unary_operator:=pd^.def;
-                   break;
+                   { This must be the last not hidden parameter }
+                   currpara:=tparaitem(currpara.next);
+                   while assigned(currpara) and (currpara.is_hidden) do
+                     currpara:=tparaitem(currpara.next);
+                   if currpara=nil then
+                     begin
+                       search_procdef_unary_operator:=pd^.def;
+                       break;
+                     end;
                  end;
              end;
             pd:=pd^.next;
@@ -2683,7 +2689,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.134  2003-10-30 16:23:13  peter
+  Revision 1.135  2003-11-23 17:05:16  peter
+    * register calling is left-right
+    * parameter ordering
+    * left-right calling inserts result parameter last
+
+  Revision 1.134  2003/10/30 16:23:13  peter
     * don't search for overloads in parents for constructors
 
   Revision 1.133  2003/10/29 21:56:28  peter