Ver código fonte

+ added inline nodes for handling and/or/xor in place (i.e. x:=x op y, where
op=and/or/xor). They generate more optimal code on certain architectures
(including x86). The new inline nodes aren't generated by the compiler yet,
but will be used in the future, at certain optimization levels, whenever the
pattern x:=x op y is detected by the compiler.

git-svn-id: trunk@35666 -

nickysn 8 anos atrás
pai
commit
fc59649a98

+ 2 - 0
.gitattributes

@@ -11469,6 +11469,7 @@ tests/test/cg/taddset2.pp svneol=native#text/plain
 tests/test/cg/taddset3.pp svneol=native#text/plain
 tests/test/cg/taddset4.pp svneol=native#text/plain
 tests/test/cg/tadint64.pp svneol=native#text/plain
+tests/test/cg/tandorxorassign1.pp svneol=native#text/plain
 tests/test/cg/tassign1.pp svneol=native#text/plain
 tests/test/cg/tassign2.pp svneol=native#text/plain
 tests/test/cg/tautom.pp svneol=native#text/plain
@@ -11597,6 +11598,7 @@ tests/test/cg/ttryfin4.pp svneol=native#text/plain
 tests/test/cg/ttryfin5.pp svneol=native#text/plain
 tests/test/cg/tumin.pp svneol=native#text/plain
 tests/test/cg/tvec.pp svneol=native#text/plain
+tests/test/cg/uandorxorassign.pp svneol=native#text/plain
 tests/test/cg/uprintf3.pp svneol=native#text/plain
 tests/test/cg/variants/ivarol10.pp svneol=native#text/plain
 tests/test/cg/variants/ivarol100.pp svneol=native#text/plain

+ 3 - 0
compiler/compinnr.inc

@@ -93,6 +93,9 @@ const
    in_delete_x_y_z      = 83;
    in_reset_typedfile_name   = 84;
    in_rewrite_typedfile_name = 85;
+   in_and_assign_x_y    = 86;
+   in_or_assign_x_y     = 87;
+   in_xor_assign_x_y    = 88;
 
 { Internal constant functions }
    in_const_sqr        = 100;

+ 75 - 0
compiler/ncginl.pas

@@ -35,6 +35,7 @@ interface
           procedure second_length;virtual;
           procedure second_predsucc;virtual;
           procedure second_incdec;virtual;
+          procedure second_AndOrXor_assign;virtual;
           procedure second_typeinfo;virtual;
           procedure second_includeexclude;virtual;
           procedure second_pi; virtual;
@@ -199,6 +200,10 @@ implementation
             in_fma_extended,
             in_fma_float128:
                second_fma;
+            in_and_assign_x_y,
+            in_or_assign_x_y,
+            in_xor_assign_x_y:
+               second_AndOrXor_assign;
             else internalerror(9);
          end;
       end;
@@ -417,6 +422,76 @@ implementation
         end;
 
 
+{*****************************************************************************
+                     AND/OR/XOR ASSIGN GENERIC HANDLING
+*****************************************************************************}
+      procedure tcginlinenode.second_AndOrXor_assign;
+        const
+          andorxorop:array[in_and_assign_x_y..in_xor_assign_x_y] of TOpCG=(OP_AND,OP_OR,OP_XOR);
+        var
+          maskvalue : TConstExprInt;
+          maskconstant : boolean;
+{$ifndef cpu64bitalu}
+          hregisterhi,
+{$endif not cpu64bitalu}
+          hregister : tregister;
+        begin
+          { set defaults }
+          maskconstant:=true;
+          hregister:=NR_NO;
+{$ifndef cpu64bitalu}
+          hregisterhi:=NR_NO;
+{$endif not cpu64bitalu}
+
+          { first secondpass first argument, because if the second arg }
+          { is used in that expression then SSL may move it to another }
+          { register                                                   }
+          secondpass(tcallparanode(left).left);
+          { load second parameter, must be a reference }
+          secondpass(tcallparanode(tcallparanode(left).right).left);
+
+          { when constant, just get the maskvalue }
+          if is_constintnode(tcallparanode(left).left) then
+             maskvalue:=get_ordinal_value(tcallparanode(left).left)
+          else
+            begin
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,tcallparanode(left).right.resultdef,true);
+              hregister:=tcallparanode(left).left.location.register;
+{$ifndef cpu64bitalu}
+              hregisterhi:=tcallparanode(left).left.location.register64.reghi;
+{$endif not cpu64bitalu}
+              maskconstant:=false;
+            end;
+          { write the and/or/xor instruction }
+          if maskconstant then
+            begin
+{$ifndef cpu64bitalu}
+              if def_cgsize(left.resultdef) in [OS_64,OS_S64] then
+                cg64.a_op64_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef),maskvalue,tcallparanode(tcallparanode(left).right).left.location)
+              else
+{$endif not cpu64bitalu}
+                hlcg.a_op_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef,
+{$ifdef cpu64bitalu}
+                  aint(maskvalue.svalue),
+{$else cpu64bitalu}
+                  longint(maskvalue.svalue),  // can't use aint, because it breaks 16-bit and 8-bit CPUs
+{$endif cpu64bitalu}
+                  tcallparanode(tcallparanode(left).right).left.location);
+            end
+           else
+             begin
+{$ifndef cpu64bitalu}
+               if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then
+                 cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef),
+                   joinreg64(hregister,hregisterhi),tcallparanode(tcallparanode(left).right).left.location)
+               else
+{$endif not cpu64bitalu}
+                 hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef,
+                   hregister,tcallparanode(tcallparanode(left).right).left.location);
+             end;
+        end;
+
+
 {*****************************************************************************
                          TYPEINFO GENERIC HANDLING
 *****************************************************************************}

+ 61 - 0
compiler/ninl.pas

@@ -90,6 +90,7 @@ interface
           function first_seg: tnode; virtual;
           function first_sar: tnode; virtual;
           function first_fma : tnode; virtual;
+          function first_AndOrXor_assign: tnode; virtual;
         private
           function handle_str: tnode;
           function handle_reset_rewrite_typed: tnode;
@@ -3020,6 +3021,52 @@ implementation
                     end;
                 end;
 
+              in_and_assign_x_y,
+              in_or_assign_x_y,
+              in_xor_assign_x_y:
+                begin
+                  resultdef:=voidtype;
+                  if not(df_generic in current_procinfo.procdef.defoptions) then
+                    begin
+                      { first parameter must exist }
+                      if not assigned(left) or (left.nodetype<>callparan) then
+                        internalerror(2017032501);
+                      { second parameter must exist }
+                      if not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype<>callparan) then
+                        internalerror(2017032502);
+                      { third parameter must NOT exist }
+                      if assigned(tcallparanode(tcallparanode(left).right).right) then
+                        internalerror(2017032503);
+
+                      valid_for_var(tcallparanode(tcallparanode(left).right).left,true);
+                      set_varstate(tcallparanode(tcallparanode(left).right).left,vs_readwritten,[vsf_must_be_valid]);
+
+                      if is_integer(tcallparanode(left).right.resultdef) then
+                        begin
+                          { value of right gets changed -> must be unique }
+                          set_unique(tcallparanode(tcallparanode(left).right).left);
+                          if is_integer(left.resultdef) then
+                            begin
+                              set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
+                              { these nodes shouldn't be created, when range checking is on }
+                              if [cs_check_range,cs_check_overflow]*current_settings.localswitches<>[] then
+                                internalerror(2017032701);
+                              inserttypeconv(tcallparanode(left).left,tcallparanode(tcallparanode(left).right).left.resultdef);
+                            end
+                          else
+                            CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
+                        end
+                      { generic type parameter? }
+                      else if is_typeparam(tcallparanode(left).right.resultdef) then
+                        begin
+                          result:=cnothingnode.create;
+                          exit;
+                        end
+                      else
+                        CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
+                    end;
+                end;
+
               in_read_x,
               in_readln_x,
               in_readstr_x,
@@ -3543,6 +3590,13 @@ implementation
               result:=first_IncDec;
             end;
 
+          in_and_assign_x_y,
+          in_or_assign_x_y,
+          in_xor_assign_x_y:
+            begin
+              result:=first_AndOrXor_assign;
+            end;
+
          in_include_x_y,
          in_exclude_x_y:
            begin
@@ -4557,5 +4611,12 @@ implementation
          result:=nil;
        end;
 
+
+     function tinlinenode.first_AndOrXor_assign: tnode;
+       begin
+         result:=nil;
+         expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
+       end;
+
 end.
 

+ 3 - 0
rtl/inc/innr.inc

@@ -94,6 +94,9 @@ const
    fpc_in_delete_x_y_z      = 83;
    fpc_in_reset_typedfile_name   = 84;
    fpc_in_rewrite_typedfile_name = 85;
+   fpc_in_and_assign_x_y   = 86;
+   fpc_in_or_assign_x_y    = 87;
+   fpc_in_xor_assign_x_y   = 88;
 
 { Internal constant functions }
    fpc_in_const_sqr        = 100;

+ 336 - 0
tests/test/cg/tandorxorassign1.pp

@@ -0,0 +1,336 @@
+program tandorxorassign1;
+
+uses
+  uandorxorassign;
+
+{$R-,Q-}
+
+procedure Check(Value, ExpectedValue: QWord);
+begin
+  if Value <> ExpectedValue then
+  begin
+    Writeln('Error!');
+    Halt(1);
+  end;
+end;
+
+var
+  gr: record
+    b, b2: Byte;
+    w, w2: Word;
+    d, d2: DWord;
+    q, q2: QWord;
+  end;
+
+procedure Test_And_Ref_Const;
+begin
+  gr.b := $5A;
+  AndAssignByte(gr.b, $4F);
+  Check(gr.b, $4A);
+
+  gr.w := $5A7E;
+  AndAssignWord(gr.w, $4F23);
+  Check(gr.w, $4A22);
+
+  gr.d := $5A7EFF44;
+  AndAssignDWord(gr.d, $4F23E768);
+  Check(gr.d, $4A22E740);
+
+  gr.q := $5A7EFF4455AAFF00;
+  AndAssignQWord(gr.q, $4F23E7680FF05A78);
+  Check(gr.q, $4A22E74005A05A00);
+end;
+
+procedure Test_And_Ref_Ref;
+begin
+  gr.b := $5A;
+  gr.b2 := $4F;
+  AndAssignByte(gr.b, gr.b2);
+  Check(gr.b, $4A);
+
+  gr.w := $5A7E;
+  gr.w2 := $4F23;
+  AndAssignWord(gr.w, gr.w2);
+  Check(gr.w, $4A22);
+
+  gr.d := $5A7EFF44;
+  gr.d2 := $4F23E768;
+  AndAssignDWord(gr.d, gr.d2);
+  Check(gr.d, $4A22E740);
+
+  gr.q := $5A7EFF4455AAFF00;
+  gr.q2 := $4F23E7680FF05A78;
+  AndAssignQWord(gr.q, gr.q2);
+  Check(gr.q, $4A22E74005A05A00);
+end;
+
+procedure Test_And_RegVar_Const;
+var
+  b: Byte;
+  w: Word;
+  d: DWord;
+  q: QWord;
+begin
+  b := $5A;
+  AndAssignByte(b, $4F);
+  Check(b, $4A);
+
+  w := $5A7E;
+  AndAssignWord(w, $4F23);
+  Check(w, $4A22);
+
+  d := $5A7EFF44;
+  AndAssignDWord(d, $4F23E768);
+  Check(d, $4A22E740);
+
+  q := $5A7EFF4455AAFF00;
+  AndAssignQWord(q, $4F23E7680FF05A78);
+  Check(q, $4A22E74005A05A00);
+end;
+
+procedure Test_And_RegVar_RegVar;
+var
+  b, b2: Byte;
+  w, w2: Word;
+  d, d2: DWord;
+  q, q2: QWord;
+begin
+  b := $5A;
+  b2 := $4F;
+  AndAssignByte(b, b2);
+  Check(b, $4A);
+
+  w := $5A7E;
+  w2 := $4F23;
+  AndAssignWord(w, w2);
+  Check(w, $4A22);
+
+  d := $5A7EFF44;
+  d2 := $4F23E768;
+  AndAssignDWord(d, d2);
+  Check(d, $4A22E740);
+
+  q := $5A7EFF4455AAFF00;
+  q2 := $4F23E7680FF05A78;
+  AndAssignQWord(q, q2);
+  Check(q, $4A22E74005A05A00);
+end;
+
+procedure Test_Or_Ref_Const;
+begin
+  gr.b := $5A;
+  OrAssignByte(gr.b, $4F);
+  Check(gr.b, $5F);
+
+  gr.w := $5A7E;
+  OrAssignWord(gr.w, $4F23);
+  Check(gr.w, $5F7F);
+
+  gr.d := $5A7EFF44;
+  OrAssignDWord(gr.d, $4F23E768);
+  Check(gr.d, $5F7FFF6C);
+
+  gr.q := $5A7EFF4455AAFF00;
+  OrAssignQWord(gr.q, $4F23E7680FF05A78);
+  Check(gr.q, $5F7FFF6C5FFAFF78);
+end;
+
+procedure Test_Or_Ref_Ref;
+begin
+  gr.b := $5A;
+  gr.b2 := $4F;
+  OrAssignByte(gr.b, gr.b2);
+  Check(gr.b, $5F);
+
+  gr.w := $5A7E;
+  gr.w2 := $4F23;
+  OrAssignWord(gr.w, gr.w2);
+  Check(gr.w, $5F7F);
+
+  gr.d := $5A7EFF44;
+  gr.d2 := $4F23E768;
+  OrAssignDWord(gr.d, gr.d2);
+  Check(gr.d, $5F7FFF6C);
+
+  gr.q := $5A7EFF4455AAFF00;
+  gr.q2 := $4F23E7680FF05A78;
+  OrAssignQWord(gr.q, gr.q2);
+  Check(gr.q, $5F7FFF6C5FFAFF78);
+end;
+
+procedure Test_Or_RegVar_Const;
+var
+  b: Byte;
+  w: Word;
+  d: DWord;
+  q: QWord;
+begin
+  b := $5A;
+  OrAssignByte(b, $4F);
+  Check(b, $5F);
+
+  w := $5A7E;
+  OrAssignWord(w, $4F23);
+  Check(w, $5F7F);
+
+  d := $5A7EFF44;
+  OrAssignDWord(d, $4F23E768);
+  Check(d, $5F7FFF6C);
+
+  q := $5A7EFF4455AAFF00;
+  OrAssignQWord(q, $4F23E7680FF05A78);
+  Check(q, $5F7FFF6C5FFAFF78);
+end;
+
+procedure Test_Or_RegVar_RegVar;
+var
+  b, b2: Byte;
+  w, w2: Word;
+  d, d2: DWord;
+  q, q2: QWord;
+begin
+  b := $5A;
+  b2 := $4F;
+  OrAssignByte(b, b2);
+  Check(b, $5F);
+
+  w := $5A7E;
+  w2 := $4F23;
+  OrAssignWord(w, w2);
+  Check(w, $5F7F);
+
+  d := $5A7EFF44;
+  d2 := $4F23E768;
+  OrAssignDWord(d, d2);
+  Check(d, $5F7FFF6C);
+
+  q := $5A7EFF4455AAFF00;
+  q2 := $4F23E7680FF05A78;
+  OrAssignQWord(q, q2);
+  Check(q, $5F7FFF6C5FFAFF78);
+end;
+
+procedure Test_Xor_Ref_Const;
+begin
+  gr.b := $5A;
+  XorAssignByte(gr.b, $4F);
+  Check(gr.b, $15);
+
+  gr.w := $5A7E;
+  XorAssignWord(gr.w, $4F23);
+  Check(gr.w, $155D);
+
+  gr.d := $5A7EFF44;
+  XorAssignDWord(gr.d, $4F23E768);
+  Check(gr.d, $155D182C);
+
+  gr.q := $5A7EFF4455AAFF00;
+  XorAssignQWord(gr.q, $4F23E7680FF05A78);
+  Check(gr.q, $155D182C5A5AA578);
+end;
+
+procedure Test_Xor_Ref_Ref;
+begin
+  gr.b := $5A;
+  gr.b2 := $4F;
+  XorAssignByte(gr.b, gr.b2);
+  Check(gr.b, $15);
+
+  gr.w := $5A7E;
+  gr.w2 := $4F23;
+  XorAssignWord(gr.w, gr.w2);
+  Check(gr.w, $155D);
+
+  gr.d := $5A7EFF44;
+  gr.d2 := $4F23E768;
+  XorAssignDWord(gr.d, gr.d2);
+  Check(gr.d, $155D182C);
+
+  gr.q := $5A7EFF4455AAFF00;
+  gr.q2 := $4F23E7680FF05A78;
+  XorAssignQWord(gr.q, gr.q2);
+  Check(gr.q, $155D182C5A5AA578);
+end;
+
+procedure Test_Xor_RegVar_Const;
+var
+  b: Byte;
+  w: Word;
+  d: DWord;
+  q: QWord;
+begin
+  b := $5A;
+  XorAssignByte(b, $4F);
+  Check(b, $15);
+
+  w := $5A7E;
+  XorAssignWord(w, $4F23);
+  Check(w, $155D);
+
+  d := $5A7EFF44;
+  XorAssignDWord(d, $4F23E768);
+  Check(d, $155D182C);
+
+  q := $5A7EFF4455AAFF00;
+  XorAssignQWord(q, $4F23E7680FF05A78);
+  Check(q, $155D182C5A5AA578);
+end;
+
+procedure Test_Xor_RegVar_RegVar;
+var
+  b, b2: Byte;
+  w, w2: Word;
+  d, d2: DWord;
+  q, q2: QWord;
+begin
+  b := $5A;
+  b2 := $4F;
+  XorAssignByte(b, b2);
+  Check(b, $15);
+
+  w := $5A7E;
+  w2 := $4F23;
+  XorAssignWord(w, w2);
+  Check(w, $155D);
+
+  d := $5A7EFF44;
+  d2 := $4F23E768;
+  XorAssignDWord(d, d2);
+  Check(d, $155D182C);
+
+  q := $5A7EFF4455AAFF00;
+  q2 := $4F23E7680FF05A78;
+  XorAssignQWord(q, q2);
+  Check(q, $155D182C5A5AA578);
+end;
+
+begin
+  Writeln('Testing And(Ref, Const)');
+  Test_And_Ref_Const;
+  Writeln('Testing And(Ref, Ref)');
+  Test_And_Ref_Ref;
+  Writeln('Testing And(RegVar, Const)');
+  Test_And_RegVar_Const;
+  Writeln('Testing And(RegVar, RegVar)');
+  Test_And_RegVar_RegVar;
+
+  Writeln('Testing Or(Ref, Const)');
+  Test_Or_Ref_Const;
+  Writeln('Testing Or(Ref, Ref)');
+  Test_Or_Ref_Ref;
+  Writeln('Testing Or(RegVar, Const)');
+  Test_Or_RegVar_Const;
+  Writeln('Testing Or(RegVar, RegVar)');
+  Test_Or_RegVar_RegVar;
+
+  Writeln('Testing Xor(Ref, Const)');
+  Test_Xor_Ref_Const;
+  Writeln('Testing Xor(Ref, Ref)');
+  Test_Xor_Ref_Ref;
+  Writeln('Testing Xor(RegVar, Const)');
+  Test_Xor_RegVar_Const;
+  Writeln('Testing Xor(RegVar, RegVar)');
+  Test_Xor_RegVar_RegVar;
+
+  Writeln('Ok!');
+end.

+ 27 - 0
tests/test/cg/uandorxorassign.pp

@@ -0,0 +1,27 @@
+unit uandorxorassign;
+
+interface
+
+const
+   fpc_in_and_assign_x_y   = 86;
+   fpc_in_or_assign_x_y    = 87;
+   fpc_in_xor_assign_x_y   = 88;
+
+procedure AndAssignByte(var X: Byte; Const Mask: Byte);[internproc:fpc_in_and_assign_x_y];
+procedure AndAssignWord(var X: Word; Const Mask: Word);[internproc:fpc_in_and_assign_x_y];
+procedure AndAssignDWord(var X: DWord; Const Mask: DWord);[internproc:fpc_in_and_assign_x_y];
+procedure AndAssignQWord(var X: QWord; Const Mask: QWord);[internproc:fpc_in_and_assign_x_y];
+
+procedure OrAssignByte(var X: Byte; Const Mask: Byte);[internproc:fpc_in_or_assign_x_y];
+procedure OrAssignWord(var X: Word; Const Mask: Word);[internproc:fpc_in_or_assign_x_y];
+procedure OrAssignDWord(var X: DWord; Const Mask: DWord);[internproc:fpc_in_or_assign_x_y];
+procedure OrAssignQWord(var X: QWord; Const Mask: QWord);[internproc:fpc_in_or_assign_x_y];
+
+procedure XorAssignByte(var X: Byte; Const Mask: Byte);[internproc:fpc_in_xor_assign_x_y];
+procedure XorAssignWord(var X: Word; Const Mask: Word);[internproc:fpc_in_xor_assign_x_y];
+procedure XorAssignDWord(var X: DWord; Const Mask: DWord);[internproc:fpc_in_xor_assign_x_y];
+procedure XorAssignQWord(var X: QWord; Const Mask: QWord);[internproc:fpc_in_xor_assign_x_y];
+
+implementation
+
+end.