2016 Update

Task/Binary-digits/Pascal/binary-digits-2.pascal

@@ -0,0 +1,106 @@
+program IntToPcharTest;
+uses
+  sysutils;//for timing
+
+const
+{$ifdef CPU64}
+  cBitcnt = 64;
+{$ELSE}
+  cBitcnt = 32;
+{$ENDIF}
+
+procedure IntToBinPchar(AInt : NativeUInt;s:pChar);
+//create the Bin-String
+//!Beware of endianess ! this is for little endian
+const
+  IO : array[0..1] of char = ('0','1');//('_','X'); as you like
+  IO4 : array[0..15] of LongWord = // '0000','1000' as LongWord
+($30303030,$31303030,$30313030,$31313030,
+ $30303130,$31303130,$30313130,$31313130,
+ $30303031,$31303031,$30313031,$31313031,
+ $30303131,$31303131,$30313131,$31313131);
+var
+  i : NativeInt;
+
+begin
+  IF AInt > 0 then
+  Begin
+  // Get the index of highest set bit
+{$ifdef CPU64}
+    i := BSRQWord(NativeInt(Aint))+1;
+{$ELSE}
+    i := BSRDWord(NativeInt(Aint))+1;
+{$ENDIF}
+    s[i] := #0;
+    //get 4 characters at once
+    dec(i);
+    while i >= 3 do
+    Begin
+      pLongInt(@s[i-3])^ := IO4[Aint AND 15];
+      Aint := Aint SHR 4;
+      dec(i,4)
+    end;
+    //the rest one by one
+    while i >= 0 do
+    Begin
+      s[i] := IO[Aint AND 1];
+      AInt := Aint shr 1;
+      dec(i);
+    end;
+  end
+  else
+  Begin
+    s[0] := IO[0];
+    s[1] := #0;
+  end;
+end;
+
+procedure Binary_Digits;
+var
+ s: pCHar;
+begin
+  GetMem(s,cBitcnt+4);
+  fillchar(s[0],cBitcnt+4,#0);
+  IntToBinPchar(   5,s);writeln('   5: ',s);
+  IntToBinPchar(  50,s);writeln('  50: ',s);
+  IntToBinPchar(9000,s);writeln('9000: ',s);
+  IntToBinPchar(NativeUInt(-1),s);writeln('  -1: ',s);
+  FreeMem(s);
+end;
+
+const
+  rounds = 10*1000*1000;
+
+var
+  s: pChar;
+  t :TDateTime;
+  i,l,cnt: NativeInt;
+  Testfield : array[0..rounds-1] of NativeUint;
+Begin
+  randomize;
+  cnt := 0;
+  For i := rounds downto  1 do
+  Begin
+    l := random(High(NativeInt));
+    Testfield[i] := l;
+  {$ifdef CPU64}
+    inc(cnt,BSRQWord(l));
+  {$ELSE}
+    inc(cnt,BSRQWord(l));
+  {$ENDIF}
+  end;
+  Binary_Digits;
+  GetMem(s,cBitcnt+4);
+  fillchar(s[0],cBitcnt+4,#0);
+  //warm up
+  For i := 0 to rounds-1 do
+    IntToBinPchar(Testfield[i],s);
+  //speed test
+  t := time;
+  For i := 1 to rounds do
+    IntToBinPchar(Testfield[i],s);
+  t := time-t;
+  Write(' Time ',t*86400.0:6:3,' secs, average stringlength ');
+  Writeln(cnt/rounds+1:6:3);
+  FreeMem(s);
+end.