* implementation of bit scan intrinsics by Richard Vida, resolves #17592

git-svn-id: trunk@16174 -

.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

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;

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;

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.

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

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}

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

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}

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}

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;

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 }

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.