RosettaCodeData/Task/Population-count/Pascal/population-count-1.pas

83 lines
2.1 KiB
ObjectPascal

unit popcount;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,ASMCSE,CSE,PEEPHOLE}
{$Smartlink OFF}
{$ENDIF}
interface
function popcnt(n:Uint64):integer;overload;
function popcnt(n:Uint32):integer;overload;
function popcnt(n:Uint16):integer;overload;
function popcnt(n:Uint8):integer;overload;
implementation
const
//K1 = $0101010101010101;
K33 = $3333333333333333;
K55 = $5555555555555555;
KF1 = $0F0F0F0F0F0F0F0F;
KF2 = $00FF00FF00FF00FF;
KF4 = $0000FFFF0000FFFF;
KF8 = $00000000FFFFFFFF;
{
function popcnt64(n:Uint64):integer;
begin
n := n- (n shr 1) AND K55;
n := (n AND K33)+ ((n shr 2) AND K33);
n := (n + (n shr 4)) AND KF1;
n := (n*k1) SHR 56;
result := n;
end;
}
function popcnt(n:Uint64):integer;overload;
// on Intel Haswell 2x faster for fpc 32-Bit
begin
n := (n AND K55)+((n shr 1) AND K55);
n := (n AND K33)+((n shr 2) AND K33);
n := (n AND KF1)+((n shr 4) AND KF1);
n := (n AND KF2)+((n shr 8) AND KF2);
n := (n AND KF4)+((n shr 16) AND KF4);
n := (n AND KF8)+ (n shr 32);
result := n;
end;
function popcnt(n:Uint32):integer;overload;
var
c,b : NativeUint;
begin
b := n;
c := (b shr 1) AND NativeUint(K55); b := (b AND NativeUint(K55))+C;
c := ((b shr 2) AND NativeUint(K33));b := (b AND NativeUint(K33))+C;
c:= ((b shr 4) AND NativeUint(KF1)); b := (b AND NativeUint(KF1))+c;
c := ((b shr 8) AND NativeUint(KF2));b := (b AND NativeUint(KF2))+c;
c := b shr 16; b := (b AND NativeUint(KF4))+ C;
result := b;
end;
function popcnt(n:Uint16):integer;overload;
var
c,b : NativeUint;
begin
b := n;
c := (b shr 1) AND NativeUint(K55); b := (b AND NativeUint(K55))+C;
c :=((b shr 2) AND NativeUint(K33)); b := (b AND NativeUint(K33))+C;
c:= ((b shr 4) AND NativeUint(KF1)); b := (b AND NativeUint(KF1))+c;
c := b shr 8; b := (b AND NativeUint(KF2))+c;
result := b;
end;
function popcnt(n:Uint8):integer;overload;
var
c,b : NativeUint;
begin
b := n;
c := (b shr 1) AND NativeUint(K55); b := (b AND NativeUint(K55))+C;
c :=((b shr 2) AND NativeUint(K33));b := (b AND NativeUint(K33))+C;
c:= b shr 4;
result := (b AND NativeUint(KF1))+c;
end;
Begin
End.