Fix for bug report 38549 about wrong code generation

for mips/mipsel and riscv32/riscv64 CPUs for 
  set operators '<=' and '>='.
  New tests for this bug report.
  tw38549.pp, main source, also included 
  by tw38549a.pp, tw38549b.pp, tw38459c.pp and tw38459d.pp
  with explicit {$packset X}, with X=1,2,4, or 8 added.

git-svn-id: trunk@48874 -

.gitattributes

@@ -18678,6 +18678,11 @@ tests/webtbs/tw38413.pp svneol=native#text/pascal
 tests/webtbs/tw38429.pp svneol=native#text/pascal
 tests/webtbs/tw38497.pp svneol=native#text/pascal
 tests/webtbs/tw38527.pp svneol=native#text/plain
+tests/webtbs/tw38549.pp svneol=native#text/plain
+tests/webtbs/tw38549a.pp svneol=native#text/plain
+tests/webtbs/tw38549b.pp svneol=native#text/plain
+tests/webtbs/tw38549c.pp svneol=native#text/plain
+tests/webtbs/tw38549d.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain

compiler/mips/ncpuadd.pas

@@ -36,7 +36,7 @@ type
   private
     procedure cmp64_lt(left_reg, right_reg: TRegister64;unsigned:boolean);
     procedure cmp64_le(left_reg, right_reg: TRegister64;unsigned:boolean);
-    procedure second_generic_cmp32(unsigned: boolean);
+    procedure second_generic_cmp32(unsigned,is_smallset: boolean);
     procedure second_mul64bit;
   protected
     procedure second_addfloat; override;
@@ -72,18 +72,31 @@ uses
                                tmipsaddnode
 *****************************************************************************}
 
-procedure tmipsaddnode.second_generic_cmp32(unsigned: boolean);
+procedure tmipsaddnode.second_generic_cmp32(unsigned,is_smallset: boolean);
 var
   cond: TOpCmp;
+  allow_constant : boolean;
+  dreg : tregister;
 begin
   pass_left_right;
-  force_reg_left_right(True, True);
+  allow_constant:=(not is_smallset) or not (nodetype in [lten,gten]);
+  force_reg_left_right(True, allow_constant);
   location_reset(location,LOC_FLAGS,OS_NO);
 
   cond:=cmpnode2topcmp(unsigned);
   if nf_swapped in flags then
     cond:=swap_opcmp(cond);
 
+  if is_smallset and (nodetype in [lten,gten]) then
+    begin
+      if ((nodetype=lten) and not (nf_swapped in flags)) or
+         ((nodetype=gten) and (nf_swapped in flags)) then
+        dreg:=right.location.register
+      else
+        dreg:=left.location.register;
+      current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,dreg,right.location.register,left.location.register));
+      cond:=OC_EQ;
+    end;
   location.resflags.cond:=cond;
   location.resflags.reg1:=left.location.register;
   location.resflags.use_const:=(right.location.loc=LOC_CONSTANT);
@@ -304,13 +317,13 @@ end;
 
 procedure tmipsaddnode.second_cmpboolean;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,false);
 end;
 
 
 procedure tmipsaddnode.second_cmpsmallset;
 begin
-  second_generic_cmp32(true);
+  second_generic_cmp32(true,true);
 end;
 
 
@@ -319,7 +332,7 @@ var
   unsigned: boolean;
 begin
   unsigned := not (is_signed(left.resultdef)) or not (is_signed(right.resultdef));
-  second_generic_cmp32(unsigned);
+  second_generic_cmp32(unsigned,false);
 end;
 
 

compiler/riscv/nrvadd.pas

@@ -34,7 +34,7 @@ unit nrvadd;
       trvaddnode = class(tcgaddnode)
         function pass_1: tnode; override;
       protected                            
-        procedure Cmp(signed: boolean);
+        procedure Cmp(signed,is_smallset: boolean);
 
         function use_mul_helper: boolean; override;
 
@@ -72,14 +72,17 @@ implementation
      low_value = {$ifdef CPU64BITALU} low(int64) {$else} low(longint) {$endif};
 {$endif}
 
-    procedure trvaddnode.Cmp(signed: boolean);
+    procedure trvaddnode.Cmp(signed,is_smallset: boolean);
       var
         flabel,tlabel: tasmlabel;
         op, opi: TAsmOp;
+        allow_constant : boolean;
       begin
         pass_left_right;
 
-        force_reg_left_right(true,true);
+        allow_constant:=(not is_smallset) or not (nodetype in [lten,gten]);
+
+        force_reg_left_right(true,allow_constant);
 
         if nf_swapped in flags then
           swapleftright;
@@ -164,13 +167,21 @@ implementation
               if (left.location.loc=LOC_CONSTANT) and
                  (not is_imm12(left.location.value)) then
                 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
-
+              if is_smallset then
+                begin
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,right.location.register,right.location.register,left.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_SUB,location.register,left.location.register,right.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end
+              else
+                begin
                   if left.location.loc=LOC_CONSTANT then
                     current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,right.location.register,left.location.value))
                   else
                     current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,right.location.register,left.location.register));
                   current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
                 end;
+            end;
           gten:
             begin
               if not (left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
@@ -179,13 +190,21 @@ implementation
               if (right.location.loc=LOC_CONSTANT) and
                  (not is_imm12(right.location.value)) then
                 hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,false);
-
+              if is_smallset then
+                begin
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_AND,left.location.register,right.location.register,left.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(A_SUB,location.register,left.location.register,right.location.register));
+                  current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
+                end
+              else
+                begin
                    if right.location.loc=LOC_CONSTANT then
                     current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,left.location.register,right.location.value))
                   else
                     current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,right.location.register));
                   current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(A_SLTIU,location.register,location.register,1));
                 end;
+            end;
         else
           Internalerror(2016061101);
         end;
@@ -205,7 +224,7 @@ implementation
 
     procedure trvaddnode.second_cmpsmallset;
       begin
-        Cmp(true);
+        Cmp(false,true);
       end;
 
 
@@ -216,7 +235,7 @@ implementation
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
-        Cmp(not unsigned);
+        Cmp(not unsigned,false);
       end;
 
 
@@ -227,7 +246,7 @@ implementation
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
-        Cmp(not unsigned);
+        Cmp(not unsigned,false);
       end;                  
 
 

tests/webtbs/tw38549.pp

@@ -0,0 +1,226 @@
+type
+
+{$ifdef SET_39}
+  {$define SET_31}
+{$endif}
+{$ifdef SET_31}
+  {$define SET_25}
+{$endif}
+{$ifdef SET_25}
+  {$define SET_23}
+{$endif}
+{$ifdef SET_23}
+  {$define SET_17}
+{$endif}
+{$ifdef SET_17}
+  {$define SET_15}
+{$endif}
+{$ifdef SET_15}
+  {$define SET_9}
+{$endif}
+
+  { options for symtables }
+  tsymtableoption = (
+    sto_has_helper,       { contains at least one helper symbol }
+    sto_has_generic,      { contains at least one generic symbol }
+    sto_has_operator,     { contains at least one operator overload }
+    sto_needs_init_final, { the symtable needs initialization and/or
+                            finalization of variables/constants }
+    sto_has_non_trivial_init, { contains at least on managed type that is not
+                               initialized to zero (e.g. a record with management
+                               operators }
+    sto_above
+{$ifdef SET_9}
+    ,sto_6
+    ,sto_7
+    ,sto_8
+    ,sto_9
+{$endif}
+{$ifdef SET_15}
+    ,sto_10
+    ,sto_11
+    ,sto_12
+    ,sto_13
+    ,sto_14
+    ,sto_15
+{$endif}
+{$ifdef SET_17}
+    ,sto_16
+    ,sto_17
+{$endif}
+{$ifdef SET_23}
+    ,sto_18
+    ,sto_19
+    ,sto_20
+    ,sto_21
+    ,sto_22
+    ,sto_23
+{$endif}
+{$ifdef SET_25}
+    ,sto_24
+    ,sto_25
+{$endif}
+{$ifdef SET_31}
+    ,sto_26
+    ,sto_27
+    ,sto_28
+    ,sto_29
+    ,sto_30
+    ,sto_31
+{$endif}
+{$ifdef SET_39}
+    ,sto_32
+    ,sto_33
+    ,sto_34
+    ,sto_35
+    ,sto_36
+    ,sto_37
+    ,sto_38
+    ,sto_39
+{$endif}
+  );
+  tsymtableoptions = set of tsymtableoption;
+
+const
+  ok_count : longint = 0;
+  error_count : longint = 0;
+
+procedure add_error;
+begin
+  writeln('New error');
+  inc(error_count);
+end; 
+
+procedure test(tableoptions : tsymtableoptions; expected : boolean);
+begin
+ if [sto_needs_init_final,sto_has_non_trivial_init] <= tableoptions then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end;
+ if tableoptions >= [sto_needs_init_final,sto_has_non_trivial_init] then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+procedure test2(tableoptions1, tableoptions2 : tsymtableoptions; expected : boolean);
+begin
+ if tableoptions1 <= tableoptions2 then
+   begin
+     if expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+ else
+   begin
+     if not expected then
+       begin
+         writeln('Ok');
+         inc(ok_count);
+       end
+     else
+       add_error;
+   end
+end;
+
+var
+  tableoptions1, tableoptions2 : tsymtableoptions;
+
+begin
+  tableoptions1:=[];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_has_non_trivial_init];
+  test(tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,true);
+
+  tableoptions1:=[sto_has_helper,sto_has_non_trivial_init,sto_above];
+  test(tableoptions1,false);
+
+  tableoptions1:=[];
+  tableoptions2:=[];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,true);
+
+  tableoptions2:=[sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_has_helper];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+  test2(tableoptions1,tableoptions1,true);
+  test2(tableoptions2,tableoptions2,true);
+
+  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  test2(tableoptions1,tableoptions2,true);
+  test2(tableoptions2,tableoptions1,false);
+
+  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
+  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_above];
+  test2(tableoptions1,tableoptions2,false);
+  test2(tableoptions2,tableoptions1,false);
+
+  writeln('Test for sets of size : ',sizeof(tableoptions1));
+  if error_count > 0 then
+    begin
+      writeln(error_count,' test(s) failed');
+      writeln(ok_count,' test(s) OK');
+      halt(1);
+    end
+  else
+    writeln('Test OK: ',ok_count);
+end.
+

tests/webtbs/tw38549a.pp

@@ -0,0 +1,5 @@
+
+{$packset 1}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549b.pp

@@ -0,0 +1,5 @@
+
+{$packset 2}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549c.pp

@@ -0,0 +1,5 @@
+
+{$packset 4}
+
+{$i tw38549.pp}
+

tests/webtbs/tw38549d.pp

@@ -0,0 +1,5 @@
+
+{$packset 8}
+
+{$i tw38549.pp}
+