-
Content Count
3586 -
Joined
-
Last visited
-
Days Won
176
Everything posted by David Heffernan
-
This is not something we should be happy about though. The compiler should be doing this for us.
-
Define "best". Starting with deciding which encoding to use.
-
Micro optimization - effect of defined and not used local variables
David Heffernan replied to Mike Torrettinni's topic in Algorithms, Data Structures and Class Design
Measure your program and find out. If all you do is micro benchmarks then likely all you will achieve is to make your code harder to read and develop, and your program runs no faster. Do you know where the bottlenecks are in your program? -
Micro optimization - effect of defined and not used local variables
David Heffernan replied to Mike Torrettinni's topic in Algorithms, Data Structures and Class Design
Is this code a bottleneck in your program? If not write it in the way that is easiest to read. How many times have I said that to you? Why would you choose to make your code hard to read for no benefit? -
DeepBlue is old news. Things have moved on. Stockfish is king these days.
-
You can extend my benchmark program in earlier posts to see how it performs.
-
This code is very easy to verify that it is safe. For more complex code, that may not be the case, and so pointers could be risky. I was using pointers here for performance reasons. Copy a bunch of characters in one go rather than character by character. Others showed much better ways to do it than my initial attempt.
-
Blitz ELO of <1500 suggests that no, it does not play good chess CCRL Blitz - Index (computerchess.org.uk)
-
Can it play chess well? Or is it interesting because it's Pascal?
-
This seems like choosing a library, and then trying to work out how to fit that library to the problem. That's the wrong way round. One should first understand the problem space, its requirements and constraints, and then find the best solution. Problem first, then solution. Not the other way round.
-
OpenGL doesn't seem like an obvious choice for 2D graphics on Windows.
-
I'm sure you can get the performance you need with the vcl
-
If only they'd developed a compiler that targeted .net.....
-
Generic Drawing Engine
David Heffernan replied to David Hoyle's topic in RTL and Delphi Object Pascal
What about numbers other than 1? -
Generic Drawing Engine
David Heffernan replied to David Hoyle's topic in RTL and Delphi Object Pascal
Generics likely aren't the right solution here. You need templates which don't exist in Delphi. -
It was always strings. I've kept a variety of routines in there, that chart the evolution in this thread. Don't think so, because of the first point, which is that the question was about strings and not individual chars.
-
Very nicely done indeed. Another update of my benchmark: {$APPTYPE CONSOLE} uses System.SysUtils, System.Classes, System.Diagnostics; //******************************************** // Constants to tune the benchmark performance const HexStringLength = 64; InputDataCount = 512; IterationCount = 20000; //************************** // David Heffernan's routine function HexToBinHeffMove(const HexValue: string): string; const BinaryValues: array [0..15] of string = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111' ); var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9': HexDigitValue := Ord(HexDigit) - Ord('0'); 'a'..'f': HexDigitValue := 10 + Ord(HexDigit) - Ord('a'); 'A'..'F': HexDigitValue := 10 + Ord(HexDigit) - Ord('A'); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Move(Pointer(BinaryValues[HexDigitValue])^, Ptr^, 4 * SizeOf(Char)); Inc(Ptr, 4); end; end; //***************************************************************** // David Heffernan's routine, with Move replace by Int64 assignment function HexToBinHeffInt64Assign(const HexValue: string): string; const BinaryValues: array [0..15] of string = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111' ); var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9': HexDigitValue := Ord(HexDigit) - Ord('0'); 'a'..'f': HexDigitValue := 10 + Ord(HexDigit) - Ord('a'); 'A'..'F': HexDigitValue := 10 + Ord(HexDigit) - Ord('A'); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; PInt64(Ptr)^ := PInt64(BinaryValues[HexDigitValue])^; Inc(Ptr, 4); end; end; //************************ // Mahdi Safsafi's routine function HexToBinMahdi(const HexValue: string): string; type TChar4 = array [0 .. 3] of Char; PChar4 = ^TChar4; const Table1: array ['0' .. '9'] of TChar4 = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001'); Table2: array ['a' .. 'f'] of TChar4 = ('1010', '1011', '1100', '1101', '1110', '1111'); var HexDigit: Char; P: PChar4; begin SetLength(Result, Length(HexValue) * 4); P := PChar4(Result); for HexDigit in HexValue do begin case HexDigit of '0' .. '9': P^ := Table1[HexDigit]; 'a' .. 'f': P^ := Table2[HexDigit]; 'A' .. 'F': P^ := Table2[Chr(Ord(HexDigit) xor $20)]; else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(P); end; end; //************************************************ // Mahdi Safsafi's routine with a classic for loop function HexToBinMahdiClassicFor(const HexValue: string): string; type TChar4 = array [0 .. 3] of Char; PChar4 = ^TChar4; const Table1: array ['0' .. '9'] of TChar4 = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001'); Table2: array ['a' .. 'f'] of TChar4 = ('1010', '1011', '1100', '1101', '1110', '1111'); var i, n: Integer; HexDigit: PChar; P: PChar4; begin n := Length(HexValue); SetLength(Result, n * 4); HexDigit := PChar(Pointer(HexValue)); P := PChar4(Result); for i := 1 to n do begin case HexDigit^ of '0' .. '9': P^ := Table1[HexDigit^]; 'a' .. 'f': P^ := Table2[HexDigit^]; 'A' .. 'F': P^ := Table2[Chr(Ord(HexDigit^) xor $20)]; else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(P); Inc(HexDigit); end; end; //***************** // Stefan's routine function HexToBinStefan(const HexValue: string): string; label _error; type TChar4 = array [0..3] of Char; PChar4 = ^TChar4; const Table: array [0..22] of TChar4 = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', // 0-9 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', // :-@ - unused '1010', '1011', '1100', '1101', '1110', '1111'); // A-F var len, i: Integer; HexDigit: PChar; P: PChar4; n: Cardinal; begin len := Length(HexValue); SetLength(Result, len * 4); P := PChar4(Result); HexDigit := @PChar(Pointer(HexValue))[0]; for i := 1 to len do begin n := Cardinal((Ord(HexDigit^) - 48) and not 32); {$B+} if ((n > 9) and (n < 15)) or (n > 22) then goto _error; {$B-} P^ := Table[n]; Inc(P); Inc(HexDigit); end; Exit; _error: raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit^, HexValue]); end; function HexToBinStefan2(const HexValue: string): string; label _error; type TChar4 = array [0..3] of Char; PChar4 = ^TChar4; const Table: array [0..22] of TChar4 = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', // 0-9 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', 'xxxx', // :-@ - unused '1010', '1011', '1100', '1101', '1110', '1111'); // A-F var len, i: Integer; HexDigit: PChar; P: PChar4; n: Cardinal; begin len := Length(HexValue); SetLength(Result, len * 4); P := PChar4(Result); HexDigit := @PChar(Pointer(HexValue))[0]; for i := 1 to len do begin // subtract 48 to make '0'-'9' 0-9 which enables unconditionally downcasing any upper case char n := Cardinal((Ord(HexDigit^) - 48) and not 32); {$B-} // avoid multiple conditional jumps by not using short eval // avoid one check by simply subtracting 10 and checking the invalid range of 10-16 // thank you godbolt.org and amazingly optimizing c++ compilers for that idea! <3 if (Cardinal(Integer(n)-10) <= 6) or (n > 22) then goto _error; {$B-} P^ := Table[n]; Inc(P); Inc(HexDigit); end; Exit; _error: raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit^, HexValue]); end; {$IFDEF CPUX86} //*********************** // Kas Ob's asm32 version procedure CharToBin_ASM32(HexChar: Char; HexBuffer: PChar); asm push edi mov edi,edx // Get the decimal value of one Hex Char (= half byte) movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar xor ecx,ecx mov dx,$1 test al,4 cmovne cx,dx shl ecx,16 test al,8 cmovne cx,dx add ecx,$00300030 mov [edi],ecx xor ecx,ecx test al,1 cmovne cx,dx shl ecx,16 test al,2 cmovne cx,dx add ecx,$00300030 mov [edi+4],ecx pop edi end; function HexToBinAsm32(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_ASM32(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; //********************* // Kas Ob's xmm version procedure CharToBin_XMM(HexChar: Char; HexBuffer: PChar); const DEC_TO_BIN_WORD_MASK: array[0..7] of UInt16 = ($01, $02,$00,$00, $04, $08, $00, $00); DEC_TO_BIN_FF_TO_CHARONE_DISTANCE: array[0..7] of UInt16 = ($FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF); DEC_TO_BIN_REVERSE_MASK: array[0..15] of Byte = (10, $80, 8, $80, 2, $80, 0, $80, $80, $80, $80, $80, $80, $80, $80, $80); asm movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar movd xmm0, eax pxor xmm1, xmm1 movdqu xmm2, DEC_TO_BIN_FF_TO_CHARONE_DISTANCE movdqu xmm3, DEC_TO_BIN_WORD_MASK movdqu xmm4,DEC_TO_BIN_REVERSE_MASK punpckldq xmm0, xmm0 packssdw xmm0, xmm0 pand xmm0, xmm3 pcmpeqw xmm0, xmm1 psubw xmm0, xmm2 PSHUFB xmm0, xmm4 // reverse the result movq qword ptr[HexBuffer], xmm0 end; function HexToBinXmm(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_XMM(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; {$ENDIF} //*************** // Benchmark code function RandomHexDigit: Char; var Ordinal: Integer; begin Ordinal := Random(16); case Ordinal of 0..9: Result := Chr(Ord('0') + Ordinal); 10..15: Result := Chr(Ord('a') + Ordinal - 10); else raise Exception.Create(''); end; end; function RandomHexString(Length: Integer): string; var Index: Integer; begin SetLength(Result, Length); for Index := 1 to Length do Result[Index] := RandomHexDigit; end; procedure TestCorrectness; var Index: Integer; HexStr, BinStr: string; begin for Index := 0 to $fffff do begin HexStr := IntToHex(Index, 6); BinStr := HexToBinHeffMove(HexStr); if BinStr<>HexToBinHeffInt64Assign(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinMahdi(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinMahdiClassicFor(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinStefan(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinStefan2(HexStr) then raise Exception.Create('incorrect implementation'); {$IFDEF CPUX86} if BinStr<>HexToBinAsm32(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinXmm(HexStr) then raise Exception.Create('incorrect implementation'); {$ENDIF} end; end; procedure Benchmark; var Index, Iteration: Integer; sw: TStopwatch; HexStrings: TArray<string>; binaryString: string; begin SetLength(HexStrings, InputDataCount); for Index := 0 to InputDataCount-1 do HexStrings[Index] := RandomHexString(HexStringLength); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinHeffMove(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Heff, move): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinHeffInt64Assign(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Heff, int64 assign): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinMahdi(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Mahdi): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinMahdiClassicFor(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Mahdi, classic for): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinStefan(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Stefan): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinStefan2(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Stefan mk 2): ', sw.ElapsedMilliseconds); {$IFDEF CPUX86} sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinAsm32(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('asm32: ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinXmm(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('xmm: ', sw.ElapsedMilliseconds); {$ENDIF} end; begin try Randomize; TestCorrectness; Benchmark; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Writeln('Completed'); Readln; end. 32 bit output: Pascal lookup (Heff, move): 4658 Pascal lookup (Heff, int64 assign): 3702 Pascal lookup (Mahdi): 3645 Pascal lookup (Mahdi, classic for): 2766 Pascal lookup (Stefan): 1024 Pascal lookup (Stefan mk 2): 805 asm32: 4165 xmm: 3978 64 bit output: Pascal lookup (Heff, move): 4720 Pascal lookup (Heff, int64 assign): 3138 Pascal lookup (Mahdi): 3221 Pascal lookup (Mahdi, classic for): 2629 Pascal lookup (Stefan): 1180 Pascal lookup (Stefan mk 2): 909
-
Should change all of the for ins to be fair
-
Not in the code produced so far. Small numbers are better here.
-
Updated benchmark code: {$APPTYPE CONSOLE} uses System.SysUtils, System.Classes, System.Diagnostics; //******************************************** // Constants to tune the benchmark performance const HexStringLength = 64; InputDataCount = 512; IterationCount = 20000; //***************************************************************** // David Heffernan's routine, with Move replace by Int64 assignment {$DEFINE ReplaceMoveWithInt64Assign} function HexToBinHeff(const HexValue: string): string; const BinaryValues: array [0..15] of string = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111' ); var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9': HexDigitValue := Ord(HexDigit) - Ord('0'); 'a'..'f': HexDigitValue := 10 + Ord(HexDigit) - Ord('a'); 'A'..'F': HexDigitValue := 10 + Ord(HexDigit) - Ord('A'); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; {$IFDEF ReplaceMoveWithInt64Assign} PInt64(Ptr)^ := PInt64(BinaryValues[HexDigitValue])^; {$ELSE} Move(Pointer(BinaryValues[HexDigitValue])^, Ptr^, 4 * SizeOf(Char)); {$ENDIF} Inc(Ptr, 4); end; end; //************************ // Mahdi Safsafi's routine {$DEFINE ReplaceMoveWithInt64Assign} function HexToBinMahdi(const HexValue: string): string; type TChar4 = array [0 .. 3] of Char; PChar4 = ^TChar4; const Table1: array ['0' .. '9'] of TChar4 = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001'); Table2: array ['a' .. 'f'] of TChar4 = ('1010', '1011', '1100', '1101', '1110', '1111'); var HexDigit: Char; P: PChar4; begin SetLength(Result, Length(HexValue) * 4); P := PChar4(Result); for HexDigit in HexValue do begin case HexDigit of '0' .. '9': P^ := Table1[HexDigit]; 'a' .. 'f': P^ := Table2[HexDigit]; 'A' .. 'F': P^ := Table2[Chr(Ord(HexDigit) xor $20)]; else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(P); end; end; {$IFDEF CPUX86} //*********************** // Kas Ob's asm32 version procedure CharToBin_ASM32(HexChar: Char; HexBuffer: PChar); asm push edi mov edi,edx // Get the decimal value of one Hex Char (= half byte) movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar xor ecx,ecx mov dx,$1 test al,4 cmovne cx,dx shl ecx,16 test al,8 cmovne cx,dx add ecx,$00300030 mov [edi],ecx xor ecx,ecx test al,1 cmovne cx,dx shl ecx,16 test al,2 cmovne cx,dx add ecx,$00300030 mov [edi+4],ecx pop edi end; function HexToBinAsm32(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_ASM32(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; //********************* // Kas Ob's xmm version procedure CharToBin_XMM(HexChar: Char; HexBuffer: PChar); const DEC_TO_BIN_WORD_MASK: array[0..7] of UInt16 = ($01, $02,$00,$00, $04, $08, $00, $00); DEC_TO_BIN_FF_TO_CHARONE_DISTANCE: array[0..7] of UInt16 = ($FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF); DEC_TO_BIN_REVERSE_MASK: array[0..15] of Byte = (10, $80, 8, $80, 2, $80, 0, $80, $80, $80, $80, $80, $80, $80, $80, $80); asm movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar movd xmm0, eax pxor xmm1, xmm1 movdqu xmm2, DEC_TO_BIN_FF_TO_CHARONE_DISTANCE movdqu xmm3, DEC_TO_BIN_WORD_MASK movdqu xmm4,DEC_TO_BIN_REVERSE_MASK punpckldq xmm0, xmm0 packssdw xmm0, xmm0 pand xmm0, xmm3 pcmpeqw xmm0, xmm1 psubw xmm0, xmm2 PSHUFB xmm0, xmm4 // reverse the result movq qword ptr[HexBuffer], xmm0 end; function HexToBinXmm(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_XMM(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; {$ENDIF} //*************** // Benchmark code function RandomHexDigit: Char; var Ordinal: Integer; begin Ordinal := Random(16); case Ordinal of 0..9: Result := Chr(Ord('0') + Ordinal); 10..15: Result := Chr(Ord('a') + Ordinal - 10); else raise Exception.Create(''); end; end; function RandomHexString(Length: Integer): string; var Index: Integer; begin SetLength(Result, Length); for Index := 1 to Length do Result[Index] := RandomHexDigit; end; procedure TestCorrectness; var Index: Integer; HexStr, BinStr: string; begin for Index := 0 to $fffff do begin HexStr := IntToHex(Index, 6); BinStr := HexToBinHeff(HexStr); if BinStr<>HexToBinMahdi(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinAsm32(HexStr) then raise Exception.Create('incorrect implementation'); if BinStr<>HexToBinXmm(HexStr) then raise Exception.Create('incorrect implementation'); end; end; procedure Benchmark; var Index, Iteration: Integer; sw: TStopwatch; HexStrings: TArray<string>; binaryString: string; begin SetLength(HexStrings, InputDataCount); for Index := 0 to InputDataCount-1 do HexStrings[Index] := RandomHexString(HexStringLength); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinHeff(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Heff): ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinMahdi(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup (Mahdi): ', sw.ElapsedMilliseconds); {$IFDEF CPUX86} sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinAsm32(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('asm32: ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to InputDataCount-1 do begin binaryString := HexToBinXmm(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('xmm: ', sw.ElapsedMilliseconds); {$ENDIF} end; begin try Randomize; TestCorrectness; Benchmark; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. OUTPUT: Pascal lookup (Heff): 3717 Pascal lookup (Mahdi): 3443 asm32: 4472 xmm: 4038 Although the output varies from run to run ofc. I think Stefan is right though. If you want to benefit from SIMD you need to process bigger chunks than a single hex digit at a time.
-
I understand, thanks
-
I'm still seeing an AV here even with that change. It would be really nice to get this fixed and then I can update my benchmark program again.
-
UPDATED BENCHMARK: {$APPTYPE CONSOLE} uses System.SysUtils, System.Classes, System.Diagnostics; //******************************************** // Constants to tune the benchmark performance const HexStringLength = 64; InputDataCount = 512; IterationCount = 20000; //***************************************************************** // David Heffernan's routine, with Move replace by Int64 assignment {$DEFINE ReplaceMoveWithInt64Assign} function HexToBin(const HexValue: string): string; const BinaryValues: array [0..15] of string = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111' ); var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9': HexDigitValue := Ord(HexDigit) - Ord('0'); 'a'..'f': HexDigitValue := 10 + Ord(HexDigit) - Ord('a'); 'A'..'F': HexDigitValue := 10 + Ord(HexDigit) - Ord('A'); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; {$IFDEF ReplaceMoveWithInt64Assign} PInt64(Ptr)^ := PInt64(BinaryValues[HexDigitValue])^; {$ELSE} Move(Pointer(BinaryValues[HexDigitValue])^, Ptr^, 4 * SizeOf(Char)); {$ENDIF} Inc(Ptr, 4); end; end; //*********************** // Kas Ob's asm32 version procedure CharToBin_ASM32(HexChar: Char; HexBuffer: PChar); asm push edi mov edi,edx // Get the decimal value of one Hex Char (= half byte) movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar xor ecx,ecx mov dx,$1 test al,4 cmovne cx,dx shl ecx,16 test al,8 cmovne cx,dx add ecx,$00300030 mov [edi],ecx xor ecx,ecx test al,1 cmovne cx,dx shl ecx,16 test al,2 cmovne cx,dx add ecx,$00300030 mov [edi+4],ecx pop edi end; function HexToBinAsm32(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_ASM32(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; //********************* // Kas Ob's xmm version procedure CharToBin_XMM(HexChar: Char; HexBuffer: PChar); const DEC_TO_BIN_WORD_MASK: array[0..7] of UInt16 = ($01, $02,$00,$00, $04, $08, $00, $00); DEC_TO_BIN_FF_TO_CHARONE_DISTANCE: array[0..7] of UInt16 = ($FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF, $FFCF); DEC_TO_BIN_REVERSE_MASK: array[0..15] of Byte = (10, $80, 8, $80, 2, $80, 0, $80, $80, $80, $80, $80, $80, $80, $80, $80); asm movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar movd xmm0, eax pxor xmm1, xmm1 movdqu xmm2, DEC_TO_BIN_FF_TO_CHARONE_DISTANCE punpckldq xmm0, xmm0 packssdw xmm0, xmm0 pand xmm0, dqword ptr[DEC_TO_BIN_WORD_MASK] pcmpeqw xmm0, xmm1 psubw xmm0, xmm2 movdqu xmm3,DEC_TO_BIN_REVERSE_MASK PSHUFB xmm0, xmm3 // reverse the result movq qword ptr[HexBuffer], xmm0 end; function HexToBinXmm(const HexValue: string): string; var HexDigit: Char; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_XMM(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; //*************** // Benchmark code function RandomHexDigit: Char; var Ordinal: Integer; begin Ordinal := Random(16); case Ordinal of 0..9: Result := Chr(Ord('0') + Ordinal); 10..15: Result := Chr(Ord('a') + Ordinal - 10); else raise Exception.Create(''); end; end; function RandomHexString(Length: Integer): string; var Index: Integer; begin SetLength(Result, Length); for Index := 1 to Length do Result[Index] := RandomHexDigit; end; procedure Benchmark; var Index, Iteration: Integer; sw: TStopwatch; HexStrings: TStringList; binaryString: string; begin HexStrings := TStringList.Create; try for Index := 0 to InputDataCount-1 do HexStrings.Add(RandomHexString(HexStringLength)); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to HexStrings.Count-1 do begin binaryString := HexToBin(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('Pascal lookup: ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to HexStrings.Count-1 do begin binaryString := HexToBinAsm32(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('asm32: ', sw.ElapsedMilliseconds); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to HexStrings.Count-1 do begin binaryString := HexToBinXmm(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln('xmm: ', sw.ElapsedMilliseconds); finally HexStrings.Free; end; end; begin try Randomize; Benchmark; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. Compiled on XE7, 32 bit, release configuration OUTPUT: Pascal lookup: 3743 asm32: 4396 EAccessViolation: Access violation at address 004D77D3 in module 'Project14.exe'. Read of address FFFFFFFF The AV is HexToBinXmm. Perhaps I misunderstood something.
-
I made this benchmark program, that wraps your single digit asm into a function that handles string input, and included error checking. If you skip the error checking then your asm code is faster. But if you include error checking, not so. How would you go about integrating your single digit code into a string level function with error checking? Also, I'd love to have a high level explanation as to why my reasoning that a lookup table should not be beaten is wrong. Or is it perhaps that the implementation of the lookup table could be done better? {$APPTYPE CONSOLE} uses System.SysUtils, System.Classes, System.Diagnostics; //******************************************** // Constants to tune the benchmark performance const HexStringLength = 64; InputDataCount = 512; IterationCount = 20000; //***************************************************************** // David Heffernan's routine, with Move replace by Int64 assignment {$DEFINE ReplaceMoveWithInt64Assign} function HexToBin(const HexValue: string): string; const BinaryValues: array [0..15] of string = ( '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111' ); var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9': HexDigitValue := Ord(HexDigit) - Ord('0'); 'a'..'f': HexDigitValue := 10 + Ord(HexDigit) - Ord('a'); 'A'..'F': HexDigitValue := 10 + Ord(HexDigit) - Ord('A'); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; {$IFDEF ReplaceMoveWithInt64Assign} PInt64(Ptr)^ := PInt64(BinaryValues[HexDigitValue])^; {$ELSE} Move(Pointer(BinaryValues[HexDigitValue])^, Ptr^, 4 * SizeOf(Char)); {$ENDIF} Inc(Ptr, 4); end; end; //********************* // Kas Ob's asm version procedure CharToBin_ASM32(HexChar: Char; HexBuffer: PChar); asm push edi mov edi,edx // Get the decimal value of one Hex Char (= half byte) movzx eax, HexChar mov ecx, 57 sub ecx, eax sar ecx, 31 and ecx, 39 neg ecx add eax, ecx add eax, - 48 // Produce 4 Chars presenting 4 bits of HexChar xor ecx,ecx mov dx,$1 test al,4 cmovne cx,dx shl ecx,16 test al,8 cmovne cx,dx add ecx,$00300030 mov [edi],ecx xor ecx,ecx test al,1 cmovne cx,dx shl ecx,16 test al,2 cmovne cx,dx add ecx,$00300030 mov [edi+4],ecx pop edi end; function HexToBinAsm(const HexValue: string): string; var HexDigit: Char; HexDigitValue: Integer; Ptr: PChar; begin SetLength(Result, Length(HexValue) * 4); Ptr := Pointer(Result); for HexDigit in HexValue do begin case HexDigit of '0'..'9','a'..'f','A'..'F': CharToBin_ASM32(HexDigit, Ptr); else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(Ptr, 4); end; end; //*************** // Benchmark code function RandomHexDigit: Char; var Ordinal: Integer; begin Ordinal := Random(16); case Ordinal of 0..9: Result := Chr(Ord('0') + Ordinal); 10..15: Result := Chr(Ord('a') + Ordinal - 10); else raise Exception.Create(''); end; end; function RandomHexString(Length: Integer): string; var Index: Integer; begin SetLength(Result, Length); for Index := 1 to Length do Result[Index] := RandomHexDigit; end; procedure Benchmark; var Index, Iteration: Integer; sw: TStopwatch; HexStrings: TStringList; binaryString: string; begin HexStrings := TStringList.Create; try for Index := 0 to InputDataCount-1 do HexStrings.Add(RandomHexString(HexStringLength)); sw := TStopwatch.StartNew; for Iteration := 0 to IterationCount-1 do for Index := 0 to HexStrings.Count-1 do begin binaryString := HexToBin(HexStrings[Index]); binaryString := ''; // force a reallocation of the string every iteration of this loop end; Writeln(sw.ElapsedMilliseconds); finally HexStrings.Free; end; end; begin try Randomize; Benchmark; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. EDIT: It turns out that this benchmark is possibly useless at the moment, because HexToBinAsm doesn't work correctly (almost certainly my fault). I need to work out what I've done wrong. EDIT2: No, it's fine, I was mistaken, HexToBinAsm above works correctly.
-
My benchmarking suggests that point 1 has no impact on performance, but point 2 does. Actually the suggestion made by @Kas Ob. to replace the Move in my code with PInt64(Ptr)^ := PInt64(BinaryValues[HexDigitValue])^ is all you need to match the performance of your version. Which makes a lot of sense to me.