+ 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 -
This commit is contained in:
nickysn 2017-03-26 23:16:53 +00:00
parent 73c46a5988
commit fc59649a98
7 changed files with 507 additions and 0 deletions

2
.gitattributes vendored
View File

@ -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

View File

@ -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;

View File

@ -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
*****************************************************************************}

View File

@ -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.

View File

@ -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;

View File

@ -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.

View File

@ -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.