* basics for x86 register calling

compiler/defcmp.pas

@@ -813,7 +813,8 @@ implementation
              begin
                { object pascal objects }
                if (def_from.deftype=objectdef) and
-                 tobjectdef(def_from).is_related(tobjectdef(def_to)) then
+                  (tobjectdef(def_from).is_related(tobjectdef(def_to)) or
+                   tobjectdef(def_to).is_related(tobjectdef(def_from))) then
                 begin
                   doconv:=tc_equal;
                   eq:=te_convert_l1;
@@ -1209,7 +1210,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2003-06-03 21:02:08  peter
+  Revision 1.28  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.27  2003/06/03 21:02:08  peter
     * allow pointer(int64) in all modes
 
   Revision 1.26  2003/05/26 21:17:17  peter

compiler/i386/cpupara.pas

@@ -51,6 +51,10 @@ unit cpupara;
           function getparaloc(p : tdef) : tcgloc;
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
           function getselflocation(p : tabstractprocdef) : tparalocation;override;
+       private
+          procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+          procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+          procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
@@ -174,29 +178,10 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+    procedure ti386paramanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       var
-        hp : tparaitem;
         paraloc : tparalocation;
       begin
-        hp:=tparaitem(p.para.first);
-        while assigned(hp) do
-          begin
-            if hp.paratyp in [vs_var,vs_out] then
-              paraloc.size:=OS_ADDR
-            else
-              paraloc.size:=def_cgsize(hp.paratype.def);
-            paraloc.loc:=LOC_REFERENCE;
-            if assigned(current_procinfo) then
-              paraloc.reference.index:=current_procinfo.framepointer
-            else
-              paraloc.reference.index:=NR_FRAME_POINTER_REG;
-            paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
-            hp.paraloc[side]:=paraloc;
-{$warning callerparaloc shall not be the same as calleeparaloc}
-            hp:=tparaitem(hp.next);
-          end;
-
         { Function return }
         fillchar(paraloc,sizeof(tparalocation),0);
         paraloc.size:=def_cgsize(p.rettype.def);
@@ -231,6 +216,89 @@ unit cpupara;
       end;
 
 
+    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+      var
+        hp : tparaitem;
+        paraloc : tparalocation;
+      begin
+        hp:=tparaitem(p.para.first);
+        while assigned(hp) do
+          begin
+            if hp.paratyp in [vs_var,vs_out] then
+              paraloc.size:=OS_ADDR
+            else
+              paraloc.size:=def_cgsize(hp.paratype.def);
+            paraloc.loc:=LOC_REFERENCE;
+            if assigned(current_procinfo) then
+              paraloc.reference.index:=current_procinfo.framepointer
+            else
+              paraloc.reference.index:=NR_FRAME_POINTER_REG;
+            paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
+            hp.paraloc[side]:=paraloc;
+{$warning callerparaloc shall not be the same as calleeparaloc}
+            hp:=tparaitem(hp.next);
+          end;
+      end;
+
+
+    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+      var
+        hp : tparaitem;
+        paraloc : tparalocation;
+        sr : tsuperregister;
+        subreg : tsubregister;
+      begin
+        sr:=RS_EAX;
+        hp:=tparaitem(p.para.first);
+        while assigned(hp) do
+          begin
+            if hp.paratyp in [vs_var,vs_out] then
+              paraloc.size:=OS_ADDR
+            else
+              paraloc.size:=def_cgsize(hp.paratype.def);
+            {
+              EAX
+              EDX
+              ECX
+              Stack
+              Stack
+            }
+            if sr<=NR_ECX then
+              begin
+                paraloc.loc:=LOC_REGISTER;
+                if paraloc.size=OS_NO then
+                  subreg:=R_SUBWHOLE
+                else
+                  subreg:=cgsize2subreg(paraloc.size);
+                paraloc.register:=newreg(R_INTREGISTER,sr,subreg);
+                inc(sr);
+              end
+            else
+              begin
+                paraloc.loc:=LOC_REFERENCE;
+                if assigned(current_procinfo) then
+                  paraloc.reference.index:=current_procinfo.framepointer
+                else
+                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
+              end;
+            hp.paraloc[side]:=paraloc;
+{$warning callerparaloc shall not be the same as calleeparaloc}
+            hp:=tparaitem(hp.next);
+          end;
+      end;
+
+
+    procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        if p.proccalloption=pocall_register then
+          create_register_paraloc_info(p,side)
+        else
+          create_stdcall_paraloc_info(p,side);
+        create_funcret_paraloc_info(p,side);
+      end;
+
+
     function ti386paramanager.getselflocation(p : tabstractprocdef) : tparalocation;
       var
         hsym : tvarsym;
@@ -250,7 +318,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2003-09-09 15:55:05  peter
+  Revision 1.27  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.26  2003/09/09 15:55:05  peter
     * winapi doesn't like pushing 8 byte record
 
   Revision 1.25  2003/09/08 18:28:51  peter

compiler/i386/cpupi.pas

@@ -35,6 +35,7 @@ unit cpupi;
        ti386procinfo = class(tcgprocinfo)
           procedure allocate_interrupt_parameter;override;
           procedure allocate_framepointer_reg;override;
+          procedure handle_body_start;override;
        end;
 
 
@@ -64,12 +65,21 @@ unit cpupi;
       end;
 
 
+    procedure ti386procinfo.handle_body_start;
+      begin
+        inherited handle_body_start;
+      end;
+
+
 begin
    cprocinfo:=ti386procinfo;
 end.
 {
   $Log$
-  Revision 1.10  2003-09-03 15:55:01  peter
+  Revision 1.11  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.10  2003/09/03 15:55:01  peter
     * NEWRA branch merged
 
   Revision 1.9.2.1  2003/08/31 15:46:26  peter

compiler/pdecsub.pas

@@ -1699,7 +1699,8 @@ const
             end;
           pocall_register :
             begin
-              Message1(parser_w_proc_directive_ignored,'REGISTER');
+              { Adjust alignment to match cdecl or stdcall }
+              pd.parast.dataalignment:=std_param_align;
             end;
           pocall_far16 :
             begin
@@ -1758,6 +1759,11 @@ const
       var
         currpara : tparaitem;
         st : tsymtable;
+{$ifdef i386}
+        orgs : stringid;
+        vs : tvarsym;
+        n : integer;
+{$endif i386}
       begin
         { insert hidden high parameters }
         insert_hidden_para(pd);
@@ -1766,6 +1772,41 @@ const
         { insert funcret parameter if required }
         insert_funcret_para(pd);
 
+{$ifdef i386}
+        { Move first 3 register parameters in localst }
+        if (pd.deftype=procdef) and
+           (pd.proccalloption=pocall_register) and
+           not(po_assembler in pd.procoptions) and
+           assigned(pd.para.first) then
+          begin
+            { insert copy in localst }
+            if not assigned(tprocdef(pd).localst) then
+              tprocdef(pd).insert_localst;
+            n:=0;
+            currpara:=tparaitem(pd.para.first);
+            while assigned(currpara) and (n<3) do
+             begin
+               orgs:=currpara.parasym.realname;
+               if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
+                 internalerror(200304232);
+               { rename parameter in parast }
+               pd.parast.rename(currpara.parasym.name,'reg'+currpara.parasym.name);
+               include(tvarsym(currpara.parasym).varoptions,vo_is_reg_para);
+               vs:=tvarsym.create(orgs,currpara.paratyp,currpara.paratype);
+               vs.varoptions:=tvarsym(currpara.parasym).varoptions;
+               include(vs.varoptions,vo_is_reg_para);
+               tprocdef(pd).localst.insert(vs);
+               tprocdef(pd).localst.insertvardata(vs);
+               { update currpara }
+               currpara.parasym:=vs;
+               { next }
+               currpara:=tparaitem(currpara.next);
+               inc(n);
+             end;
+          end;
+
+{$endif i386}
+
         if (pd.deftype=procdef) then
          begin
            { rename value parameters that need a local copy to valXXX,
@@ -1796,7 +1837,8 @@ const
                begin
                  if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
                    internalerror(200304232);
-                 st.insertvardata(currpara.parasym);
+                 if not(vo_is_reg_para in tvarsym(currpara.parasym).varoptions) then
+                   st.insertvardata(currpara.parasym);
                  currpara:=tparaitem(currpara.next);
                end;
             end;
@@ -2148,7 +2190,10 @@ const
 end.
 {
   $Log$
-  Revision 1.132  2003-09-09 15:54:10  peter
+  Revision 1.133  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.132  2003/09/09 15:54:10  peter
     * calling convention fix
 
   Revision 1.131  2003/09/07 22:09:35  peter

compiler/symconst.pas

@@ -256,7 +256,8 @@ type
     vo_is_funcret,
     vo_is_self,
     vo_is_vmt,
-    vo_is_result  { special result variable }
+    vo_is_result,  { special result variable }
+    vo_is_reg_para  { register parameter, no space allocation in parast, but in localst }
   );
   tvaroptions=set of tvaroption;
 
@@ -373,7 +374,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.62  2003-09-09 15:54:10  peter
+  Revision 1.63  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.62  2003/09/09 15:54:10  peter
     * calling convention fix
 
   Revision 1.61  2003/09/07 22:09:35  peter

compiler/x86/cgx86.pas

@@ -356,24 +356,33 @@ unit cgx86;
     procedure tcgx86.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
       begin
         check_register_size(size,r);
-        case size of
-          OS_8,OS_S8,
-          OS_16,OS_S16:
+        case locpara.loc of
+          LOC_REGISTER :
+            cg.a_load_reg_reg(list,size,locpara.size,r,locpara.register);
+          LOC_REFERENCE :
             begin
-              if target_info.alignment.paraalign = 2 then
-                r:=rg.makeregsize(r,OS_16)
-              else
-                r:=rg.makeregsize(r,OS_32);
-              list.concat(taicpu.op_reg(A_PUSH,S_L,r));
+              case size of
+                OS_8,OS_S8,
+                OS_16,OS_S16:
+                  begin
+                    if target_info.alignment.paraalign = 2 then
+                      r:=rg.makeregsize(r,OS_16)
+                    else
+                      r:=rg.makeregsize(r,OS_32);
+                    list.concat(taicpu.op_reg(A_PUSH,S_L,r));
+                  end;
+                OS_32,OS_S32:
+                  begin
+                    if getsubreg(r)<>R_SUBD then
+                      internalerror(7843);
+                    list.concat(taicpu.op_reg(A_PUSH,S_L,r));
+                  end
+                else
+                  internalerror(2002032212);
+              end;
             end;
-          OS_32,OS_S32:
-            begin
-              if getsubreg(r)<>R_SUBD then
-                internalerror(7843);
-              list.concat(taicpu.op_reg(A_PUSH,S_L,r));
-            end
           else
-            internalerror(2002032212);
+            internalerror(200309082);
         end;
       end;
 
@@ -381,18 +390,27 @@ unit cgx86;
     procedure tcgx86.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
 
       begin
-        case size of
-          OS_8,OS_S8,OS_16,OS_S16:
+        case locpara.loc of
+          LOC_REGISTER :
+            cg.a_load_const_reg(list,locpara.size,a,locpara.register);
+          LOC_REFERENCE :
             begin
-              if target_info.alignment.paraalign = 2 then
-                list.concat(taicpu.op_const(A_PUSH,S_W,a))
-              else
-                list.concat(taicpu.op_const(A_PUSH,S_L,a));
+              case size of
+                OS_8,OS_S8,OS_16,OS_S16:
+                  begin
+                    if target_info.alignment.paraalign = 2 then
+                      list.concat(taicpu.op_const(A_PUSH,S_W,a))
+                    else
+                      list.concat(taicpu.op_const(A_PUSH,S_L,a));
+                  end;
+                OS_32,OS_S32:
+                  list.concat(taicpu.op_const(A_PUSH,S_L,a));
+                else
+                  internalerror(2002032213);
+              end;
             end;
-          OS_32,OS_S32:
-            list.concat(taicpu.op_const(A_PUSH,S_L,a));
           else
-            internalerror(2002032213);
+            internalerror(200309082);
         end;
       end;
 
@@ -404,58 +422,91 @@ unit cgx86;
         tmpreg : tregister;
 
       begin
-        case size of
-          OS_8,OS_S8,
-          OS_16,OS_S16:
+        case locpara.loc of
+          LOC_REGISTER :
+            cg.a_load_ref_reg(list,size,locpara.size,r,locpara.register);
+          LOC_REFERENCE :
             begin
-              if target_info.alignment.paraalign = 2 then
-                pushsize:=OS_16
-              else
-                pushsize:=OS_32;
-              tmpreg:=rg.getregisterint(list,pushsize);
-              a_load_ref_reg(list,size,pushsize,r,tmpreg);
-              list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
-              rg.ungetregisterint(list,tmpreg);
+              case size of
+                OS_8,OS_S8,
+                OS_16,OS_S16:
+                  begin
+                    if target_info.alignment.paraalign = 2 then
+                      pushsize:=OS_16
+                    else
+                      pushsize:=OS_32;
+                    tmpreg:=rg.getregisterint(list,pushsize);
+                    a_load_ref_reg(list,size,pushsize,r,tmpreg);
+                    list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
+                    rg.ungetregisterint(list,tmpreg);
+                  end;
+                OS_32,OS_S32:
+                  list.concat(taicpu.op_ref(A_PUSH,S_L,r));
+{$ifdef cpu64bit}
+                OS_64,OS_S64:
+                  list.concat(taicpu.op_ref(A_PUSH,S_Q,r));
+{$endif cpu64bit}
+                else
+                  internalerror(2002032214);
+              end;
             end;
-          OS_32,OS_S32:
-            list.concat(taicpu.op_ref(A_PUSH,S_L,r));
-          OS_64,OS_S64:
-            list.concat(taicpu.op_ref(A_PUSH,S_Q,r));
           else
-            internalerror(2002032214);
+            internalerror(200309083);
         end;
       end;
 
 
     procedure tcgx86.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
       var
-        tmpreg: tregister;
-        baseno,indexno:boolean;
+        tmpreg : tregister;
       begin
         if (r.segment<>NR_NO) then
           CGMessage(cg_e_cant_use_far_pointer_there);
-        baseno:=(r.base=NR_NO);
-        indexno:=(r.index=NR_NO);
-        if baseno and indexno then
-          begin
-            if assigned(r.symbol) then
-              list.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,r.symbol,r.offset))
-            else
-              list.concat(Taicpu.Op_const(A_PUSH,S_L,r.offset));
-          end
-        else if baseno and not indexno and
-                (r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
-          list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.index))
-        else if not baseno and indexno and
-                (r.offset=0) and (r.symbol=nil) then
-          list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
-        else
-          begin
-            tmpreg:=rg.getaddressregister(list);
-            a_loadaddr_ref_reg(list,r,tmpreg);
-            list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
-            rg.ungetregisterint(list,tmpreg);
-          end;
+        case locpara.loc of
+          LOC_REGISTER :
+            begin
+              if (r.base=NR_NO) and (r.index=NR_NO) then
+                 begin
+                   if assigned(r.symbol) then
+                     list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,r.symbol,r.offset,locpara.register))
+                   else
+                     a_load_const_reg(list,OS_INT,r.offset,locpara.register);
+                 end
+               else if (r.base=NR_NO) and (r.index<>NR_NO) and
+                       (r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
+                 a_load_reg_reg(list,OS_INT,OS_INT,r.index,locpara.register)
+               else if (r.base<>NR_NO) and (r.index=NR_NO) and
+                       (r.offset=0) and (r.symbol=nil) then
+                 a_load_reg_reg(list,OS_INT,OS_INT,r.base,locpara.register)
+               else
+                 a_loadaddr_ref_reg(list,r,locpara.register);
+            end;
+          LOC_REFERENCE :
+            begin
+              if (r.base=NR_NO) and (r.index=NR_NO) then
+                 begin
+                   if assigned(r.symbol) then
+                     list.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,r.symbol,r.offset))
+                   else
+                     list.concat(Taicpu.Op_const(A_PUSH,S_L,r.offset));
+                 end
+               else if (r.base=NR_NO) and (r.index<>NR_NO) and
+                       (r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
+                 list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.index))
+               else if (r.base<>NR_NO) and (r.index=NR_NO) and
+                       (r.offset=0) and (r.symbol=nil) then
+                 list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
+               else
+                 begin
+                   tmpreg:=rg.getaddressregister(list);
+                   a_loadaddr_ref_reg(list,r,tmpreg);
+                   list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
+                   rg.ungetregisterint(list,tmpreg);
+                 end;
+            end;
+          else
+            internalerror(200309084);
+        end;
       end;
 
 
@@ -1572,7 +1623,10 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.62  2003-09-09 20:59:27  daniel
+  Revision 1.63  2003-09-09 21:03:17  peter
+    * basics for x86 register calling
+
+  Revision 1.62  2003/09/09 20:59:27  daniel
     * Adding register allocation order
 
   Revision 1.61  2003/09/07 22:09:35  peter