paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-01 10:42:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* constant evaluation of ror/rol if they are internally handled, resolves #6300

Browse Source 
* renamed rox_x_x to rox_x_y

git-svn-id: trunk@17810 -
This commit is contained in:
florian 2011-06-23 20:54:08 +00:00
parent 9b1129cf5b
commit 8e7f39f176
6 changed files with 178 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -10367,6 +10367,8 @@ tests/test/trhlp8.pp svneol=native#text/pascal
tests/test/trhlp9.pp svneol=native#text/pascal
tests/test/trox1.pp svneol=native#text/plain
tests/test/trox2.pp svneol=native#text/plain
tests/test/trox3.pp svneol=native#text/pascal
tests/test/trox4.pp svneol=native#text/pascal
tests/test/trstr1.pp svneol=native#text/plain
tests/test/trstr2.pp svneol=native#text/plain
tests/test/trstr3.pp svneol=native#text/plain

4
compiler/compinnr.inc
View File

@ -73,9 +73,9 @@ const
in_readstr_x = 63;
in_abs_long = 64;
in_ror_x = 65;
in_ror_x_x = 66;
in_ror_x_y = 66;
in_rol_x = 67;
in_rol_x_x = 68;
in_rol_x_y = 68;
in_objc_selector_x = 69;
in_objc_protocol_x = 70;
in_objc_encode_x = 71;

8
compiler/ncginl.pas
View File

@ -163,9 +163,9 @@ implementation
end;
{$endif SUPPORT_MMX}
in_rol_x,
in_rol_x_x,
in_rol_x_y,
in_ror_x,
in_ror_x_x:
in_ror_x_y:
second_rox;
in_sar_x,
in_sar_x_y:
@ -741,10 +741,10 @@ implementation
location_copy(location,op1.location);
case inlinenumber of
in_ror_x,
in_ror_x_x:
in_ror_x_y:
op:=OP_ROR;
in_rol_x,
in_rol_x_x:
in_rol_x_y:
op:=OP_ROL;
end;
location_force_reg(current_asmdata.CurrAsmList,location,location.size,false);

81
compiler/ninl.pas
View File

@ -1521,6 +1521,74 @@ implementation
end;
function handle_const_rox : tnode;
var
vl,vl2 : TConstExprInt;
bits,shift: integer;
def : tdef;
begin
result:=nil;
if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then
begin
if (left.nodetype=callparan) and
assigned(tcallparanode(left).right) then
begin
if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then
begin
def:=tcallparanode(tcallparanode(left).right).left.resultdef;
vl:=tordconstnode(tcallparanode(left).left).value;
vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
end
else
exit;
end
else
begin
def:=left.resultdef;
vl:=1;
vl2:=tordconstnode(left).value;
end;
bits:=def.size*8;
shift:=vl.svalue and (bits-1);
{$push}
{$r-,q-}
if shift=0 then
result:=cordconstnode.create(vl2.svalue,def,false)
else
case inlinenumber of
in_ror_x,in_ror_x_y:
case def.size of
1:
result:=cordconstnode.create(RorByte(Byte(vl2.svalue),shift),def,false);
2:
result:=cordconstnode.create(RorWord(Word(vl2.svalue),shift),def,false);
4:
result:=cordconstnode.create(RorDWord(DWord(vl2.svalue),shift),def,false);
8:
result:=cordconstnode.create(RorQWord(QWord(vl2.svalue),shift),def,false);
else
internalerror(2011061903);
end;
in_rol_x,in_rol_x_y:
case def.size of
1:
result:=cordconstnode.create(RolByte(Byte(vl2.svalue),shift),def,false);
2:
result:=cordconstnode.create(RolWord(Word(vl2.svalue),shift),def,false);
4:
result:=cordconstnode.create(RolDWord(DWord(vl2.svalue),shift),def,false);
8:
result:=cordconstnode.create(RolQWord(QWord(vl2.svalue),shift),def,false);
else
internalerror(2011061902);
end;
else
internalerror(2011061901);
end;
end;
end;
var
hp : tnode;
vl,vl2 : TConstExprInt;
@ -1931,6 +1999,11 @@ implementation
begin
result:=handle_const_sar;
end;
in_rol_x,
in_rol_x_y,
in_ror_x,
in_ror_x_y :
result:=handle_const_rox;
end;
end;
end;
@ -2621,8 +2694,8 @@ implementation
set_varstate(left,vs_read,[vsf_must_be_valid]);
resultdef:=left.resultdef;
end;
in_rol_x_x,
in_ror_x_x,
in_rol_x_y,
in_ror_x_y,
in_sar_x_y:
begin
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
@ -3040,9 +3113,9 @@ implementation
expectloc:=tcallparanode(left).left.expectloc;
end;
in_rol_x,
in_rol_x_x,
in_rol_x_y,
in_ror_x,
in_ror_x_x,
in_ror_x_y,
in_sar_x,
in_sar_x_y,
in_bsf_x,

46
tests/test/trox3.pp Normal file
View File

@ -0,0 +1,46 @@
procedure do_error(i : integer);
begin
writeln('Error: ',i);
halt(1);
end;
var
b1,b2 : byte;
w1 : word;
d1 : dword;
q1 : qword;
begin
b1:=rorbyte(rorbyte(rorbyte(1),2),3);
if b1<>4 then
do_error(1000);
w1:=rorword(rorword(rorword(1),2),3);
if w1<>$400 then
do_error(1001);
d1:=rordword(rordword(rordword(1),2),3);
if d1<>$4000000 then
do_error(1002);
q1:=rorqword(rorqword(rorqword(1),2),3);
if q1<>$400000000000000 then
do_error(1003);
b1:=rolbyte(rolbyte(rolbyte(1),2),3);
if b1<>$40 then
do_error(2000);
w1:=rolword(rolword(rolword($8001),2),3);
if w1<>$60 then
do_error(2001);
d1:=roldword(roldword(roldword($80000001),2),3);
if d1<>$60 then
do_error(2002);
q1:=rolqword(rolqword(rolqword($8000000000000001),2),3);
if q1<>$60 then
do_error(2003);
writeln('ok');
end.

47
tests/test/trox4.pp Normal file
View File

@ -0,0 +1,47 @@
// tests whether the rol/ror operations properly mask out the shift count
procedure do_error(i : integer);
begin
writeln('Error: ',i);
halt(1);
end;
var
b1 : byte;
w1 : word;
d1 : dword;
q1 : qword;
begin
b1:=rorbyte(2,15);
if b1<>4 then
do_error(1000);
w1:=rorword(1,29);
if w1<>$8 then
do_error(1001);
d1:=rordword($400,60);
if d1<>$4000 then
do_error(1002);
q1:=rorqword($80000000000,125);
if q1<>$400000000000 then
do_error(1003);
b1 := rolbyte($81,14);
if (b1 <> $60) then
do_error(2000);
w1:=rolword($8001,22);
if w1<>$60 then
do_error(2001);
d1:=roldword($80000001,38);
if d1<>$60 then
do_error(2002);
q1:=rolqword(qword($8000000000000001),70);
if q1<>$60 then
do_error(2003);
writeln('ok');
end.