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

+ support mmx shifting

Browse Source 
git-svn-id: trunk@38367 -
This commit is contained in:
florian 2018-02-27 21:40:12 +00:00
parent e523865b07
commit 8c5606b41d
9 changed files with 196 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11964,6 +11964,7 @@ tests/test/cg/tlohi.pp svneol=native#text/plain
tests/test/cg/tlohi2.pp svneol=native#text/pascal
tests/test/cg/tm128.pp svneol=native#text/pascal
tests/test/cg/tmanypar.pp svneol=native#text/plain
tests/test/cg/tmmxshift.pp svneol=native#text/pascal
tests/test/cg/tmoddiv.pp svneol=native#text/plain
tests/test/cg/tmoddiv1.pp svneol=native#text/plain
tests/test/cg/tmoddiv2.pp svneol=native#text/plain

2
compiler/defutil.pas
View File

@ -32,7 +32,7 @@ interface
type
tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle,mmxs64bit,mmxu64bit);
{*****************************************************************************

2
compiler/i386/n386mat.pas
View File

@ -33,7 +33,7 @@ interface
procedure pass_generate_code;override;
end;
ti386shlshrnode = class(tcgshlshrnode)
ti386shlshrnode = class(tx86shlshrnode)
procedure second_64bit;override;
function first_shlshr64bitint: tnode; override;
end;

2
compiler/i8086/n8086mat.pas
View File

@ -35,7 +35,7 @@ interface
procedure pass_generate_code;override;
end;
ti8086shlshrnode = class(tcgshlshrnode)
ti8086shlshrnode = class(tx86shlshrnode)
procedure second_64bit;override;
function first_shlshr64bitint: tnode; override;
end;

8
compiler/ncgmat.pas
View File

@ -102,6 +102,9 @@ interface
end;
tcgshlshrnode = class(tshlshrnode)
{$ifdef SUPPORT_MMX}
procedure second_mmx;virtual;abstract;
{$endif SUPPORT_MMX}
{$ifndef cpu64bitalu}
procedure second_64bit;virtual;
{$endif not cpu64bitalu}
@ -602,6 +605,11 @@ implementation
begin
secondpass(left);
secondpass(right);
{$ifdef SUPPORT_MMX}
if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(left.resultdef) then
second_mmx
else
{$endif SUPPORT_MMX}
{$ifndef cpu64bitalu}
if is_64bit(left.resultdef) then
second_64bit

56
compiler/nmat.pas
View File

@ -98,7 +98,7 @@ implementation
verbose,globals,cutils,compinnr,
globtype,constexp,
symconst,symtype,symdef,
defutil,
defcmp,defutil,
htypechk,pass_1,
cgbase,
ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl,
@ -790,36 +790,52 @@ implementation
exit;
end;
{ calculations for ordinals < 32 bit have to be done in
32 bit for backwards compatibility. That way 'shl 33' is
the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
if (not is_64bit(left.resultdef)) and
(torddef(left.resultdef).ordtype<>u32bit) then
{$ifdef SUPPORT_MMX}
if (cs_mmx in current_settings.localswitches) and
is_mmx_able_array(left.resultdef) and
((is_mmx_able_array(right.resultdef) and
equal_defs(left.resultdef,right.resultdef)
) or is_constintnode(right)) then
begin
{ keep singness of orignal type }
if is_signed(left.resultdef) then
if not(mmx_type(left.resultdef) in [mmxu16bit,mmxs16bit,mmxfixed16,mmxu32bit,mmxs32bit,mmxu64bit,mmxs64bit]) then
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
if not(is_mmx_able_array(right.resultdef)) then
inserttypeconv(right,sinttype);
end
else
{$endif SUPPORT_MMX}
begin
{ calculations for ordinals < 32 bit have to be done in
32 bit for backwards compatibility. That way 'shl 33' is
the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
if (not is_64bit(left.resultdef)) and
(torddef(left.resultdef).ordtype<>u32bit) then
begin
{ keep singness of orignal type }
if is_signed(left.resultdef) then
begin
{$if defined(cpu64bitalu) or defined(cpu32bitalu)}
inserttypeconv(left,s32inttype)
inserttypeconv(left,s32inttype)
{$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(sinttype),true));
inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(sinttype),true));
{$else}
internalerror(2013031301);
internalerror(2013031301);
{$endif}
end
else
begin
end
else
begin
{$if defined(cpu64bitalu) or defined(cpu32bitalu)}
inserttypeconv(left,u32inttype);
inserttypeconv(left,u32inttype);
{$elseif defined(cpu16bitalu) or defined(cpu8bitalu)}
inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(uinttype),true));
inserttypeconv(left,get_common_intdef(torddef(left.resultdef),torddef(uinttype),true));
{$else}
internalerror(2013031301);
internalerror(2013031301);
{$endif}
end
end;
end
end;
inserttypeconv(right,sinttype);
inserttypeconv(right,sinttype);
end;
resultdef:=left.resultdef;

103
compiler/x86/nx86mat.pas
View File

@ -48,6 +48,12 @@ interface
procedure pass_generate_code;override;
end;
tx86shlshrnode = class(tcgshlshrnode)
{$ifdef SUPPORT_MMX}
procedure second_mmx;override;
{$endif SUPPORT_MMX}
end;
implementation
uses
@ -59,7 +65,8 @@ interface
cgbase,pass_1,pass_2,
ncon,
cpubase,cpuinfo,
cga,cgobj,hlcgobj,cgx86,cgutils;
cga,cgobj,hlcgobj,cgx86,cgutils,
tgobj;
{*****************************************************************************
@ -680,4 +687,98 @@ DefaultDiv:
end;
end;
procedure tx86shlshrnode.second_mmx;
var
op : TAsmOp;
cmpop : boolean;
mmxbase : tmmxtype;
hreg,
hregister : tregister;
begin
secondpass(left);
if codegenerror then
exit;
secondpass(right);
if codegenerror then
exit;
cmpop:=false;
op:=A_NOP;
mmxbase:=mmx_type(left.resultdef);
location_reset(location,LOC_MMXREGISTER,def_cgsize(resultdef));
case nodetype of
shrn :
case mmxbase of
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PSRLW;
mmxs32bit,mmxu32bit:
op:=A_PSRLD;
mmxs64bit,mmxu64bit:
op:=A_PSRLQ;
else
Internalerror(2018022504);
end;
shln :
case mmxbase of
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PSLLW;
mmxs32bit,mmxu32bit:
op:=A_PSLLD;
mmxs64bit,mmxu64bit:
op:=A_PSLLD;
else
Internalerror(2018022503);
end;
else
internalerror(2018022502);
end;
{ left and right no register? }
{ then one must be demanded }
if (left.location.loc<>LOC_MMXREGISTER) then
begin
{ register variable ? }
if (left.location.loc=LOC_CMMXREGISTER) then
begin
hregister:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
emit_reg_reg(A_MOVQ,S_NO,left.location.register,hregister);
end
else
begin
if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(2018022505);
hregister:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference);
emit_ref_reg(A_MOVQ,S_NO,left.location.reference,hregister);
end;
location_reset(left.location,LOC_MMXREGISTER,OS_NO);
left.location.register:=hregister;
end;
{ at this point, left.location.loc should be LOC_MMXREGISTER }
case right.location.loc of
LOC_MMXREGISTER,LOC_CMMXREGISTER:
begin
emit_reg_reg(op,S_NO,right.location.register,left.location.register);
location.register:=left.location.register;
end;
LOC_CONSTANT:
emit_const_reg(op,S_NO,right.location.value,left.location.register);
LOC_REFERENCE,LOC_CREFERENCE:
begin
tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference);
emit_ref_reg(op,S_NO,right.location.reference,left.location.register);
end;
else
internalerror(2018022506);
end;
location.register:=left.location.register;
location_freetemp(current_asmdata.CurrAsmList,right.location);
end;
end.

2
compiler/x86_64/nx64mat.pas
View File

@ -29,7 +29,7 @@ interface
node,nmat,nx86mat;
type
tx8664shlshrnode = class(tshlshrnode)
tx8664shlshrnode = class(tx86shlshrnode)
procedure pass_generate_code;override;
end;

45
tests/test/cg/tmmxshift.pp Normal file
View File

@ -0,0 +1,45 @@
{$mmx+}
uses
mmx;
var
wa,wb : tmmxword;
ca,cb : tmmxcardinal;
i : longint;
begin
for i:=low(wa) to high(wa) do
wa[i]:=2;
wb:=default(tmmxword);
wb[0]:=2;
wa:=wa shl 3;
for i:=low(wa) to high(wa) do
if wa[i]<>16 then
halt(1);
wa:=wa shl wb;
for i:=low(wa) to high(wa) do
if wa[i]<>64 then
halt(1);
wa:=(wa shr 3) shr wb;
for i:=low(wa) to high(wa) do
if wa[i]<>2 then
halt(1);
for i:=low(ca) to high(ca) do
ca[i]:=2;
cb:=default(tmmxcardinal);
cb[0]:=2;
ca:=ca shl 3;
for i:=low(ca) to high(ca) do
if ca[i]<>16 then
halt(1);
ca:=ca shl cb;
for i:=low(wa) to high(ca) do
if ca[i]<>64 then
halt(1);
ca:=(ca shr 3) shr cb;
for i:=low(ca) to high(ca) do
if ca[i]<>2 then
halt(1);
writeln('ok');
end.