paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-06 13:49:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ ror/rol functions

Browse Source 
+ internal compiler support for ror/rol on i386

git-svn-id: trunk@11466 -
This commit is contained in:
florian 2008-07-27 17:12:32 +00:00
parent 0a26b6a129
commit 1afb1aa9cc
18 changed files with 426 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7697,6 +7697,7 @@ tests/test/trecreg2.pp svneol=native#text/plain
tests/test/trecreg3.pp -text
tests/test/trecreg4.pp svneol=native#text/plain
tests/test/tresstr.pp svneol=native#text/plain
tests/test/trox1.pp svneol=native#text/plain
tests/test/trstr1.pp svneol=native#text/plain
tests/test/trstr2.pp svneol=native#text/plain
tests/test/trstr3.pp svneol=native#text/plain

2
compiler/arm/cgcpu.pas
View File

@ -347,7 +347,7 @@ unit cgcpu;
const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
(A_NONE,A_MOV,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
A_NONE,A_NONE,A_NONE,A_SUB,A_EOR,A_NONE,A_NONE);
procedure tcgarm.a_op_const_reg_reg(list: TAsmList; op: TOpCg;

6
compiler/cgbase.pas
View File

@ -102,7 +102,9 @@ interface
OP_SHL, { logical shift left }
OP_SHR, { logical shift right }
OP_SUB, { simple subtraction }
OP_XOR { simple exclusive or }
OP_XOR, { simple exclusive or }
OP_ROL, { rotate left }
OP_ROR { rotate right }
);
{# Generic flag values - used for jump locations }
@ -630,7 +632,7 @@ implementation
const
list: array[topcg] of boolean =
(true,false,true,true,false,false,true,true,false,false,
true,false,false,false,false,true);
true,false,false,false,false,true,false,false);
begin
commutativeop := list[op];
end;

2
compiler/cgobj.pas
View File

@ -2465,7 +2465,7 @@ implementation
if a = 0 then
op:=OP_NONE;
end;
OP_SAR,OP_SHL,OP_SHR:
OP_SAR,OP_SHL,OP_SHR,OP_ROL,OP_ROR:
begin
if a = 0 then
op:=OP_NONE;

5
compiler/compinnr.inc
View File

@ -72,6 +72,11 @@ const
in_writestr_x = 62;
in_readstr_x = 63;
in_abs_long = 64;
in_ror_x = 65;
in_ror_x_x = 66;
in_rol_x = 67;
in_rol_x_x = 68;
{ Internal constant functions }
in_const_sqr = 100;

4
compiler/m68k/cgcpu.pas
View File

@ -158,7 +158,9 @@ unit cgcpu;
A_LSL,
A_LSR,
A_SUB,
A_EOR
A_EOR,
A_NONE,
A_NONE
);

70
compiler/ncginl.pas
View File

@ -54,6 +54,7 @@ interface
procedure second_round_real; virtual;
procedure second_trunc_real; virtual;
procedure second_abs_long; virtual;
procedure second_rox; virtual;
end;
implementation
@ -161,6 +162,11 @@ implementation
end;
end;
{$endif SUPPORT_MMX}
in_rol_x,
in_rol_x_x,
in_ror_x,
in_ror_x_x:
second_rox;
else internalerror(9);
end;
end;
@ -689,9 +695,8 @@ implementation
end;
procedure Tcginlinenode.second_get_caller_addr;
var frame_ref:Treference;
var
frame_ref:Treference;
begin
if current_procinfo.framepointer=NR_STACK_POINTER_REG then
begin
@ -713,6 +718,65 @@ implementation
end;
end;
procedure tcginlinenode.second_rox;
var
op : topcg;
hcountreg : tregister;
op1,op2 : tnode;
begin
{ one or two parameters? }
if assigned(tcallparanode(left).right) then
begin
op1:=tcallparanode(tcallparanode(left).right).left;
op2:=tcallparanode(left).left;
end
else
op1:=left;
secondpass(op1);
{ load left operator in a register }
location_copy(location,op1.location);
case inlinenumber of
in_ror_x,
in_ror_x_x:
op:=OP_ROR;
in_rol_x,
in_rol_x_x:
op:=OP_ROL;
end;
location_force_reg(current_asmdata.CurrAsmList,location,location.size,false);
if assigned(tcallparanode(left).right) then
begin
secondpass(op2);
{ rotating by a constant directly coded: }
if op2.nodetype=ordconstn then
cg.a_op_const_reg(current_asmdata.CurrAsmList,op,location.size,
tordconstnode(op2).value.uvalue and (resultdef.size*8-1),location.register)
else
begin
location_force_reg(current_asmdata.CurrAsmList,op2.location,location.size,false);
{
if op2.location.loc<>LOC_REGISTER then
begin
hcountreg:=cg.getintregister(current_asmdata.CurrAsmList,
op2.location.size);
cg.a_load_loc_reg(current_asmdata.CurrAsmList,location.size,
op2.location,hcountreg);
end
else
hcountreg:=op2.location.register;
}
{ do modulo 2 operation }
cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,op2.location.size,resultdef.size*8-1,op2.location.register);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,op,location.size,op2.location.register,location.register);
end;
end
else
cg.a_op_const_reg(current_asmdata.CurrAsmList,op,location.size,1,location.register);
end;
begin
cinlinenode:=tcginlinenode;
end.

18
compiler/ninl.pas
View File

@ -2434,6 +2434,19 @@ implementation
begin
resultdef:=voidpointertype;
end;
in_rol_x,
in_ror_x:
begin
set_varstate(left,vs_read,[vsf_must_be_valid]);
resultdef:=left.resultdef;
end;
in_rol_x_x,
in_ror_x_x:
begin
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef;
end;
else
internalerror(8);
end;
@ -2781,6 +2794,11 @@ implementation
expectloc:=tcallparanode(left).left.expectloc;
end;
{$endif SUPPORT_UNALIGNED}
in_rol_x,
in_rol_x_x,
in_ror_x,
in_ror_x_x:
expectloc:=LOC_REGISTER;
else
internalerror(89);
end;

5
compiler/options.pas
View File

@ -2197,6 +2197,11 @@ begin
def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
{$endif}
{ these cpus have an inline rol/ror implementaion }
{$if defined(x86)}
def_system_macro('FPC_HAS_INTERNAL_ROX');
{$endif}
{$ifdef SUPPORT_UNALIGNED}
def_system_macro('FPC_SUPPORTS_UNALIGNED');
def_system_macro('FPC_UNALIGNED_FIXED');

6
compiler/powerpc/cgcpu.pas
View File

@ -119,10 +119,10 @@ unit cgcpu;
const
TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_MR,A_ADDI,A_ANDI_,A_DIVWU,
A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI,A_NONE,A_NONE);
TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_MR,A_ADDIS,A_ANDIS_,
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS,A_NONE,A_NONE);
implementation
@ -669,7 +669,7 @@ const
const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
(A_NONE,A_MR,A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR,A_NONE,A_NONE);
begin
if (op = OP_MOVE) then

4
compiler/powerpc64/cgcpu.pas
View File

@ -1062,10 +1062,10 @@ procedure tcgppc.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
const
op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop =
(A_NONE, A_MR, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR,
A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR);
A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR, A_NONE, A_NONE);
op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop =
(A_NONE, A_MR, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR,
A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR);
A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR, A_NONE, A_NONE);
begin
case op of
OP_NEG, OP_NOT:

4
compiler/sparc/cgcpu.pas
View File

@ -109,10 +109,10 @@ interface
const
TOpCG2AsmOp : array[topcg] of TAsmOp=(
A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_SMUL,A_UMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SLL,A_SRL,A_SUB,A_XOR
A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_SMUL,A_UMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SLL,A_SRL,A_SUB,A_XOR,A_NONE,A_NONE
);
TOpCG2AsmOpWithFlags : array[topcg] of TAsmOp=(
A_NONE,A_MOV,A_ADDcc,A_ANDcc,A_UDIVcc,A_SDIVcc,A_SMULcc,A_UMULcc,A_NEG,A_NOT,A_ORcc,A_SRA,A_SLL,A_SRL,A_SUBcc,A_XORcc
A_NONE,A_MOV,A_ADDcc,A_ANDcc,A_UDIVcc,A_SDIVcc,A_SMULcc,A_UMULcc,A_NEG,A_NOT,A_ORcc,A_SRA,A_SLL,A_SRL,A_SUBcc,A_XORcc,A_NONE,A_NONE
);
TOpCmp2AsmCond : array[topcmp] of TAsmCond=(C_NONE,
C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A

18
compiler/x86/cgx86.pas
View File

@ -159,7 +159,7 @@ unit cgx86;
const
TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_MOV,A_ADD,A_AND,A_DIV,
A_IDIV,A_IMUL,A_MUL,A_NEG,A_NOT,A_OR,
A_SAR,A_SHL,A_SHR,A_SUB,A_XOR);
A_SAR,A_SHL,A_SHR,A_SUB,A_XOR,A_ROL,A_ROR);
TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE,
C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A);
@ -1098,10 +1098,10 @@ unit cgx86;
opmm2asmop : array[0..1,OS_F32..OS_F64,topcg] of tasmop = (
( { scalar }
( { OS_F32 }
A_NOP,A_NOP,A_ADDSS,A_NOP,A_DIVSS,A_NOP,A_NOP,A_MULSS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSS,A_NOP
A_NOP,A_NOP,A_ADDSS,A_NOP,A_DIVSS,A_NOP,A_NOP,A_MULSS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSS,A_NOP,A_NOP,A_NOP
),
( { OS_F64 }
A_NOP,A_NOP,A_ADDSD,A_NOP,A_DIVSD,A_NOP,A_NOP,A_MULSD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSD,A_NOP
A_NOP,A_NOP,A_ADDSD,A_NOP,A_DIVSD,A_NOP,A_NOP,A_MULSD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSD,A_NOP,A_NOP,A_NOP
)
),
( { vectorized/packed }
@ -1109,10 +1109,10 @@ unit cgx86;
these
}
( { OS_F32 }
A_NOP,A_NOP,A_ADDPS,A_NOP,A_DIVPS,A_NOP,A_NOP,A_MULPS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPS,A_XORPS
A_NOP,A_NOP,A_ADDPS,A_NOP,A_DIVPS,A_NOP,A_NOP,A_MULPS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPS,A_XORPS,A_NOP,A_NOP
),
( { OS_F64 }
A_NOP,A_NOP,A_ADDPD,A_NOP,A_DIVPD,A_NOP,A_NOP,A_MULPD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPD,A_XORPD
A_NOP,A_NOP,A_ADDPD,A_NOP,A_DIVPD,A_NOP,A_NOP,A_MULPD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPD,A_XORPD,A_NOP,A_NOP
)
)
);
@ -1259,7 +1259,7 @@ unit cgx86;
end
else
list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a,reg));
OP_SHL,OP_SHR,OP_SAR:
OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR:
begin
{$ifdef x86_64}
if (a and 63) <> 0 Then
@ -1375,7 +1375,7 @@ unit cgx86;
else
list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
TCgSize2OpSize[size],a,tmpref));
OP_SHL,OP_SHR,OP_SAR:
OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR:
begin
if (a and 31) <> 0 then
list.concat(taicpu.op_const_ref(
@ -1407,9 +1407,9 @@ unit cgx86;
{ special stuff, needs separate handling inside code }
{ generator }
internalerror(200109233);
OP_SHR,OP_SHL,OP_SAR:
OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR:
begin
{ Use ecx to load the value, that allows beter coalescing }
{ Use ecx to load the value, that allows better coalescing }
getcpuregister(list,NR_ECX);
a_load_reg_reg(list,size,OS_32,src,NR_ECX);
list.concat(taicpu.op_reg_reg(Topcg2asmop[op],tcgsize2opsize[size],NR_CL,dst));

28
rtl/i386/i386.inc
View File

@ -1537,3 +1537,31 @@ asm
end;
{$endif}
{$ifdef FPC_HAS_INTERNAL_ROX}
{ the i386 cg doesn't support yet directly coded 64 bit rotates }
function Ror(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shr 1) or (AValue shl 63);
end;
function Ror(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 63;
Result:=(AValue shr Dist) or (AValue shl (64-Dist));
end;
function Rol(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shl 1) or (AValue shr 63);
end;
function Rol(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 63;
Result:=(AValue shl Dist) or (AValue shr (64-Dist));
end;
{$endif FPC_HAS_INTERNAL_ROX}

112
rtl/inc/generic.inc
View File

@ -2043,4 +2043,114 @@ procedure WriteBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
end;
{$endif}
{$endif FPC_SYSTEM_HAS_MEM_BARRIER}
{$ifndef FPC_HAS_INTERNAL_ROX}
{$ifndef FPC_SYSTEM_HAS_ROX}
function Ror(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shr 1) or (AValue shl 7);
end;
function Ror(Const AValue : Byte;Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 7;
Result:=(AValue shr Dist) or (AValue shl (8-Dist));
end;
function Ror(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shr 1) or (AValue shl 15);
end;
function Ror(Const AValue : Word;Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 15;
Result:=(AValue shr Dist) or (AValue shl (16-Dist));
end;
function Ror(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shr 1) or (AValue shl 31);
end;
function Ror(Const AValue : DWord;Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 31;
Result:=(AValue shr Dist) or (AValue shl (32-Dist));
end;
function Ror(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shr 1) or (AValue shl 63);
end;
function Ror(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 63;
Result:=(AValue shr Dist) or (AValue shl (64-Dist));
end;
function Rol(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shl 1) or (AValue shr 7);
end;
function Rol(Const AValue : Byte;Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 7;
Result:=(AValue shl Dist) or (AValue shr (8-Dist));
end;
function Rol(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shl 1) or (AValue shr 15);
end;
function Rol(Const AValue : Word;Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 15;
Result:=(AValue shl Dist) or (AValue shr (16-Dist));
end;
function Rol(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shl 1) or (AValue shr 31);
end;
function Rol(Const AValue : DWord;Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 31;
Result:=(AValue shl Dist) or (AValue shr (32-Dist));
end;
function Rol(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=(AValue shl 1) or (AValue shr 63);
end;
function Rol(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Dist:=Dist and 63;
Result:=(AValue shl Dist) or (AValue shr (64-Dist));
end;
{$endif FPC_SYSTEM_HAS_ROX}
{$endif FPC_HAS_INTERNAL_ROX}

4
rtl/inc/innr.inc
View File

@ -73,6 +73,10 @@ const
fpc_in_writestr_x = 62;
fpc_in_readstr_x = 63;
fpc_in_abs_long = 64;
fpc_in_ror_x = 65;
fpc_in_ror_x_x = 66;
fpc_in_rol_x = 67;
fpc_in_rol_x_x = 68;
{ Internal constant functions }
fpc_in_const_sqr = 100;

51
rtl/inc/systemh.inc
View File

@ -608,6 +608,57 @@ function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifdef FPC_HAS_INTERNAL_ROX}
function Ror(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
function Ror(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
function Ror(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
function Ror(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
function Ror(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
function Ror(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
{ the i386 cg doesn't support yet directly coded 64 bit rotates }
{$ifndef cpui386}
function Ror(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
function Ror(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
{$else cpui386}
function Ror(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif cpui386}
function Rol(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
function Rol(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
function Rol(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
function Rol(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
function Rol(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
function Rol(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
{ the i386 cg doesn't support yet directly coded 64 bit rotates }
{$ifndef cpui386}
function Rol(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
function Rol(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
{$else cpui386}
function Rol(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif cpui386}
{$else FPC_HAS_INTERNAL_ROX}
function Ror(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : Byte;Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : Word;Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : DWord;Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Ror(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : Byte;Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : Word;Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : DWord;Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function Rol(Const AValue : QWord;Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ROX}
{$ifndef FPUNONE}
{ float math routines }
{$I mathh.inc}

78
tests/test/trox1.pp Normal file
View File

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