2
0
Эх сурвалжийг харах

* fixed several sparc alignment issues
+ Jonas' inline node patch; non functional yet

florian 21 жил өмнө
parent
commit
6368652be2

+ 7 - 3
compiler/aasmtai.pas

@@ -182,9 +182,9 @@ interface
       { please keep the size of this record <=12 bytes and keep it properly aligned }
       { please keep the size of this record <=12 bytes and keep it properly aligned }
       toper = record
       toper = record
         ot : longint;
         ot : longint;
-{$ifdef cpuarm}
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
         dummy1,dummy2,dummy3 : byte;
         dummy1,dummy2,dummy3 : byte;
-{$endif cpuarm}
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
         case typ : toptype of
         case typ : toptype of
           top_none   : ();
           top_none   : ();
           top_reg    : (reg:tregister);
           top_reg    : (reg:tregister);
@@ -2217,7 +2217,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.86  2004-06-20 08:55:28  florian
+  Revision 1.87  2004-08-14 14:50:42  florian
+    * fixed several sparc alignment issues
+    + Jonas' inline node patch; non functional yet
+
+  Revision 1.86  2004/06/20 08:55:28  florian
     * logs truncated
     * logs truncated
 
 
   Revision 1.85  2004/06/16 20:07:06  florian
   Revision 1.85  2004/06/16 20:07:06  florian

+ 174 - 36
compiler/ncal.pas

@@ -50,6 +50,10 @@ interface
 
 
        tcallnode = class(tbinarynode)
        tcallnode = class(tbinarynode)
        private
        private
+{$ifndef VER1_0}
+          { info for inlining }
+          inlinelocals: array of tnode;
+{$endif VER1_0}
           { number of parameters passed from the source, this does not include the hidden parameters }
           { number of parameters passed from the source, this does not include the hidden parameters }
           paralength   : smallint;
           paralength   : smallint;
           function  gen_self_tree_methodpointer:tnode;
           function  gen_self_tree_methodpointer:tnode;
@@ -66,6 +70,9 @@ interface
 
 
           procedure createinlineparas(var createstatement, deletestatement: tstatementnode);
           procedure createinlineparas(var createstatement, deletestatement: tstatementnode);
           function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
           function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
+{$ifndef VER1_0}
+          procedure createlocaltemps(p:TNamedIndexItem;arg:pointer);
+{$endif VER1_0}
        protected
        protected
           pushedparasize : longint;
           pushedparasize : longint;
        public
        public
@@ -1847,8 +1854,10 @@ type
     function tcallnode.replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
     function tcallnode.replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
       var
       var
         paras: tcallparanode;
         paras: tcallparanode;
+        temp: tnode;
       begin
       begin
         result := fen_false;
         result := fen_false;
+        n.fileinfo := pfileposinfo(arg)^;
         if (n.nodetype = loadn) then
         if (n.nodetype = loadn) then
           begin
           begin
             paras := tcallparanode(left);
             paras := tcallparanode(left);
@@ -1861,9 +1870,86 @@ type
                 n := paras.left.getcopy;
                 n := paras.left.getcopy;
                 resulttypepass(n);
                 resulttypepass(n);
                 result := fen_true;
                 result := fen_true;
+              end
+{$ifndef VER1_0}
+            else
+              begin
+                { local? }
+                if (tloadnode(n).symtableentry.typ <> varsym) or
+                   (tloadnode(n).symtableentry.owner <> tprocdef(procdefinition).localst) then
+                  exit;
+                if (tloadnode(n).symtableentry.indexnr > high(inlinelocals)) or
+                   not assigned(inlinelocals[tloadnode(n).symtableentry.indexnr]) then
+                  internalerror(20040720);
+                temp := inlinelocals[tloadnode(n).symtableentry.indexnr].getcopy;
+                n.free;
+                n := temp;
+                resulttypepass(n);
+                result := fen_true;
+              end;
+{$endif ndef VER1_0}
+          end;
+      end;
+
+
+{$ifndef VER1_0}
+      type
+        ptempnodes = ^ttempnodes;
+        ttempnodes = record
+          createstatement, deletestatement: tstatementnode;
+        end;
+
+    procedure tcallnode.createlocaltemps(p:TNamedIndexItem;arg:pointer);
+      var
+        tempinfo: ptempnodes absolute ptempnodes(arg);
+        tempnode: ttempcreatenode;
+      begin
+        if (tsymentry(p).typ <> varsym) then
+          exit;
+        if (p.indexnr > high(inlinelocals)) then
+          setlength(inlinelocals,p.indexnr+10);
+{$ifndef VER1_0}
+        if (vo_is_funcret in tvarsym(p).varoptions) and
+           assigned(funcretnode) then
+          begin
+            if node_complexity(funcretnode) > 1 then
+              begin
+                { can this happen? }
+                { we may have to replace the funcretnode with the address of funcretnode }
+                { loaded in a temp in this case, because the expression may e.g. contain }
+                { a global variable that gets changed inside the function                }
+                internalerror(2004072101);
+              end;
+            inlinelocals[tvarsym(p).indexnr] := funcretnode.getcopy
+          end
+        else
+{$endif ndef VER1_0}
+          begin
+            if (cs_regvars in aktglobalswitches) and
+               (([vo_regable{$ifndef x86},vo_fpuregable{$endif}] * tvarsym(p).varoptions) <> []) and
+               (not tvarsym(p).vartype.def.needs_inittable) then
+              tempnode := ctempcreatenode.create_reg(tvarsym(p).vartype,tvarsym(p).vartype.def.size,tt_persistent)
+            else
+              tempnode := ctempcreatenode.create(tvarsym(p).vartype,tvarsym(p).vartype.def.size,tt_persistent);
+            addstatement(tempinfo^.createstatement,tempnode);
+            if assigned(tvarsym(p).defaultconstsym) then
+              begin
+                { warning: duplicate from psub.pas:initializevars() -> must refactor }
+                addstatement(tempinfo^.createstatement,cassignmentnode.create(
+                                  ctemprefnode.create(tempnode),
+                                  cloadnode.create(tvarsym(p).defaultconstsym,tvarsym(p).defaultconstsym.owner)));
               end;
               end;
+            if (vo_is_funcret in tvarsym(p).varoptions) then
+              begin
+                funcretnode := ctemprefnode.create(tempnode);
+                addstatement(tempinfo^.deletestatement,ctempdeletenode.create_normal_temp(tempnode));
+              end
+            else
+              addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
+            inlinelocals[p.indexnr] := ctemprefnode.create(tempnode);
           end;
           end;
       end;
       end;
+{$endif ndef VER1_0}
 
 
 
 
     procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode);
     procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode);
@@ -1871,46 +1957,84 @@ type
         para: tcallparanode;
         para: tcallparanode;
         tempnode: ttempcreatenode;
         tempnode: ttempcreatenode;
         hp: tnode;
         hp: tnode;
+{$ifndef VER1_0}
+        tempnodes: ttempnodes;
+{$endif ndef VER1_0}
       begin
       begin
         { parameters }
         { parameters }
         para := tcallparanode(left);
         para := tcallparanode(left);
         while assigned(para) do
         while assigned(para) do
           begin
           begin
-            { create temps for value parameters, and also for const parameters }
-            { which are passed by value instead of by reference                }
-            if (para.paraitem.paratyp = vs_value) or
-               ((para.paraitem.paratyp = vs_const) and
-                not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption)) then
-              begin
-                if (cs_regvars in aktglobalswitches) and
-                   (([vo_regable,vo_fpuregable] * tvarsym(para.paraitem.parasym).varoptions) <> []) and
-                   (not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
-                  tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
-                else
-                  tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
-                addstatement(createstatement,tempnode);
-                addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
-                  para.left));
-                para.left := ctemprefnode.create(tempnode);
-                addstatement(deletestatement,ctempdeletenode.create(tempnode));
-              end
-            else if node_complexity(para.left) > 1 then
+            if (para.paraitem.parasym.typ = varsym) and
+               { para.left will already be the same as funcretnode in the following case, so don't change }
+               (not(vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) or
+                (not assigned(funcretnode))) then
               begin
               begin
-                if (cs_regvars in aktglobalswitches) and
-                   not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable then
-                  tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
-                else
-                  tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
-                addstatement(createstatement,tempnode);
-                addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
-                  caddrnode.create(para.left)));
-                hp := cderefnode.create(ctemprefnode.create(tempnode));
-                inserttypeconv_explicit(hp,para.left.resulttype);
-                para.left := hp;
-                addstatement(deletestatement,ctempdeletenode.create(tempnode));
+                { create temps for value parameters, function result and also for    }
+                { const parameters which are passed by value instead of by reference }
+                if (vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) or
+                   (para.paraitem.paratyp = vs_value) or
+                   ((para.paraitem.paratyp = vs_const) and
+                    (not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption) or
+                    { the problem is that we can't take the address of a function result :( }
+                     (node_complexity(para.left) >= NODE_COMPLEXITY_INF))) then
+                  begin
+                    if (cs_regvars in aktglobalswitches) and
+                       (([vo_regable,vo_fpuregable] * tvarsym(para.paraitem.parasym).varoptions) <> []) and
+                       (not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
+                      tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
+                    else
+                      tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
+                    addstatement(createstatement,tempnode);
+                    { assign the value of the parameter to the temp, except in case of the function result }
+                    { (in that case, para.left is a block containing the creation of a new temp, while we  }
+                    {  only need a temprefnode, so delete the old stuff)                                   }
+                    if not(vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) then
+                      begin
+                        addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
+                          para.left));
+                        para.left := ctemprefnode.create(tempnode);
+                        addstatement(deletestatement,ctempdeletenode.create(tempnode));
+                      end
+                    else
+                      begin
+                        if not(assigned(funcretnode)) then
+                          funcretnode := ctemprefnode.create(tempnode);
+                        para.left.free;
+                        para.left := ctemprefnode.create(tempnode);
+                        addstatement(deletestatement,ctempdeletenode.create_normal_temp(tempnode));
+                      end
+                  end
+                else if node_complexity(para.left) > 1 then
+                  begin
+                    if (cs_regvars in aktglobalswitches) and
+                       not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable then
+                      tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
+                    else
+                      tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
+                    addstatement(createstatement,tempnode);
+                    addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
+                      caddrnode.create(para.left)));
+                    hp := cderefnode.create(ctemprefnode.create(tempnode));
+                    inserttypeconv_explicit(hp,para.left.resulttype);
+                    para.left := hp;
+                    addstatement(deletestatement,ctempdeletenode.create(tempnode));
+                  end;
+                para := tcallparanode(para.right);
               end;
               end;
-            para := tcallparanode(para.right);
           end;
           end;
+{$ifndef VER1_0}
+        { local variables }
+        if not assigned(tprocdef(procdefinition).localst) or
+           (tprocdef(procdefinition).localst.symindex.count = 0) then
+          exit;
+        tempnodes.createstatement := createstatement;
+        tempnodes.deletestatement := deletestatement;
+        setlength(inlinelocals,tprocdef(procdefinition).localst.symindex.count);
+        tprocdef(procdefinition).localst.foreach({$ifdef FPCPROCVAR}@{$endif}createlocaltemps,@tempnodes);
+        createstatement := tempnodes.createstatement;
+        deletestatement := tempnodes.deletestatement;
+{$endif ndef VER1_0}
       end;
       end;
 
 
 
 
@@ -1918,11 +2042,12 @@ type
       var
       var
         createstatement,deletestatement: tstatementnode;
         createstatement,deletestatement: tstatementnode;
         createblock,deleteblock: tblocknode;
         createblock,deleteblock: tblocknode;
+        i: longint;
       label
       label
         errorexit;
         errorexit;
       begin
       begin
          result:=nil;
          result:=nil;
-
+{!!!!!!!!
          if (procdefinition.proccalloption=pocall_inline) and
          if (procdefinition.proccalloption=pocall_inline) and
             { can we inline this procedure at the node level? }
             { can we inline this procedure at the node level? }
             (tprocdef(procdefinition).inlininginfo^.inlinenode) then
             (tprocdef(procdefinition).inlininginfo^.inlinenode) then
@@ -1948,9 +2073,18 @@ type
                   { replace complex parameters with temps }
                   { replace complex parameters with temps }
                   createinlineparas(createstatement,deletestatement);
                   createinlineparas(createstatement,deletestatement);
                   { replace the parameter loads with the parameter values }
                   { replace the parameter loads with the parameter values }
-                  foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,pointer(funcretnode));
+                  foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,@fileinfo);
+                  { free the temps for the locals }
+                  for i := 0 to high(inlinelocals) do
+                    if assigned(inlinelocals[i]) then
+                      inlinelocals[i].free;
+                  setlength(inlinelocals,0);
                   addstatement(createstatement,result);
                   addstatement(createstatement,result);
                   addstatement(createstatement,deleteblock);
                   addstatement(createstatement,deleteblock);
+                  { set function result location if necessary }
+                  if assigned(funcretnode) and
+                     (cnf_return_value_used in callnodeflags) then
+                    addstatement(createstatement,funcretnode.getcopy);
                   result := createblock;
                   result := createblock;
                   { consider it must not be inlined if called
                   { consider it must not be inlined if called
                     again inside the args or itself }
                     again inside the args or itself }
@@ -1960,7 +2094,7 @@ type
                   exit;
                   exit;
                 end;
                 end;
            end;
            end;
-
+}
          { calculate the parameter info for the procdef }
          { calculate the parameter info for the procdef }
          if not procdefinition.has_paraloc_info then
          if not procdefinition.has_paraloc_info then
            begin
            begin
@@ -2258,7 +2392,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.243  2004-07-16 19:45:15  jonas
+  Revision 1.244  2004-08-14 14:50:42  florian
+    * fixed several sparc alignment issues
+    + Jonas' inline node patch; non functional yet
+
+  Revision 1.243  2004/07/16 19:45:15  jonas
     + temps can now also hold fpu values in registers (take care with use,
     + temps can now also hold fpu values in registers (take care with use,
       bacause of the x86 fpu stack)
       bacause of the x86 fpu stack)
     * fpu parameters to node-inlined procedures can now also be put in
     * fpu parameters to node-inlined procedures can now also be put in

+ 12 - 13
compiler/psub.pas

@@ -155,11 +155,14 @@ implementation
                  tvarsym(p).vartype.def.needs_inittable then
                  tvarsym(p).vartype.def.needs_inittable then
                 include(current_procinfo.flags,pi_needs_implicit_finally);
                 include(current_procinfo.flags,pi_needs_implicit_finally);
             end;
             end;
+{
+          must be done at the end of the program, not at the end of the procedure
           typedconstsym :
           typedconstsym :
             begin
             begin
               if ttypedconstsym(p).typedconsttype.def.needs_inittable then
               if ttypedconstsym(p).typedconsttype.def.needs_inittable then
                 include(current_procinfo.flags,pi_needs_implicit_finally);
                 include(current_procinfo.flags,pi_needs_implicit_finally);
             end;
             end;
+}
         end;
         end;
       end;
       end;
 
 
@@ -969,23 +972,15 @@ implementation
       begin
       begin
         result := false;
         result := false;
         if not assigned(procdef.inlininginfo^.code) or
         if not assigned(procdef.inlininginfo^.code) or
-           (po_assembler in procdef.procoptions) or
-            { no locals }
-            (tprocdef(procdef).localst.symsearch.count <> 0) or
-            { procedure, not function }
-            (not is_void(procdef.rettype.def)) then
+           (po_assembler in procdef.procoptions) then
           exit;
           exit;
         paraitem:=tparaitem(procdef.para.first);
         paraitem:=tparaitem(procdef.para.first);
 
 
-        { all call by reference parameters, or parameters which don't }
-        { get a new value? }
-        { also note: in theory, if there are only value parameters and none of those  }
-        {   are changed, we could also inline the paras. However, the compiler does   }
-        {   not distinguish between "used but not changed" and "used and changed"     }
-        {   (both are represented by vs_used), so that this not yet possible to do    }
         while assigned(paraitem) do
         while assigned(paraitem) do
           begin
           begin
-            { we can't handle formaldefs, valuepara's which get a new value and special arrays }
+            { we can't handle formaldefs and special arrays (the latter may need a    }
+            { re-basing of the index, i.e. if you pass an array[1..10] as open array, }
+            { you have to add 1 to all index operations if you directly inline it     }
             if ((paraitem.paratyp in [vs_out,vs_var]) and
             if ((paraitem.paratyp in [vs_out,vs_var]) and
                 (paraitem.paratype.def.deftype=formaldef)) or
                 (paraitem.paratype.def.deftype=formaldef)) or
                is_special_array(paraitem.paratype.def)  then
                is_special_array(paraitem.paratype.def)  then
@@ -1428,7 +1423,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.202  2004-07-16 21:11:31  jonas
+  Revision 1.203  2004-08-14 14:50:42  florian
+    * fixed several sparc alignment issues
+    + Jonas' inline node patch; non functional yet
+
+  Revision 1.202  2004/07/16 21:11:31  jonas
     - disable node-based inlining of routines with special array parameters
     - disable node-based inlining of routines with special array parameters
       for now (de indexes of open arrays have to be changed, because on the
       for now (de indexes of open arrays have to be changed, because on the
       caller-side these routines are not necessarily 0-based)
       caller-side these routines are not necessarily 0-based)

+ 10 - 2
compiler/sparc/cpubase.pas

@@ -224,7 +224,11 @@ type
         References are given from the caller's point of view. The usual
         References are given from the caller's point of view. The usual
         TLocation isn't used, because contains a lot of unnessary fields.
         TLocation isn't used, because contains a lot of unnessary fields.
       }
       }
-      tparalocation = packed record
+      tparalocation =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
          Size : TCGSize;
          Size : TCGSize;
          { The location type where the parameter is passed, usually
          { The location type where the parameter is passed, usually
            LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
            LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
@@ -567,7 +571,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.68  2004-07-26 04:00:35  mazen
+  Revision 1.69  2004-08-14 14:50:42  florian
+    * fixed several sparc alignment issues
+    + Jonas' inline node patch; non functional yet
+
+  Revision 1.68  2004/07/26 04:00:35  mazen
   * fix compile problem
   * fix compile problem
 
 
   Revision 1.67  2004/06/20 08:55:32  florian
   Revision 1.67  2004/06/20 08:55:32  florian

+ 10 - 2
compiler/symdef.pas

@@ -455,7 +455,11 @@ interface
 {$ifdef i386}
 {$ifdef i386}
           fpu_used        : byte;    { how many stack fpu must be empty }
           fpu_used        : byte;    { how many stack fpu must be empty }
 {$endif i386}
 {$endif i386}
-          funcret_paraloc : packed array[tcallercallee] of tparalocation;
+          funcret_paraloc :
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+            packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+            array[tcallercallee] of tparalocation;
           has_paraloc_info : boolean; { paraloc info is available }
           has_paraloc_info : boolean; { paraloc info is available }
           constructor create(level:byte);
           constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           constructor ppuload(ppufile:tcompilerppufile);
@@ -6146,7 +6150,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.249  2004-08-07 14:52:45  florian
+  Revision 1.250  2004-08-14 14:50:42  florian
+    * fixed several sparc alignment issues
+    + Jonas' inline node patch; non functional yet
+
+  Revision 1.249  2004/08/07 14:52:45  florian
     * fixed web bug 3226: type p = type pointer;
     * fixed web bug 3226: type p = type pointer;
 
 
   Revision 1.248  2004/07/19 19:15:50  florian
   Revision 1.248  2004/07/19 19:15:50  florian