diff --git a/.gitattributes b/.gitattributes index 3bae22d54c..4830649daf 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9086,6 +9086,7 @@ tests/test/tasout.pp svneol=native#text/plain tests/test/tassignmentoperator1.pp svneol=native#text/pascal tests/test/tbopr.pp svneol=native#text/plain tests/test/tbrtlevt.pp svneol=native#text/plain +tests/test/tbsx1.pp svneol=native#text/plain tests/test/tcase0.pp svneol=native#text/pascal tests/test/tcase1.pp svneol=native#text/plain tests/test/tcase10.pp svneol=native#text/pascal diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index d8018bdc51..704623191e 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -288,6 +288,9 @@ unit cgobj; procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const loc: tlocation); procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; bitnumber: aint; const loc: tlocation); + { bit scan instructions } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual; abstract; + { fpu move instructions } procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract; procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); virtual; abstract; diff --git a/compiler/compinnr.inc b/compiler/compinnr.inc index 875cc9ff50..24890e011b 100644 --- a/compiler/compinnr.inc +++ b/compiler/compinnr.inc @@ -81,6 +81,8 @@ const in_objc_encode_x = 71; in_sar_x_y = 72; in_sar_x = 73; + in_bsf_x = 74; + in_bsr_x = 75; { Internal constant functions } in_const_sqr = 100; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index effe7bc99b..61e7ff7c9b 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -56,6 +56,7 @@ interface procedure second_abs_long; virtual; procedure second_rox; virtual; procedure second_sar; virtual; + procedure second_bsfbsr; virtual; end; implementation @@ -169,6 +170,9 @@ implementation in_sar_x, in_sar_x_y: second_sar; + in_bsf_x, + in_bsr_x: + second_BsfBsr; else internalerror(9); end; end; @@ -806,6 +810,29 @@ implementation end; end; + + procedure tcginlinenode.second_BsfBsr; + var + reverse: boolean; + opsize: tcgsize; + begin + reverse:=(inlinenumber = in_bsr_x); + secondpass(left); + + opsize:=tcgsize2unsigned[left.location.size]; + if opsize < OS_32 then + opsize:=OS_32; + + if (left.location.loc <> LOC_REGISTER) or + (left.location.size <> opsize) then + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + + location_reset(location,LOC_REGISTER,opsize); + location.register := cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_bit_scan_reg_reg(current_asmdata.CurrAsmList,reverse,opsize,left.location.register,location.register); + end; + + begin cinlinenode:=tcginlinenode; end. diff --git a/compiler/ninl.pas b/compiler/ninl.pas index e457fe90f3..5e0e2911f8 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -2597,6 +2597,18 @@ implementation set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef; end; + in_bsf_x, + in_bsr_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + if not is_integer(left.resultdef) then + CGMessage1(type_e_integer_expr_expected,left.resultdef.typename); + if torddef(left.resultdef).ordtype in [u64bit, s64bit] then + resultdef:=u64inttype + else + resultdef:=u32inttype + end; + in_objc_selector_x: begin result:=cobjcselectornode.create(left); @@ -3007,7 +3019,9 @@ implementation in_ror_x, in_ror_x_x, in_sar_x, - in_sar_x_y: + in_sar_x_y, + in_bsf_x, + in_bsr_x: expectloc:=LOC_REGISTER; else internalerror(89); diff --git a/compiler/options.pas b/compiler/options.pas index 76cb27397a..d1a6eaf22a 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -2432,6 +2432,11 @@ begin def_system_macro('FPC_HAS_INTERNAL_SAR'); { $endif} +{ inline bsf/bsr implementation } +{$if defined(x86) or defined(x86_64)} + def_system_macro('FPC_HAS_INTERNAL_BSX'); +{$endif} + {$ifdef powerpc64} def_system_macro('FPC_HAS_LWSYNC'); {$endif} diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index 861712e0be..6b039c6685 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -71,6 +71,9 @@ unit cgx86; procedure a_load_reg_reg(list : TAsmList;fromsize,tosize: tcgsize;reg1,reg2 : tregister);override; procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + { bit scan instructions } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + { fpu move instructions } procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; @@ -1631,6 +1634,16 @@ unit cgx86; end; end; + procedure tcgx86.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + var + opsize: topsize; + begin + opsize:=tcgsize2opsize[size]; + if not reverse then + list.concat(taicpu.op_reg_reg(A_BSF,opsize,src,dst)) + else + list.concat(taicpu.op_reg_reg(A_BSR,opsize,src,dst)); + end; {*************** compare instructructions ****************} diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index fba3ae31dc..fc227ca291 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -1653,3 +1653,26 @@ end; {$endif} +{$ifndef FPC_SYSTEM_HAS_BSX_QWORD} +{$define FPC_SYSTEM_HAS_BSX_QWORD} + +function BsfQWord(Const AValue : QWord): cardinal; assembler; nostackframe; +asm + bsfl 4(%esp),%eax + jnz .L2 +.L1: bsfl 8(%esp),%eax + add $32,%eax +.L2: +end; + +function BsrQWord(Const AValue : QWord): cardinal; assembler; nostackframe; +asm + bsrl 8(%esp),%eax + jz .L1 + add $32,%eax + jmp .L2 +.L1: bsrl 4(%esp),%eax +.L2: +end; + +{$endif} diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 6362096ed2..ad7c843169 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -2269,3 +2269,96 @@ function SarInt64(Const AValue : Int64;Shift : Byte): Int64; {$endif FPC_HAS_INTERNAL_SAR_QWORD} {$endif FPC_SYSTEM_HAS_SAR_QWORD} +{$ifndef FPC_HAS_INTERNAL_BSX_BYTE} +{$ifndef FPC_SYSTEM_HAS_BSX_BYTE} +function BsfByte(Const AValue: Byte): Byte; + const bsf8bit: array [Byte] of Byte = ( + $ff,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0 + ); + begin + result:=bsf8bit[AValue]; + end; + +function BsrByte(Const AValue: Byte): Byte; + const bsr8bit: array [Byte] of Byte = ( + $ff,0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7 + ); + begin + result:=bsr8bit[AValue]; + end; +{$endif} +{$endif} + +{$ifndef FPC_SYSTEM_HAS_BSX_WORD} +{$ifndef FPC_HAS_INTERNAL_BSX_WORD} +function BsfWord(Const AValue: Word): cardinal; + begin + if lo(AValue)<>0 then + result:=BsfByte(lo(AValue)) + else + result:=BsfByte(hi(AValue))+8 + end; + +function BsrWord(Const AValue: Word): cardinal; + begin + if hi(AValue)<>0 then + result:=BsrByte(hi(AValue))+8 + else + result:=BsrByte(lo(AValue)) + end; +{$endif} +{$endif} + +{$ifndef FPC_HAS_INTERNAL_BSX_DWORD} +{$ifndef FPC_SYSTEM_HAS_BSX_DWORD} +function BsfDWord(Const AValue : DWord): cardinal; +begin + if lo(AValue)<>0 then + result:=BsfWord(lo(AValue)) + else + result:=BsfWord(hi(AValue))+16 +end; + +function BsrDWord(Const AValue : DWord): cardinal; +begin + if hi(AValue)<>0 then + result:=BsrWord(hi(AValue))+16 + else + result:=BsrWord(lo(AValue)) +end; +{$endif} +{$endif} + +{$ifndef FPC_HAS_INTERNAL_BSX_QWORD} +{$ifndef FPC_SYSTEM_HAS_BSX_QWORD} +function BsfQWord(Const AValue : QWord): cardinal; + begin + if lo(AValue) <> 0 then + result:=BsfDWord(lo(AValue)) + else + result:=BsfDWord(hi(AValue)) + 32 + end; + +function BsrQWord(Const AValue : QWord): cardinal; + begin + if hi(AValue) <> 0 then + result:=BsrDWord(hi(AValue)) + 32 + else + result:=BsrDWord(lo(AValue)) + end; +{$endif} +{$endif} diff --git a/rtl/inc/innr.inc b/rtl/inc/innr.inc index b6e9c97644..da5c95e14e 100644 --- a/rtl/inc/innr.inc +++ b/rtl/inc/innr.inc @@ -82,6 +82,8 @@ const fpc_objc_encode_x = 71; fpc_in_sar_x_y = 72; fpc_in_sar_x = 73; + fpc_in_bsf_x = 74; + fpc_in_bsr_x = 75; { Internal constant functions } fpc_in_const_sqr = 100; diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 2b6cdfda24..fa7b3d845e 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -756,6 +756,48 @@ function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_s function SarInt64(Const AValue : Int64;Shift : Byte = 1): Int64; {$endif FPC_HAS_INTERNAL_SAR_QWORD} +{$ifdef FPC_HAS_INTERNAL_BSX} +{$if defined(cpui386) or defined(cpux86_64)} +{$define FPC_HAS_INTERNAL_BSX_BYTE} +{$define FPC_HAS_INTERNAL_BSX_WORD} +{$define FPC_HAS_INTERNAL_BSX_DWORD} +{$endif} +{$if defined(cpux86_64)} +{$define FPC_HAS_INTERNAL_BSX_QWORD} +{$endif} +{$endif} + +{$ifdef FPC_HAS_INTERNAL_BSX_BYTE} +function BsfByte(Const AValue: Byte): Byte;[internproc:fpc_in_bsf_x]; +function BsrByte(Const AValue: Byte): Byte;[internproc:fpc_in_bsr_x]; +{$else} +function BsfByte(Const AValue: Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif} +function BsrByte(Const AValue: Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif} + +{$ifdef FPC_HAS_INTERNAL_BSX_WORD} +function BsfWord(Const AValue: Word): cardinal;[internproc:fpc_in_bsf_x]; +function BsrWord(Const AValue: Word): cardinal;[internproc:fpc_in_bsr_x]; +{$else} +function BsfWord(Const AValue: Word): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +function BsrWord(Const AValue: Word): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif} + +{$ifdef FPC_HAS_INTERNAL_BSX_DWORD} +function BsfDWord(Const AValue : DWord): cardinal;[internproc:fpc_in_bsf_x]; +function BsrDWord(Const AValue : DWord): cardinal;[internproc:fpc_in_bsr_x]; +{$else} +function BsfDWord(Const AValue : DWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +function BsrDWord(Const AValue : DWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif FPC_HAS_INTERNAL_BSX_DWORD} + +{$ifdef FPC_HAS_INTERNAL_BSX_QWORD} +function BsfQWord(Const AValue : QWord): cardinal;[internproc:fpc_in_bsf_x]; +function BsrQWord(Const AValue : QWord): cardinal;[internproc:fpc_in_bsr_x]; +{$else} +function BsfQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +function BsrQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif FPC_HAS_INTERNAL_BSF_QWORD} {$ifndef FPUNONE} { float math routines } diff --git a/tests/test/tbsx1.pp b/tests/test/tbsx1.pp new file mode 100644 index 0000000000..1ccae2a46c --- /dev/null +++ b/tests/test/tbsx1.pp @@ -0,0 +1,102 @@ +program testbitscan; + +function test_byte: boolean; +var + x8,f,r: byte; + i: integer; +begin + for i:=0 to 7 do + begin + x8:=1 shl i; + f:=BsfByte(x8); + if (f<>i) then + begin + writeln('BsfByte(',x8,') returned ',f,', should be ',i); + exit(false); + end; + r:=BsrByte(x8); + if r<>i then + begin + writeln('BsrByte(',x8,') returned ',f,', should be ',i); + exit(false); + end; + end; + result:=true; +end; + +function test_word: boolean; +var + x16: word; + i,f,r: integer; +begin + for i:=0 to 15 do + begin + x16:=1 shl i; + f:=BsfWord(x16); + if (f<>i) then + begin + writeln('BsfWord(',x16,') returned ',f,', should be ',i); + exit(false); + end; + r:=BsrWord(x16); + if r<>i then + begin + writeln('BsrWord(',x16,') returned ',f,', should be ',i); + exit(false); + end; + end; + result:=true; +end; + +function test_dword: boolean; +var + x32: cardinal; + i,f,r: integer; +begin + for i:=0 to 31 do + begin + x32:=1 shl i; + f:=BsfDWord(x32); + if (f<>i) then + begin + writeln('BsfDWord(',x32,') returned ',f,', should be ',i); + exit(false); + end; + r:=BsrDWord(x32); + if r<>i then + begin + writeln('BsrDWord(',x32,') returned ',f,', should be ',i); + exit(false); + end; + end; + result:=true; +end; + +function test_qword: boolean; +var + x64: qword; + i, f, r: integer; +begin + for i:=0 to 63 do + begin + x64:=uint64(1) shl i; + f:=BsfQWord(x64); + if f<>i then begin + writeln('BsfQWord(',x64,') returned ',f,', should be ',i); + exit(false); + end; + r:=BsrQWord(x64); + if r<>i then begin + writeln('BsrQWord(',x64,') returned ',r,', should be ',i); + exit(false); + end; + end; + result:=true; +end; + +begin + if test_byte then writeln('passed') else halt(1); + if test_word then writeln('passed') else halt(1); + if test_dword then writeln('passed') else halt(1); + if test_qword then writeln('passed') else halt(1); +end.