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

* generic fpc_shorstr_concat
+ fpc_shortstr_append_shortstr optimization

peter 22 жил өмнө
parent
commit
0799b0663d

+ 11 - 63
compiler/i386/n386add.pas

@@ -331,25 +331,16 @@ interface
         { special cases for shortstrings, handled in pass_2 (JM) }
         { special cases for shortstrings, handled in pass_2 (JM) }
         { can't handle fpc_shortstr_compare with compilerproc either because it }
         { can't handle fpc_shortstr_compare with compilerproc either because it }
         { returns its results in the flags instead of in eax                    }
         { returns its results in the flags instead of in eax                    }
-        if (nodetype = addn) and
-           is_shortstring(resulttype.def) then
+        if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
+           is_shortstring(left.resulttype.def) and
+           not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
+              ((right.nodetype=stringconstn) and (str_length(right)=0))) then
          begin
          begin
-           expectloc:=LOC_REFERENCE;
+           expectloc:=LOC_FLAGS;
            calcregisters(self,0,0,0);
            calcregisters(self,0,0,0);
            result := nil;
            result := nil;
            exit;
            exit;
-         end
-        else
-         if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
-            is_shortstring(left.resulttype.def) and
-            not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
-               ((right.nodetype=stringconstn) and (str_length(right)=0))) then
-          begin
-            expectloc:=LOC_FLAGS;
-            calcregisters(self,0,0,0);
-            result := nil;
-            exit;
-          end;
+         end;
         { otherwise, use the generic code }
         { otherwise, use the generic code }
         result := inherited first_addstring;
         result := inherited first_addstring;
       end;
       end;
@@ -358,10 +349,8 @@ interface
     procedure ti386addnode.second_addstring;
     procedure ti386addnode.second_addstring;
 
 
       var
       var
-        href       : treference;
         cmpop      : boolean;
         cmpop      : boolean;
         pushed     : Tpushedsavedint;
         pushed     : Tpushedsavedint;
-        regstopush : Tsupregset;
       begin
       begin
         { string operations are not commutative }
         { string operations are not commutative }
         if nf_swaped in flags then
         if nf_swaped in flags then
@@ -370,51 +359,6 @@ interface
            st_shortstring:
            st_shortstring:
              begin
              begin
                 case nodetype of
                 case nodetype of
-                   addn:
-                     begin
-                        cmpop:=false;
-                        secondpass(left);
-                        { if str_concat is set in expr
-                          s:=s+ ... no need to create a temp string (PM) }
-                        { the tempstring can also come from a typeconversion }
-                        { or a function result, so simply check for a        }
-                        { temp of 256 bytes(JM)                                          }
-                        if not(tg.istemp(left.location.reference) and
-                               (tg.SizeOfTemp(exprasmlist,left.location.reference) = 256)) and
-                           not(nf_use_strconcat in flags) then
-                          begin
-                             tg.GetTemp(exprasmlist,256,tt_normal,href);
-                             cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
-                             { location is released by copyshortstring }
-                             location_freetemp(exprasmlist,left.location);
-
-                             location_reset(left.location,LOC_REFERENCE,def_cgsize(resulttype.def));
-                             left.location.reference:=href;
-                          end;
-
-                        secondpass(right);
-
-                        { on the right we do not need the register anymore too }
-                        { Instead of releasing them already, simply do not }
-                        { push them (so the release is in the right place, }
-                        { because emitpushreferenceaddr doesn't need extra }
-                        { registers) (JM)                                  }
-                        regstopush := all_intregisters;
-                        remove_non_regvars_from_loc(right.location,regstopush);
-                        rg.saveusedintregisters(exprasmlist,pushed,regstopush);
-                        { push the maximum possible length of the result }
-                        cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
-                        { the optimizer can more easily put the          }
-                        { deallocations in the right place if it happens }
-                        { too early than when it happens too late (if    }
-                        { the pushref needs a "lea (..),edi; push edi")  }
-                        location_release(exprasmlist,right.location);
-                        cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
-                        rg.saveintregvars(exprasmlist,regstopush);
-                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
-                        tg.ungetiftemp(exprasmlist,right.location.reference);
-                        rg.restoreusedintregisters(exprasmlist,pushed);
-                     end;
                    ltn,lten,gtn,gten,equaln,unequaln :
                    ltn,lten,gtn,gten,equaln,unequaln :
                      begin
                      begin
                        cmpop := true;
                        cmpop := true;
@@ -1663,7 +1607,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.67  2003-05-22 21:32:29  peter
+  Revision 1.68  2003-05-26 19:38:28  peter
+    * generic fpc_shorstr_concat
+    + fpc_shortstr_append_shortstr optimization
+
+  Revision 1.67  2003/05/22 21:32:29  peter
     * removed some unit dependencies
     * removed some unit dependencies
 
 
   Revision 1.66  2003/04/26 09:12:55  peter
   Revision 1.66  2003/04/26 09:12:55  peter

+ 6 - 7
compiler/nadd.pas

@@ -1296,11 +1296,6 @@ implementation
         case nodetype of
         case nodetype of
           addn:
           addn:
             begin
             begin
-              { note: if you implemented an fpc_shortstr_concat similar to the    }
-              { one in i386.inc, you have to override first_addstring like in     }
-              { ti386addnode.first_string and implement the shortstring concat    }
-              { manually! The generic routine is different from the i386 one (JM) }
-
               { create the call to the concat routine both strings as arguments }
               { create the call to the concat routine both strings as arguments }
               result := ccallnode.createintern('fpc_'+
               result := ccallnode.createintern('fpc_'+
                 tstringdef(resulttype.def).stringtypname+'_concat',
                 tstringdef(resulttype.def).stringtypname+'_concat',
@@ -1958,7 +1953,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.89  2003-05-24 21:12:57  florian
+  Revision 1.90  2003-05-26 19:38:28  peter
+    * generic fpc_shorstr_concat
+    + fpc_shortstr_append_shortstr optimization
+
+  Revision 1.89  2003/05/24 21:12:57  florian
     * if something doesn't work with callparatemp, the define callparatemp
     * if something doesn't work with callparatemp, the define callparatemp
       should be used because other processors with reigster calling conventions
       should be used because other processors with reigster calling conventions
       depend on this as well
       depend on this as well
@@ -2179,4 +2178,4 @@ end.
       with string operations
       with string operations
     * adapted some routines to use the new cg methods
     * adapted some routines to use the new cg methods
 
 
-}
+}

+ 8 - 1
compiler/ncgld.pas

@@ -728,6 +728,9 @@ implementation
               secondpass(hp.left);
               secondpass(hp.left);
               if codegenerror then
               if codegenerror then
                exit;
                exit;
+              { Move flags and jump in register }
+              if hp.left.location.loc in [LOC_FLAGS,LOC_JUMP] then
+                location_force_reg(exprasmlist,hp.left.location,def_cgsize(hp.left.resulttype.def),false);
               if dovariant then
               if dovariant then
                begin
                begin
                  { find the correct vtype value }
                  { find the correct vtype value }
@@ -919,7 +922,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.61  2003-05-24 11:47:27  jonas
+  Revision 1.62  2003-05-26 19:38:28  peter
+    * generic fpc_shorstr_concat
+    + fpc_shortstr_append_shortstr optimization
+
+  Revision 1.61  2003/05/24 11:47:27  jonas
     * fixed framepointer storage: it's now always stored at r1+12, which is
     * fixed framepointer storage: it's now always stored at r1+12, which is
       a place in the link area reserved for compiler use.
       a place in the link area reserved for compiler use.
 
 

+ 37 - 1
compiler/nld.pas

@@ -628,6 +628,38 @@ implementation
                     exit;
                     exit;
                  end;
                  end;
               end;
               end;
+          end
+        else
+         if is_shortstring(left.resulttype.def) then
+          begin
+            { fold <shortstring>:=<shortstring>+<shortstring>,
+              <shortstring>+<char> is handled by an optimized node }
+            if (right.nodetype=addn) and
+               left.isequal(tbinarynode(right).left) and
+               { don't fold multiple concatenations else we could get trouble
+                 with multiple uses of s }
+               (tbinarynode(right).left.nodetype<>addn) and
+               (tbinarynode(right).right.nodetype<>addn) then
+              begin
+                { don't do a resulttypepass(right), since then the addnode }
+                { may insert typeconversions that make this optimization   }
+                { opportunity quite difficult to detect (JM)               }
+                resulttypepass(tbinarynode(right).left);
+                resulttypepass(tbinarynode(right).right);
+                if is_shortstring(tbinarynode(right).right.resulttype.def) then
+                  begin
+                    { remove property flag so it'll not trigger an error }
+                    exclude(left.flags,nf_isproperty);
+                    { generate call to helper }
+                    hp:=ccallparanode.create(tbinarynode(right).right,
+                      ccallparanode.create(left,nil));
+                    if is_shortstring(tbinarynode(right).right.resulttype.def) then
+                      result:=ccallnode.createintern('fpc_shortstr_append_shortstr',hp);
+                    tbinarynode(right).right:=nil;
+                    left:=nil;
+                    exit;
+                 end;
+              end;
           end;
           end;
 
 
         resulttypepass(right);
         resulttypepass(right);
@@ -1213,7 +1245,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.95  2003-05-23 17:05:13  peter
+  Revision 1.96  2003-05-26 19:38:28  peter
+    * generic fpc_shorstr_concat
+    + fpc_shortstr_append_shortstr optimization
+
+  Revision 1.95  2003/05/23 17:05:13  peter
     * loadn procsym need to return procdef
     * loadn procsym need to return procdef
 
 
   Revision 1.94  2003/05/23 14:27:35  peter
   Revision 1.94  2003/05/23 14:27:35  peter