From 01a351f804430a1c8ed701bbb945736c3750b88f Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 3 Mar 2021 22:15:20 +0000 Subject: [PATCH] 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 | 5 + compiler/mips/ncpuadd.pas | 25 ++++- compiler/riscv/nrvadd.pas | 51 ++++++--- tests/webtbs/tw38549.pp | 226 ++++++++++++++++++++++++++++++++++++++ tests/webtbs/tw38549a.pp | 5 + tests/webtbs/tw38549b.pp | 5 + tests/webtbs/tw38549c.pp | 5 + tests/webtbs/tw38549d.pp | 5 + 8 files changed, 305 insertions(+), 22 deletions(-) create mode 100644 tests/webtbs/tw38549.pp create mode 100644 tests/webtbs/tw38549a.pp create mode 100644 tests/webtbs/tw38549b.pp create mode 100644 tests/webtbs/tw38549c.pp create mode 100644 tests/webtbs/tw38549d.pp diff --git a/.gitattributes b/.gitattributes index c7bca25d5f..086f92634d 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/mips/ncpuadd.pas b/compiler/mips/ncpuadd.pas index 0554620030..0edbf04d8a 100644 --- a/compiler/mips/ncpuadd.pas +++ b/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; diff --git a/compiler/riscv/nrvadd.pas b/compiler/riscv/nrvadd.pas index 734aa6d09a..ec10feade3 100644 --- a/compiler/riscv/nrvadd.pas +++ b/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,12 +167,20 @@ 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 left.location.loc=LOC_CONSTANT then - current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,right.location.register,left.location.value)) + 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 - 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)); + 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 @@ -179,12 +190,20 @@ 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 right.location.loc=LOC_CONSTANT then - current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_const(opi,location.register,left.location.register,right.location.value)) + 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 - 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)); + 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); @@ -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; diff --git a/tests/webtbs/tw38549.pp b/tests/webtbs/tw38549.pp new file mode 100644 index 0000000000..7661598702 --- /dev/null +++ b/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. + diff --git a/tests/webtbs/tw38549a.pp b/tests/webtbs/tw38549a.pp new file mode 100644 index 0000000000..c4d8c37137 --- /dev/null +++ b/tests/webtbs/tw38549a.pp @@ -0,0 +1,5 @@ + +{$packset 1} + +{$i tw38549.pp} + diff --git a/tests/webtbs/tw38549b.pp b/tests/webtbs/tw38549b.pp new file mode 100644 index 0000000000..6a08dc5bc4 --- /dev/null +++ b/tests/webtbs/tw38549b.pp @@ -0,0 +1,5 @@ + +{$packset 2} + +{$i tw38549.pp} + diff --git a/tests/webtbs/tw38549c.pp b/tests/webtbs/tw38549c.pp new file mode 100644 index 0000000000..1c387adb10 --- /dev/null +++ b/tests/webtbs/tw38549c.pp @@ -0,0 +1,5 @@ + +{$packset 4} + +{$i tw38549.pp} + diff --git a/tests/webtbs/tw38549d.pp b/tests/webtbs/tw38549d.pp new file mode 100644 index 0000000000..1d81388d66 --- /dev/null +++ b/tests/webtbs/tw38549d.pp @@ -0,0 +1,5 @@ + +{$packset 8} + +{$i tw38549.pp} +