program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function ZStartTime(var StartTime: Int64): Boolean; begin Result := QueryPerformanceCounter(StartTime); end; function PrintTime(time: Single): AnsiString; begin Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), '%f', time)); end; function ZStopTime(const StartTime: Int64; var time: Single): AnsiString; var iCounterPerSec, StopTime: Int64; begin if QueryPerformanceCounter(StopTime) then if QueryPerformanceFrequency(iCounterPerSec) then begin time := (0 - StartTime + StopTime) / iCounterPerSec; Writeln('Result: ', PrintTime(time), ' sec.'); end; end; function CompareTwoLines(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; begin Len := L[-1]; if Len <> R[-1] then exit(false); while (Len > 4) and ((L[0] = R[0]) and (L[1] = R[1])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; case Len of 3, 4: Result := ((L[0] = R[0]) and (L[1] = R[1])); 1, 2: Result := L[0] = R[0]; else Result := false; end; end; function Equals_UStr(Left, Right: PByte): Boolean; {$POINTERMATH ON} {$IF Defined(CPUX64) or Defined(CPUARM64)} {$DEFINE LARGEINT} {$ELSE} {$DEFINE SMALLINT} {$IFEND} label start, differs, equals; var Count: NativeUInt; L, R: PNativeUInt; begin if (Left = Right) then goto equals; if (Left = nil) or (Right = nil) then goto differs; L := Pointer(Left); R := Pointer(Right); Count := {$IFDEF SMALLINT}L{$ELSE .LARGEINT}PCardinal(L){$ENDIF}[-1]; if (Cardinal(Count) = {$IFDEF SMALLINT}R{$ELSE .LARGEINT}PCardinal(R){$ENDIF}[-1]) then begin start: case {$IFDEF SMALLINT}Count{$ELSE}(Count + 1) shr 1{$ENDIF} of 0: begin goto equals; end; {$IFDEF SMALLINT}1, 2{$ELSE}1{$ENDIF}: begin if (PCardinal(L)[0] <> PCardinal(R)[0]) then goto differs; goto equals; end; {$IFDEF SMALLINT}3, 4{$ELSE}2{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}5, 6{$ELSE}3{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} if (PCardinal(L)[2] <> PCardinal(R)[2]) then goto differs; goto equals; end; {$IFDEF SMALLINT}7, 8{$ELSE}4{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}9, 10{$ELSE}5{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} if (PCardinal(L)[4] <> PCardinal(R)[4]) then goto differs; goto equals; end; {$IFDEF SMALLINT}11, 12{$ELSE}6{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}13, 14{$ELSE}7{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} if (PCardinal(L)[6] <> PCardinal(R)[6]) then goto differs; goto equals; end; end; repeat dec(Count, 16); {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; if (L[6] <> R[6]) then goto differs; if (L[7] <> R[7]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ENDIF} Inc(NativeUInt(L), 32); Inc(NativeUInt(R), 32); until (NativeInt(Count) < 16); if (NativeInt(Count) > 0) then goto start; end else begin differs: Result := false; exit; end; equals: Result := true; end; Procedure StartTestCompareTwoLines(const S: string; var StartTime: Int64; var time: Single; var Max, Min: Single); var R, I: Integer; S2: string; begin S2 := Copy(S, 1); For R := 0 To 10 Do Begin if ZStartTime(StartTime) then begin for I := 0 to 10000000 do if not CompareTwoLines(Pointer(S), Pointer(S2)) then Writeln('Oops!'); ZStopTime(StartTime, time); if time > Max then Max := time; if time < Min then Min := time; end; End; end; Procedure StartTestEquals_UStr(const S: string; var StartTime: Int64; var time: Single; var Max2, Min2: Single); var R, I: Integer; S2: string; begin S2 := Copy(S, 1); For R := 0 To 10 Do Begin if ZStartTime(StartTime) then begin for I := 0 to 10000000 do if not Equals_UStr(Pointer(S), Pointer(S2)) then Writeln('Oops!'); ZStopTime(StartTime, time); if time > Max2 then Max2 := time; if time < Min2 then Min2 := time; end; End; end; var Temp: MarshaledString; I, R: Cardinal; StartTime: Int64; S: string; time: Single; Max, Max2, Min, Min2: Single; begin try Max := 0; Min := 90000; Max2 := 0; Min2 := 90000; S := 'hv45zvhvRTHzvhvhv45zvhvRTHzvhvhv45zvhvRTHzvhvhv45zvhvRTHzvhvzvhv45zvhvRTHzvhvzvzvhv45zvhvRTHzvhvzv15zvhv45zvhvRTHzvhvzvzvhv45zvhvRTHzvhvzv15'; Writeln('StartTestCompareTwoLines'); StartTestCompareTwoLines(S, StartTime, time, Max, Min); Writeln('Max : ', PrintTime(Max), ' -- Min: ', PrintTime(Min)); Writeln('StartTestEquals_UStr'); StartTestEquals_UStr(S, StartTime, time, Max2, Min2); Writeln('Max : ', PrintTime(Max2), ' -- Min: ', PrintTime(Min2)); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function ZStartTime(var StartTime: Int64): Boolean; begin Result := QueryPerformanceCounter(StartTime); end; function PrintTime(time: Single): AnsiString; begin Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), '%f', time)); end; function ZStopTime(const StartTime: Int64; var time: Single): AnsiString; var iCounterPerSec, StopTime: Int64; begin if QueryPerformanceCounter(StopTime) then if QueryPerformanceFrequency(iCounterPerSec) then begin time := (0 - StartTime + StopTime) / iCounterPerSec; Writeln('Result: ', PrintTime(time), ' sec.'); end; end; function CompareTwoLines(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; begin Len := L[-1]; if Len <> R[-1] then exit(false); while (Len > 4) and ((L[0] = R[0]) and (L[1] = R[1])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; case Len of 3, 4: Result := ((L[0] = R[0]) and (L[1] = R[1])); 1, 2: Result := L[0] = R[0]; else Result := false; end; end; function Equals_UStr(Left, Right: PByte): Boolean; {$POINTERMATH ON} {$IF Defined(CPUX64) or Defined(CPUARM64)} {$DEFINE LARGEINT} {$ELSE} {$DEFINE SMALLINT} {$IFEND} label start, differs, equals; var Count: NativeUInt; L, R: PNativeUInt; begin if (Left = Right) then goto equals; if (Left = nil) or (Right = nil) then goto differs; L := Pointer(Left); R := Pointer(Right); Count := {$IFDEF SMALLINT}L{$ELSE .LARGEINT}PCardinal(L){$ENDIF}[-1]; if (Cardinal(Count) = {$IFDEF SMALLINT}R{$ELSE .LARGEINT}PCardinal(R){$ENDIF}[-1]) then begin start: case {$IFDEF SMALLINT}Count{$ELSE}(Count + 1) shr 1{$ENDIF} of 0: begin goto equals; end; {$IFDEF SMALLINT}1, 2{$ELSE}1{$ENDIF}: begin if (PCardinal(L)[0] <> PCardinal(R)[0]) then goto differs; goto equals; end; {$IFDEF SMALLINT}3, 4{$ELSE}2{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}5, 6{$ELSE}3{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} if (PCardinal(L)[2] <> PCardinal(R)[2]) then goto differs; goto equals; end; {$IFDEF SMALLINT}7, 8{$ELSE}4{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}9, 10{$ELSE}5{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} if (PCardinal(L)[4] <> PCardinal(R)[4]) then goto differs; goto equals; end; {$IFDEF SMALLINT}11, 12{$ELSE}6{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}13, 14{$ELSE}7{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} if (PCardinal(L)[6] <> PCardinal(R)[6]) then goto differs; goto equals; end; end; repeat dec(Count, 16); {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; if (L[6] <> R[6]) then goto differs; if (L[7] <> R[7]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ENDIF} Inc(NativeUInt(L), 32); Inc(NativeUInt(R), 32); until (NativeInt(Count) < 16); if (NativeInt(Count) > 0) then goto start; end else begin differs: Result := false; exit; end; equals: Result := true; end; Procedure StartTestCompareTwoLines(var StartTime: Int64; var time: Single; var Max, Min: Single); var R, I: Integer; S1, S2: string; begin For R := 1 To 20 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if ZStartTime(StartTime) then begin for I := 0 to 10000000 do if not CompareTwoLines(Pointer(S1), Pointer(S2)) then Writeln('Oops!'); ZStopTime(StartTime, time); if time > Max then Max := time; if time < Min then Min := time; end; End; end; Procedure StartTestEquals_UStr(var StartTime: Int64; var time: Single; var Max2, Min2: Single); var R, I: Integer; S1, S2: string; begin For R := 1 To 20 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if ZStartTime(StartTime) then begin for I := 0 to 10000000 do if not Equals_UStr(Pointer(S1), Pointer(S2)) then Writeln('Oops!'); ZStopTime(StartTime, time); if time > Max2 then Max2 := time; if time < Min2 then Min2 := time; end; End; end; var Temp: MarshaledString; I, R: Cardinal; StartTime: Int64; time: Single; Max, Max2, Min, Min2: Single; begin try Max := 0; Min := 90000; Max2 := 0; Min2 := 90000; Writeln('StartTestCompareTwoLines'); StartTestCompareTwoLines(StartTime, time, Max, Min); Writeln('Max : ', PrintTime(Max), ' -- Min: ', PrintTime(Min)); Writeln('StartTestEquals_UStr'); StartTestEquals_UStr(StartTime, time, Max2, Min2); Writeln('Max : ', PrintTime(Max2), ' -- Min: ', PrintTime(Min2)); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
function CompareTwoLines(L, R: PCardinal; Len: Cardinal): Boolean; inline; {$POINTERMATH ON} begin while (Len > 4) and ((L[0] = R[0]) and (L[1] = R[1])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; case Len of 3, 4: Result := ((L[0] = R[0]) and (L[1] = R[1])); 1, 2: Result := L[0] = R[0]; else Result := false; end; end;
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLines(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function Equals_UStr(Left, Right: PByte): Boolean; {$POINTERMATH ON} {$IF Defined(CPUX64) or Defined(CPUARM64)} {$DEFINE LARGEINT} {$ELSE} {$DEFINE SMALLINT} {$IFEND} label start, differs, equals; var Count: NativeUInt; L, R: PNativeUInt; begin if (Left = Right) then goto equals; if (Left = nil) or (Right = nil) then goto differs; L := Pointer(Left); R := Pointer(Right); Count := {$IFDEF SMALLINT}L{$ELSE .LARGEINT}PCardinal(L){$ENDIF}[-1]; if (Cardinal(Count) = {$IFDEF SMALLINT}R{$ELSE .LARGEINT}PCardinal(R){$ENDIF}[-1]) then begin start: case {$IFDEF SMALLINT}Count{$ELSE}(Count + 1) shr 1{$ENDIF} of 0: begin goto equals; end; {$IFDEF SMALLINT}1, 2{$ELSE}1{$ENDIF}: begin if (PCardinal(L)[0] <> PCardinal(R)[0]) then goto differs; goto equals; end; {$IFDEF SMALLINT}3, 4{$ELSE}2{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}5, 6{$ELSE}3{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} if (PCardinal(L)[2] <> PCardinal(R)[2]) then goto differs; goto equals; end; {$IFDEF SMALLINT}7, 8{$ELSE}4{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}9, 10{$ELSE}5{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} if (PCardinal(L)[4] <> PCardinal(R)[4]) then goto differs; goto equals; end; {$IFDEF SMALLINT}11, 12{$ELSE}6{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}13, 14{$ELSE}7{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} if (PCardinal(L)[6] <> PCardinal(R)[6]) then goto differs; goto equals; end; end; repeat dec(Count, 16); {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; if (L[6] <> R[6]) then goto differs; if (L[7] <> R[7]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ENDIF} inc(NativeUInt(L), 32); inc(NativeUInt(R), 32); until (NativeInt(Count) < 16); if (NativeInt(Count) > 0) then goto start; end else begin differs: Result := false; exit; end; equals: Result := true; end; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function PrintTime(time: Single): AnsiString; begin Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), '%f', time)); end; Type TSpeedTest = array [0 .. 1, 0 .. 32] of Variant; var SpeedTestBase: TSpeedTest; Procedure StartTestCompareTwoLines(const str: string; var StartTime: Int64); var R, I, rht: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[0][0] := str; SpeedTestBase[0][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not CompareTwoLines(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[0][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[0][31] < SpeedTestBase[0][R] then SpeedTestBase[0][31] := SpeedTestBase[0][R]; if SpeedTestBase[0][32] > SpeedTestBase[0][R] then SpeedTestBase[0][32] := SpeedTestBase[0][R]; end; End; end; Procedure StartTestEquals_UStr(const str: string; var StartTime: Int64); var R, I: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[1][0] := str; SpeedTestBase[1][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not Equals_UStr(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[1][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[1][31] < SpeedTestBase[1][R] then SpeedTestBase[1][31] := SpeedTestBase[1][R]; if SpeedTestBase[1][32] > SpeedTestBase[1][R] then SpeedTestBase[1][32] := SpeedTestBase[1][R]; end; End; end; var I: Cardinal; StartTime: Int64; A, B: Single; begin try {$IF Defined(CPUX64) or Defined(CPUARM64)} {$IFNDEF DEBUG} Writeln('Release 64bit'); {$ELSE} Writeln('Debug 64bit'); {$ENDIF} {$ELSE} {$IFNDEF DEBUG} Writeln('Release 32Bit'); {$ELSE} Writeln('Debug 32Bit'); {$ENDIF} {$IFEND} StartTestCompareTwoLines('CompareTwoLines', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[0][31]), ' Min: ', PrintTime(SpeedTestBase[0][32])); StartTestEquals_UStr('Equals_UStr', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[1][31]), ' Min: ', PrintTime(SpeedTestBase[1][32])); Writeln(SpeedTestBase[0][0], ' VS ', SpeedTestBase[1][0]); for I := 1 to 30 do begin A := SpeedTestBase[0][I]; B := SpeedTestBase[1][I]; write(PrintTime(A), ' | ', PrintTime(B), ' ) '); if A > B then write(SpeedTestBase[1][0] + ' + ' + PrintTime(A - B)) else write(SpeedTestBase[0][0] + ' + ' + PrintTime(B - A)); Writeln(' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function Equals_UStr(Left, Right: PByte): Boolean; {$POINTERMATH ON} {$IF Defined(CPUX64) or Defined(CPUARM64)} {$DEFINE LARGEINT} {$ELSE} {$DEFINE SMALLINT} {$IFEND} label start, differs, equals; var Count: NativeUInt; L, R: PNativeUInt; begin if (Left = Right) then goto equals; if (Left = nil) or (Right = nil) then goto differs; L := Pointer(Left); R := Pointer(Right); Count := {$IFDEF SMALLINT}L{$ELSE .LARGEINT}PCardinal(L){$ENDIF}[-1]; if (Cardinal(Count) = {$IFDEF SMALLINT}R{$ELSE .LARGEINT}PCardinal(R){$ENDIF}[-1]) then begin start: case {$IFDEF SMALLINT}Count{$ELSE}(Count + 1) shr 1{$ENDIF} of 0: begin goto equals; end; {$IFDEF SMALLINT}1, 2{$ELSE}1{$ENDIF}: begin if (PCardinal(L)[0] <> PCardinal(R)[0]) then goto differs; goto equals; end; {$IFDEF SMALLINT}3, 4{$ELSE}2{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}5, 6{$ELSE}3{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} if (PCardinal(L)[2] <> PCardinal(R)[2]) then goto differs; goto equals; end; {$IFDEF SMALLINT}7, 8{$ELSE}4{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}9, 10{$ELSE}5{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} if (PCardinal(L)[4] <> PCardinal(R)[4]) then goto differs; goto equals; end; {$IFDEF SMALLINT}11, 12{$ELSE}6{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}13, 14{$ELSE}7{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} if (PCardinal(L)[6] <> PCardinal(R)[6]) then goto differs; goto equals; end; end; repeat dec(Count, 16); {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; if (L[6] <> R[6]) then goto differs; if (L[7] <> R[7]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ENDIF} Inc(NativeUInt(L), 32); Inc(NativeUInt(R), 32); until (NativeInt(Count) < 16); if (NativeInt(Count) > 0) then goto start; end else begin differs: Result := false; exit; end; equals: Result := true; end; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function PrintTime(time: Single): AnsiString; begin Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), '%f', time)); end; Type TSpeedTest = array [0 .. 1, 0 .. 32] of Variant; var SpeedTestBase: TSpeedTest; Procedure StartTestCompareTwoLines(idx: byte; str: string; var StartTime: Int64); var R, I, rht: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[idx][0] := str; SpeedTestBase[idx][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not Equals_UStr(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[idx][31] < SpeedTestBase[idx][R] then SpeedTestBase[idx][31] := SpeedTestBase[idx][R]; if SpeedTestBase[idx][32] > SpeedTestBase[idx][R] then SpeedTestBase[idx][32] := SpeedTestBase[idx][R]; end; End; end; Procedure StartTestEquals_UStr(idx: byte; const str: string; var StartTime: Int64); var R, I, rht: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[idx][0] := str; SpeedTestBase[idx][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not CompareTwoLinesFast(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[idx][31] < SpeedTestBase[idx][R] then SpeedTestBase[idx][31] := SpeedTestBase[idx][R]; if SpeedTestBase[idx][32] > SpeedTestBase[idx][R] then SpeedTestBase[idx][32] := SpeedTestBase[idx][R]; end; End; end; var I: Cardinal; StartTime: Int64; A, B: Single; begin try {$IF Defined(CPUX64) or Defined(CPUARM64)} {$IFNDEF DEBUG} Writeln('Release 64bit'); {$ELSE} Writeln('Debug 64bit'); {$ENDIF} {$ELSE} {$IFNDEF DEBUG} Writeln('Release 32Bit'); {$ELSE} Writeln('Debug 32Bit'); {$ENDIF} {$IFEND} StartTestEquals_UStr(0, 'CompareTwoLinesFast', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[0][31]), ' Min: ', PrintTime(SpeedTestBase[0][32])); StartTestCompareTwoLines(1, 'CompareTwoLines', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[1][31]), ' Min: ', PrintTime(SpeedTestBase[1][32])); Writeln(SpeedTestBase[0][0], ' VS ', SpeedTestBase[1][0]); for I := 1 to 30 do begin A := SpeedTestBase[0][I]; B := SpeedTestBase[1][I]; write(PrintTime(A), ' | ', PrintTime(B), ' ) '); if A > B then write(SpeedTestBase[1][0] + ' + ' + PrintTime(A - B)) else write(SpeedTestBase[0][0] + ' + ' + PrintTime(B - A)); Writeln(' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function Equals_UStr(Left, Right: PByte): Boolean; {$POINTERMATH ON} {$IF Defined(CPUX64) or Defined(CPUARM64)} {$DEFINE LARGEINT} {$ELSE} {$DEFINE SMALLINT} {$IFEND} label start, differs, equals; var Count: NativeUInt; L, R: PNativeUInt; begin if (Left = Right) then goto equals; if (Left = nil) or (Right = nil) then goto differs; L := Pointer(Left); R := Pointer(Right); Count := {$IFDEF SMALLINT}L{$ELSE .LARGEINT}PCardinal(L){$ENDIF}[-1]; if (Cardinal(Count) = {$IFDEF SMALLINT}R{$ELSE .LARGEINT}PCardinal(R){$ENDIF}[-1]) then begin start: case {$IFDEF SMALLINT}Count{$ELSE}(Count + 1) shr 1{$ENDIF} of 0: begin goto equals; end; {$IFDEF SMALLINT}1, 2{$ELSE}1{$ENDIF}: begin if (PCardinal(L)[0] <> PCardinal(R)[0]) then goto differs; goto equals; end; {$IFDEF SMALLINT}3, 4{$ELSE}2{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}5, 6{$ELSE}3{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; {$ENDIF} if (PCardinal(L)[2] <> PCardinal(R)[2]) then goto differs; goto equals; end; {$IFDEF SMALLINT}7, 8{$ELSE}4{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}9, 10{$ELSE}5{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; {$ENDIF} if (PCardinal(L)[4] <> PCardinal(R)[4]) then goto differs; goto equals; end; {$IFDEF SMALLINT}11, 12{$ELSE}6{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} goto equals; end; {$IFDEF SMALLINT}13, 14{$ELSE}7{$ENDIF}: begin {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; {$ENDIF} if (PCardinal(L)[6] <> PCardinal(R)[6]) then goto differs; goto equals; end; end; repeat dec(Count, 16); {$IFDEF SMALLINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; if (L[4] <> R[4]) then goto differs; if (L[5] <> R[5]) then goto differs; if (L[6] <> R[6]) then goto differs; if (L[7] <> R[7]) then goto differs; {$ELSE .LARGEINT} if (L[0] <> R[0]) then goto differs; if (L[1] <> R[1]) then goto differs; if (L[2] <> R[2]) then goto differs; if (L[3] <> R[3]) then goto differs; {$ENDIF} Inc(NativeUInt(L), 32); Inc(NativeUInt(R), 32); until (NativeInt(Count) < 16); if (NativeInt(Count) > 0) then goto start; end else begin differs: Result := false; exit; end; equals: Result := true; end; function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs; external 'msvcrt.dll'; function PrintTime(time: Single): AnsiString; begin Result := ''; SetLength(Result, 25); SetLength(Result, sprintf(PAnsiChar(Result), '%f', time)); end; Type TSpeedTest = array [0 .. 1, 0 .. 32] of Variant; var SpeedTestBase: TSpeedTest; Procedure StartTestCompareTwoLines(idx: byte; str: string; var StartTime: Int64); var R, I, rht: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[idx][0] := str; SpeedTestBase[idx][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not CompareTwoLinesFast(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[idx][31] < SpeedTestBase[idx][R] then SpeedTestBase[idx][31] := SpeedTestBase[idx][R]; if SpeedTestBase[idx][32] > SpeedTestBase[idx][R] then SpeedTestBase[idx][32] := SpeedTestBase[idx][R]; end; End; end; Procedure StartTestEquals_UStr(idx: byte; const str: string; var StartTime: Int64); var R, I, rht: Integer; S1, S2: string; iCounterPerSec, StopTime: Int64; begin Writeln(str); SpeedTestBase[idx][0] := str; SpeedTestBase[idx][32] := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not Equals_UStr(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if SpeedTestBase[idx][31] < SpeedTestBase[idx][R] then SpeedTestBase[idx][31] := SpeedTestBase[idx][R]; if SpeedTestBase[idx][32] > SpeedTestBase[idx][R] then SpeedTestBase[idx][32] := SpeedTestBase[idx][R]; end; End; end; var I: Cardinal; StartTime: Int64; A, B: Single; begin try {$IF Defined(CPUX64) or Defined(CPUARM64)} {$IFNDEF DEBUG} Writeln('Release 64bit'); {$ELSE} Writeln('Debug 64bit'); {$ENDIF} {$ELSE} {$IFNDEF DEBUG} Writeln('Release 32Bit'); {$ELSE} Writeln('Debug 32Bit'); {$ENDIF} {$IFEND} StartTestEquals_UStr(0, 'TestEquals_UStr', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[0][31]), ' Min: ', PrintTime(SpeedTestBase[0][32])); StartTestCompareTwoLines(1, 'CompareTwoLinesFast', StartTime); Writeln('Max: ', PrintTime(SpeedTestBase[1][31]), ' Min: ', PrintTime(SpeedTestBase[1][32])); Writeln(SpeedTestBase[0][0], ' VS ', SpeedTestBase[1][0]); for I := 1 to 30 do begin A := SpeedTestBase[0][I]; B := SpeedTestBase[1][I]; write(PrintTime(A), ' | ', PrintTime(B), ' ) '); if A > B then write(SpeedTestBase[1][0] + ' + ' + PrintTime(A - B)) else write(SpeedTestBase[0][0] + ' + ' + PrintTime(B - A)); Writeln(' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project2; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; procedure Test(S, S2: string); {$POINTERMATH ON} var L, R: PCardinal; begin L := Pointer(S); R := Pointer(S2); if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then Writeln(' Ой! ') else Writeln('Ы - ыы'); end; var S, S2: string; L, R: PCardinal; begin try Test('', ''); Test('', 'Право руля'); Test('Лево руля', ''); Writeln(' ----- '); Test('УтюТю', 'УтюТю'); Writeln(' ----- '); Test('Отпоркавать', 'Место Капитана'); Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
program Project2; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; procedure Test(S, S2: string); {$POINTERMATH ON} var L, R: PCardinal; IsB: Boolean; begin L := Pointer(S); R := Pointer(S2); if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then IsB := L = R else IsB := true; if IsB then Writeln(' Ой! ') else Writeln('Ы - ыы'); end; var S, S2: string; L, R: PCardinal; begin try Test('', ''); Test('', 'Право руля'); Test('Лево руля', ''); Writeln(' ----- '); Test('УтюТю', 'УтюТю'); Writeln(' ----- '); Test('Отпоркавать', 'Место Капитана'); Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var len: integer; begin Result:=(L=R); if (L<>nil) and (R<>nil) and (L<>R) then begin; len:=L[-1]; if len=integer(R[-1]) then begin; while len>=31 do begin; if (L[15]<>R[15]) or (L[0]<>R[0]) or (L[1]<>R[1]) or (L[2]<>R[2]) or (L[3]<>R[3]) or (L[4]<>R[4]) or (L[5]<>R[5]) or (L[6]<>R[6]) or (L[7]<>R[7]) or (L[8]<>R[8]) or (L[9]<>R[9]) or (L[10]<>R[10]) or (L[11]<>R[11]) or (L[12]<>R[12]) or (L[13]<>R[13]) or (L[14]<>R[14]) then exit; inc(L, 16); inc(R, 16); dec(len, 32); end; if Len>=15 then begin; if (L[7]<>R[7]) or (L[0]<>R[0]) or (L[1]<>R[1]) or (L[2]<>R[2]) or (L[3]<>R[3]) or (L[4]<>R[4]) or (L[5]<>R[5]) or (L[6]<>R[6]) then exit; inc(L, 8); inc(R, 8); dec(len, 16); end; if Len>=7 then begin; if (L[3]<>R[3]) or (L[0]<>R[0]) or (L[1]<>R[1]) or (L[2]<>R[2]) then exit; inc(L, 4); inc(R, 4); dec(len, 8); end; if (Len<=0) or (L[0]=R[0]) or (Len>=3) and (L[1]=R[1]) or (Len>=5) and (L[2]=R[2]) then Result:=true; end; end; end;
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; {$POINTERMATH ON} var Len: integer; begin Result := (L = R); if (L <> nil) and (R <> nil) and (L <> R) then begin; Len := L[-1]; if Len = integer(R[-1]) then begin; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then exit; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then exit; inc(L, 8); inc(R, 8); dec(Len, 16); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then exit; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) or (Len >= 3) and (L[1] = R[1]) or (Len >= 5) and (L[2] = R[2]) then Result := true; end; end; end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 1, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; Procedure TimeCallBack(const Func: Pointer; idx: byte; str: string; var StartTime: Int64); Type TestCall = function(a, b: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; Max, Min: Single; begin Writeln(str); SpeedTestBase[idx][0] := str; Min := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[idx][R] then Max := SpeedTestBase[idx][R]; if Min > SpeedTestBase[idx][R] then Min := SpeedTestBase[idx][R]; end; End; Writeln('Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; var I: Cardinal; StartTime: Int64; a, b: Single; S1, S2: string; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try S1 := 'uhiuhiuhiugyuu'; S2 := 'uhiuhiuhiugxxx'; if not CompareTwoLinesFast2(Pointer(S1), Pointer(S2)) then begin Writeln(S2); end; { TimeCallBack(@CompareTwoLinesFast2, 0, 'Fast2', StartTime); TimeCallBack(@CompareTwoLinesFast, 1, 'Fast', StartTime); Writeln(SpeedTestBase[0][0], ' VS ', SpeedTestBase[1][0]); for I := 1 to 30 do begin a := SpeedTestBase[0][I]; b := SpeedTestBase[1][I]; write(PrintTime(a), ' | ', PrintTime(b), ' ) '); if a > b then write(SpeedTestBase[1][0] + ' + ' + PrintTime(a - b)) else write(SpeedTestBase[0][0] + ' + ' + PrintTime(b - a)); Writeln(' Speed'); end; } except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
function SSESameString(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c @@l8c: movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] pxor xmm0, xmm1 ptest xmm0, xmm0 jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c @@exit: xor eax, eax test ecx, ecx setz al pop ebx end;
function IsSSE41Supported: Boolean; asm push ebx xor eax, eax inc eax cpuid xor eax, eax rcr ecx, 20 setc al pop ebx end;
function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L=R then goto EQ; if (L=nil) or (R=nil) then goto NE; Len:=L[-1]; if Len<>integer(R[-1]) then goto NE; while Len>=31 do begin; if (L[15]<>R[15]) or (L[0]<>R[0]) or (L[1]<>R[1]) or (L[2]<>R[2]) or (L[3]<>R[3]) or (L[4]<>R[4]) or (L[5]<>R[5]) or (L[6]<>R[6]) or (L[7]<>R[7]) or (L[8]<>R[8]) or (L[9]<>R[9]) or (L[10]<>R[10]) or (L[11]<>R[11]) or (L[12]<>R[12]) or (L[13]<>R[13]) or (L[14]<>R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len>=7 then begin; if (L[3]<>R[3]) or (L[0]<>R[0]) or (L[1]<>R[1]) or (L[2]<>R[2]) then goto NE; if Len>=15 then begin; if (L[7]<>R[7]) or (L[4]<>R[4]) or (L[5]<>R[5]) or (L[6]<>R[6]) then goto NE; if Len>=23 then begin; if (L[11]<>R[11]) or (L[8]<>R[8]) or (L[9]<>R[9]) or (L[10]<>R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len<=0) or (L[0]=R[0]) and ((Len<=2) or (L[1]=R[1]) and ((Len<=4) or (L[2]=R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end;
function SSESameString(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result {.$DEFINE SSE41} {.$DEFINE UNALIGNED} asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end;
{$DEFINE Align16Bytes}
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; {$POINTERMATH ON} var Len: integer; begin Result := (L = R); if (L <> nil) and (R <> nil) and (L <> R) then begin; Len := L[-1]; if Len = integer(R[-1]) then begin; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then exit; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then exit; inc(L, 8); inc(R, 8); dec(Len, 16); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then exit; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) or (Len >= 3) and (L[1] = R[1]) or (Len >= 5) and (L[2] = R[2]) then Result := true; end; end; end; function SSESameString(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } {$DEFINE UNALIGNED} {.$DEFINE Align16Bytes} asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 3, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; Procedure TimeCallBack(const Func: Pointer; idx: byte; str: string; var StartTime: Int64); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; Max, Min: Single; begin SpeedTestBase[idx][0] := str; Min := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[idx][R] then Max := SpeedTestBase[idx][R]; if Min > SpeedTestBase[idx][R] then Min := SpeedTestBase[idx][R]; end; End; Writeln(str, ' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; var I, F: Cardinal; StartTime: Int64; A, B, V, R, C, K: Single; Name: string; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try TimeCallBack(@CompareTwoLinesFast, 0, 'Fast', StartTime); TimeCallBack(@CompareTwoLinesFast2, 1, 'Fast2', StartTime); TimeCallBack(@SSESameString, 2, 'SSESameString', StartTime); for I := 1 to 30 do begin C := 900; K := 0; for F := 0 to 3 - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } {$DEFINE UNALIGNED} { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 3, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; Procedure TimeCallBack(const Func: Pointer; idx: byte; str: string; var StartTime: Int64); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; Max, Min: Single; begin SpeedTestBase[idx][0] := str; Min := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[idx][R] then Max := SpeedTestBase[idx][R]; if Min > SpeedTestBase[idx][R] then Min := SpeedTestBase[idx][R]; end; End; Writeln(str, ' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; var I, F: Cardinal; StartTime: Int64; A, B, V, R, C, K: Single; Name: string; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try TimeCallBack(@CompareTwoLinesFast, 0, 'Fast', StartTime); TimeCallBack(@CompareTwoLinesFast2, 1, 'Fast2', StartTime); TimeCallBack(@SSESameString, 2, 'SSESameString', StartTime); for I := 1 to 30 do begin C := 900; K := 0; for F := 0 to 3 - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program StrTest; {$APPTYPE CONSOLE} {$R *.res} uses FastMM4, windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } {.$DEFINE UNALIGNED} asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 3, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; Procedure TimeCallBack(const Func: Pointer; idx: byte; str: string; var StartTime: Int64); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; Max, Min: Single; begin SpeedTestBase[idx][0] := str; Min := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[idx][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[idx][R] then Max := SpeedTestBase[idx][R]; if Min > SpeedTestBase[idx][R] then Min := SpeedTestBase[idx][R]; end; End; Writeln(str, ' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; var I, F: Cardinal; StartTime: Int64; A, B, V, R, C, K: Single; Name: string; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try TimeCallBack(@CompareTwoLinesFast, 0, 'Fast', StartTime); TimeCallBack(@CompareTwoLinesFast2, 1, 'Fast2', StartTime); TimeCallBack(@SSESameString, 2, 'SSESameString', StartTime); for I := 1 to 30 do begin C := 900; K := 0; for F := 0 to 3 - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(const A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } {.$DEFINE UNALIGNED} { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 50, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; RealSizeBase: integer = 0; Procedure TimeCallBack(const Func: Pointer; str: string); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; StartTime: Int64; Max, Min: Single; begin SpeedTestBase[RealSizeBase][0] := str; Min := 90000; For R := 1 To 30 Do Begin S1 := StringOfChar('X', R * 2); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[RealSizeBase][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[RealSizeBase][R] then Max := SpeedTestBase[RealSizeBase][R]; if Min > SpeedTestBase[RealSizeBase][R] then Min := SpeedTestBase[RealSizeBase][R]; end; End; inc(RealSizeBase); Writeln(str, ' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; procedure PrintTimeALlResult; var I, F: Cardinal; A, B, V, R, C, K: Single; Name: string; begin for I := 1 to 30 do begin C := 900; K := 0; for F := 0 to RealSizeBase - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; end; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try TimeCallBack(@CompareTwoLinesFast, 'Fast'); TimeCallBack(@CompareTwoLinesFast2, 'Fast2'); TimeCallBack(@SSESameString, 'SSESameString'); PrintTimeALlResult; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
try SetMinimumBlockAlignment(mba16Byte); TimeCallBack(@CompareTwoLinesFast, 'Fast'); TimeCallBack(@CompareTwoLinesFast2, 'Fast2'); TimeCallBack(@SSESameString, 'SSESameString'); PrintTimeALlResult; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end;
function SSESameString(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx sub edx, eax jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [eax + edx - 4] jnz @@exit // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit dec ecx jz @@exit dec ecx jz @@exit lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c xor ecx, ecx // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebx ret // -- check partial mask @@mask: dw $0000, $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 8 jae @@false movzx edx, word ptr [@@mask + ecx * 2] and ebx, edx cmp ebx, edx setz al @@false: pop ebx end; ... S1 := StringOfChar('X', R * 2) + '1'; S2 := StringOfChar('X', R * 2) + '2'; if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do TestCall(Func)(Pointer(S1), Pointer(S2)); ...
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(const A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } { .$DEFINE UNALIGNED } { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function SSESameString2(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx sub edx, eax jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [eax + edx - 4] jnz @@exit // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit dec ecx jz @@exit dec ecx jz @@exit lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c xor ecx, ecx // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebx ret // -- check partial mask @@mask: dw $0000, $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 8 jae @@false movzx edx, word ptr [@@mask + ecx * 2] and ebx, edx cmp ebx, edx setz al @@false: pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 50, 0 .. 30] of Variant; var SpeedTestBase: TSpeedTest; RealSizeBase: integer = 0; Procedure TimeCallBack(const Func: Pointer; str: string); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; StartTime: Int64; Max, Min: Single; begin SpeedTestBase[RealSizeBase][0] := str; Min := 90000; For R := 1 To 80 Do Begin S1 := StringOfChar('X', R); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[RealSizeBase][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[RealSizeBase][R] then Max := SpeedTestBase[RealSizeBase][R]; if Min > SpeedTestBase[RealSizeBase][R] then Min := SpeedTestBase[RealSizeBase][R]; end; End; inc(RealSizeBase); Writeln(str, ' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; procedure PrintTimeALlResult; var I, F: Cardinal; A, B, V, R, C, K: Single; Name: string; begin for I := 1 to 30 do begin C := 900; K := 0; for F := 0 to RealSizeBase - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; end; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try SetMinimumBlockAlignment(mba16Byte); TimeCallBack(@CompareTwoLinesFast, 'Fast'); TimeCallBack(@CompareTwoLinesFast2, 'Fast2'); TimeCallBack(@SSESameString, 'SSESameString'); TimeCallBack(@SSESameString, 'SSESameString2'); PrintTimeALlResult; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(const A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } { .$DEFINE UNALIGNED } { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function SSESameString2(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx sub edx, eax jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [eax + edx - 4] jnz @@exit // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit dec ecx jz @@exit dec ecx jz @@exit lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c xor ecx, ecx // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebx ret // -- check partial mask @@mask: dw $0000, $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 8 jae @@false movzx edx, word ptr [@@mask + ecx * 2] and ebx, edx cmp ebx, edx setz al @@false: pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 50, 0 .. 200] of Variant; var SpeedTestBase: TSpeedTest; RealSizeBase: integer = 0; SizeTestBase: integer = 80; Procedure TimeCallBack(const Func: Pointer; str: string); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; StartTime: Int64; Max, Min: Single; begin write(str); SpeedTestBase[RealSizeBase][0] := str; Min := 90000; For R := 1 To SizeTestBase Do Begin S1 := StringOfChar('X', R); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[RealSizeBase][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[RealSizeBase][R] then Max := SpeedTestBase[RealSizeBase][R]; if Min > SpeedTestBase[RealSizeBase][R] then Min := SpeedTestBase[RealSizeBase][R]; end; End; inc(RealSizeBase); Writeln(' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; procedure PrintTimeALlResult; var I, F: Cardinal; A, B, V, R, C, K: Single; Name: string; begin for I := 1 to SizeTestBase do begin C := 900; K := 0; for F := 0 to RealSizeBase - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') ', Name, ' + ', PrintTime(K - C), ' Speed'); end; end; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try SetMinimumBlockAlignment(mba16Byte); TimeCallBack(@CompareTwoLinesFast, 'Fast'); TimeCallBack(@CompareTwoLinesFast2, 'Fast2'); TimeCallBack(@SSESameString, 'SSESameString'); TimeCallBack(@SSESameString, 'SSESameString2'); PrintTimeALlResult; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; h, h2: Boolean; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(const A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } { .$DEFINE UNALIGNED } { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function SSESameString2(A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx sub edx, eax jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [eax + edx - 4] jnz @@exit // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit dec ecx jz @@exit dec ecx jz @@exit lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c xor ecx, ecx // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebx ret // -- check partial mask @@mask: dw $0000, $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 8 jae @@false movzx edx, word ptr [@@mask + ecx * 2] and ebx, edx cmp ebx, edx setz al @@false: pop ebx end; function PrintTime(time: Single): AnsiString; inline; begin Result := Format('%.6f', [time]); end; Type TSpeedTest = array [0 .. 50, 0 .. 200] of Variant; var SpeedTestBase: TSpeedTest; RealSizeBase: integer = 0; SizeTestBase: integer = 80; Procedure TimeCallBack(const Func: Pointer; str: string); Type TestCall = function(A, B: Pointer): Boolean; var R, I, rht: integer; S1, S2: string; iCounterPerSec, StopTime: Int64; StartTime: Int64; Max, Min: Single; begin write(str); SpeedTestBase[RealSizeBase][0] := str; Min := 90000; For R := 1 To SizeTestBase Do Begin S1 := StringOfChar('X', R); S2 := Copy(S1, 1); if QueryPerformanceCounter(StartTime) then begin for I := 0 to 10000000 do if not TestCall(Func)(Pointer(S1), Pointer(S2)) then begin Writeln(S2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then SpeedTestBase[RealSizeBase][R] := (0 - StartTime + StopTime) / iCounterPerSec; if Max < SpeedTestBase[RealSizeBase][R] then Max := SpeedTestBase[RealSizeBase][R]; if Min > SpeedTestBase[RealSizeBase][R] then Min := SpeedTestBase[RealSizeBase][R]; end; End; inc(RealSizeBase); Writeln(' Max: ', PrintTime(Max), ' Min: ', PrintTime(Min)); end; procedure PrintTimeALlResult; var I, F: Cardinal; A, B, V, R, C, K: Single; Name: string; begin for I := 1 to SizeTestBase do begin C := 900; K := 0; for F := 0 to RealSizeBase - 1 do begin R := SpeedTestBase[F][I]; if F <> 0 then write(' | '); if R < C then begin C := R; Name := SpeedTestBase[F][0]; end; if K < R then K := R; write(PrintTime(R)); end; Writeln(') + ', PrintTime(K - C), ' >> ', Name); end; end; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try SetMinimumBlockAlignment(mba16Byte); TimeCallBack(@CompareTwoLinesFast, 'Fast'); TimeCallBack(@CompareTwoLinesFast2, 'Fast2'); TimeCallBack(@SSESameString, 'SSESameString'); TimeCallBack(@SSESameString2, 'SSESameString2'); PrintTimeALlResult; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
s := '5565565564564634534534634';
S2 := '556556556456463453453xxxx';
if not SSESameString2(s, S2) then
begin
Writeln(S2);
end;
function ShaIsSameString(A, B: pointer): boolean; asm push ebx cmp eax, edx je @EQ test eax, eax jz @NE test edx, edx jz @NE mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jne @NE sub edx, eax sub ecx, 7 jl @12bytesmax @16bytes: mov ebx, dword ptr [eax] cmp ebx, dword ptr [eax + edx] jne @NE mov ebx, dword ptr [eax + 4] cmp ebx, dword ptr [eax + edx + 4] jne @NE mov ebx, dword ptr [eax + 8] cmp ebx, dword ptr [eax + edx + 8] jne @NE mov ebx, dword ptr [eax + 12] cmp ebx, dword ptr [eax + edx + 12] jne @NE add eax, 16 sub ecx, 8 jge @16bytes @12bytesmax: add ecx, 6 jl @EQ @4bytes: mov ebx, dword ptr [eax] cmp ebx, dword ptr [eax + edx] jne @NE add eax, 4 sub ecx, 2 jge @4bytes @EQ: mov eax, 1 pop ebx ret @NE: xor eax, eax pop ebx end;
function SSESameString2(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx xor ecx, ecx sub edx, eax jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [eax + edx - 4] jnz @@exit // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit dec ecx jz @@exit dec ecx jz @@exit lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c xor ecx, ecx // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebx ret // -- check partial mask @@mask: dw $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 7 jae @@false movzx edx, word ptr [@@mask + ecx * 2 - 2] and ebx, edx cmp ebx, edx setz al @@false: pop ebx end;
for Idx := 1 to 24 do begin
a := StringOfChar('x', Idx);
b := a;
Write(Idx:2, ': Same | ', SSESameString2(a, b), ' <-> ');
b[Idx] := 'y';
WriteLn('Diff | ', SSESameString2(a, b));
end;
function SSESameString2(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx cmp edx, eax jz @@true test eax, eax jz @@exit // eax = 0 -> result = false test edx, edx jz @@false mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@false sub edx, eax // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@false dec ecx jz @@true dec ecx jz @@true lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c @@true: xor eax, eax setz al pop ebx ret @@false: xor eax, eax pop ebx ret // -- check partial mask @@mask: dw $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 7 jae @@exit movzx edx, word ptr [@@mask + ecx * 2 - 2] and ebx, edx cmp ebx, edx setz al @@exit: pop ebx end;
program StrTest; {$APPTYPE CONSOLE} {$R *.res} uses math, windows, SysUtils; function CompareTwoLinesFast(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: Cardinal; begin if ((L = nil) or (R = nil)) or (L[-1] <> R[-1]) then exit(false); Len := L[-1]; while (Len > 64) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15]) and (L[17] = R[17]) and (L[16] = R[16]) and (L[19] = R[19]) and (L[18] = R[18]) and (L[21] = R[21]) and (L[20] = R[20]) and (L[22] = R[22]) and (L[24] = R[24]) and (L[23] = R[23]) and (L[26] = R[26]) and (L[25] = R[25]) and (L[27] = R[27]) and (L[28] = R[28]) and (L[30] = R[30]) and (L[31] = R[31]) and (L[29] = R[29])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 32)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 32)); dec(Len, 64); end; while (Len > 32) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6]) and (L[8] = R[8]) and (L[10] = R[10]) and (L[9] = R[9]) and (L[11] = R[11]) and (L[12] = R[12]) and (L[14] = R[14]) and (L[13] = R[13]) and (L[15] = R[15])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 16)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 16)); dec(Len, 32); end; while (Len > 16) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3]) and (L[7] = R[7]) and (L[5] = R[5]) and (L[4] = R[4]) and (L[6] = R[6])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 8)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 8)); dec(Len, 16); end; while (Len > 8) and ((L[1] = R[1]) and (L[0] = R[0]) and (L[2] = R[2]) and (L[3] = R[3])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 4)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 4)); dec(Len, 8); end; while (Len > 4) and ((L[1] = R[1]) and (L[0] = R[0])) do begin L := Pointer(Cardinal(L) + (sizeof(Cardinal) * 2)); R := Pointer(Cardinal(R) + (sizeof(Cardinal) * 2)); dec(Len, 4); end; if Len > 2 then Result := ((L[1] = R[1]) and (L[0] = R[0])) else Result := L[0] = R[0]; end; function CompareTwoLinesFast2(L, R: PCardinal): Boolean; inline; {$POINTERMATH ON} var Len: integer; label EQ, NE; begin if L = R then goto EQ; if (L = nil) or (R = nil) then goto NE; Len := L[-1]; if Len <> integer(R[-1]) then goto NE; while Len >= 31 do begin; if (L[15] <> R[15]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) or (L[3] <> R[3]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) or (L[7] <> R[7]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) or (L[11] <> R[11]) or (L[12] <> R[12]) or (L[13] <> R[13]) or (L[14] <> R[14]) then goto NE; inc(L, 16); inc(R, 16); dec(Len, 32); end; if Len >= 7 then begin; if (L[3] <> R[3]) or (L[0] <> R[0]) or (L[1] <> R[1]) or (L[2] <> R[2]) then goto NE; if Len >= 15 then begin; if (L[7] <> R[7]) or (L[4] <> R[4]) or (L[5] <> R[5]) or (L[6] <> R[6]) then goto NE; if Len >= 23 then begin; if (L[11] <> R[11]) or (L[8] <> R[8]) or (L[9] <> R[9]) or (L[10] <> R[10]) then goto NE; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; inc(L, 4); inc(R, 4); dec(Len, 8); end; if (Len <= 0) or (L[0] = R[0]) and ((Len <= 2) or (L[1] = R[1]) and ((Len <= 4) or (L[2] = R[2]))) then goto EQ; NE: exit(false); EQ: exit(true); end; function SSESameString(const A, B: Pointer): Boolean; // in: eax - A, edx - B; out: eax - Result { .$DEFINE SSE41 } { .$DEFINE UNALIGNED } { .$DEFINE Align16Bytes } asm push ebx push ebp xor ecx, ecx cmp eax, edx jz @@exit inc ecx test eax, eax jz @@exit test edx, edx jz @@exit mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@exit sub edx, eax {$IFNDEF UNALIGNED} { test 2 unaligned characters } mov ebx, [eax] xor ebx, [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jz @@exit {$ENDIF} xor ebx, ebx lea ebx, [ebx - 8] test ecx, ebx jz @@l2c // -- 8x character loop @@l8c: {$IFDEF UNALIGNED} movdqu xmm0, dqword ptr [eax] movdqu xmm1, dqword ptr [eax + edx] {$ELSE (ALIGNED)} movdqa xmm0, dqword ptr [eax] {$ENDIF} {$IFNDEF SSE41} {$IFDEF UNALIGNED} pcmpeqd xmm0, xmm1 {$ELSE (ALIGNED)} pcmpeqd xmm0, dqword ptr [eax + edx] {$ENDIF} pmovmskb ebp, xmm0 sub ebp, $FFFF {$ELSE (SSE2)} {$IFDEF UNALIGNED} pxor xmm0, xmm1 {$ELSE (ALIGNED)} pxor xmm0, dqword ptr [eax + edx] {$ENDIF} ptest xmm0, xmm0 {$ENDIF} jnz @@exit lea eax, [eax + $10] lea ecx, [ecx - $08] test ecx, ebx jnz @@l8c test ecx, ecx jz @@exit // -- 2x character loop @@l2c: mov ebx, dword ptr [eax] xor ebx, dword ptr [eax + edx] jnz @@exit lea eax, [eax + 4] dec ecx jz @@exit dec ecx jnz @@l2c // -- set result and exit @@exit: xor eax, eax test ecx, ecx setz al pop ebp pop ebx end; function SSESameString2(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx cmp edx, eax jz @@true test eax, eax jz @@exit // eax = 0 -> result = false test edx, edx jz @@false mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@false sub edx, eax // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@false dec ecx jz @@true dec ecx jz @@true lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c @@true: xor eax, eax setz al pop ebx ret @@false: xor eax, eax pop ebx ret // -- check partial mask @@mask: dw $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 7 jae @@exit movzx edx, word ptr [@@mask + ecx * 2 - 2] and ebx, edx cmp ebx, edx setz al @@exit: pop ebx end; { ---===[: Код для проведения тестирования :]===--- } type TTestData = record ProcName: string; Times: array of Single; Diffs: array of Single; end; TMinData = record ProcName: string; BestTime: Single; end; var TestArray: array of TTestData; BaseArray: array of TMinData; NumProcs: Integer = 0; const MAXLEN = 30; procedure TestFunction(Proc: Pointer; Name: string); type TestProc = function(a, b: Pointer): Boolean; var MaxTime, MinTime: Single; Len, Round: Integer; a, b: string; TimeVal: Single; StartTime, StopTime: Int64; iCounterPerSec: Int64; begin TestArray[NumProcs].ProcName := Name; MinTime := 90000; MaxTime := 0; SetLength(TestArray[NumProcs].Times, MAXLEN); SetLength(TestArray[NumProcs].Diffs, MAXLEN); if Length(BaseArray) = 0 then SetLength(BaseArray, MAXLEN); for Len := 0 to MAXLEN - 1 do begin a := StringOfChar('X', Succ(Len) * 2); b := Copy(a, 1); if QueryPerformanceCounter(StartTime) then begin for Round := 0 to 10000000 do if not TestProc(Proc)(Pointer(a), Pointer(b)) then begin Writeln('Error at string lengh ', Len * 2); Break; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then begin TimeVal := (StopTime - StartTime) / iCounterPerSec; TestArray[NumProcs].Times[Len] := TimeVal; if (BaseArray[Len].BestTime = 0) or (BaseArray[Len].BestTime > TimeVal) then begin BaseArray[Len].ProcName := Name; BaseArray[Len].BestTime := TimeVal; end; if MaxTime < TimeVal then MaxTime := TimeVal; if MinTime > TimeVal then MinTime := TimeVal; end; end; end; Inc(NumProcs); WriteLn(Format('[: %-20s Min: %.6f, Max: %.6f :]', [Name, MinTime, MaxTime])); end; procedure PrintResults; var Idx: Integer; Len: Integer; begin Writeln; for Len := 0 to MAXLEN - 1 do begin for Idx := 0 to NumProcs - 1 do TestArray[Idx].Diffs[Len] := TestArray[Idx].Times[Len] / BaseArray[Len].BestTime; Write((Succ(Len) * 2):2, ' | '); for Idx := 0 to NumProcs - 1 do begin if Idx > 0 then Write(' | '); Write(TestArray[Idx].Times[Len]:5:4, ' - ', TestArray[Idx].Diffs[Len]:3:2); end; WriteLn(' -> ', BaseArray[Len].ProcName); end; end; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try System.SetMinimumBlockAlignment(mba16Byte); SetLength(TestArray, 4); TestFunction(@CompareTwoLinesFast, 'Fast'); TestFunction(@CompareTwoLinesFast2, 'Fast2'); TestFunction(@SSESameString, 'SSESameString'); TestFunction(@SSESameString2, 'SSESameString2'); PrintResults; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} {$POINTERMATH ON} uses System.SysUtils; type PBaseArray = ^TBaseArray; TBaseArray = array of char; var I: Integer; str: string; s: char; b: PBaseArray; begin try str := 'TextText'; b := @str; for I := 0 to High(str) do Writeln(b^[I]); for I := 0 to High(str) do begin s := char(PWord(str)[I]); Writeln(s); end; Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
procedure TBox.AppendString(const Value: string); var a: Cardinal; p, pp: Pointer; begin Hash := 0; if _Type = SString then begin a := System.Length(Value); with TStrBox^ do begin FLength := FLength + a; if FLength > tmpLength then begin tmpLength := tmpLength + 32; if FLength > tmpLength then tmpLength := FLength + 32; if tmpLength > MaxInt then tmpLength := MaxInt; if tmpLength < 0 then tmpLength := FLength; System.SetLength(FData, tmpLength); end; end; Move(PChar(Value)^, TStrBox^.FData[TStrBox^.FLength - a], a * sizeof(Char)); end else begin case _Type of SUInt16: Dispose(TWord); SUInt32: Dispose(TCardinal); SUInt64: Dispose(TUInt64); SInt8: Dispose(TShortInt); SInt16: Dispose(TSmallInt); SInt32: Dispose(TInteger); SInt64: Dispose(TInt64); SSingle: Dispose(TSingle); SDouble: Dispose(TDouble); SExtended: Dispose(TExtended); SCurrency: Dispose(TCurrency); end; _Type := SNULL; SetString(Value); end; end;
procedure TBox.free; begin case _Type of SString: begin TStrBox^.FLength := 0; System.SetLength(TStrBox^.FData, 0); Dispose(TStrBox); end; SUInt8: TByte := 0; SUInt16: begin Dispose(TWord); TWord := nil; end; SUInt32: begin Dispose(TCardinal); TCardinal := nil; end; SUInt64: begin Dispose(TUInt64); TUInt64 := nil; end; SInt8: begin Dispose(TShortInt); TShortInt := nil; end; SInt16: begin Dispose(TSmallInt); TSmallInt := nil; end; SInt32: begin Dispose(TInteger); TInteger := nil; end; SInt64: begin Dispose(TInt64); TInt64 := nil; end; SSingle: begin Dispose(TSingle); TSingle := nil; end; SDouble: begin Dispose(TDouble); TDouble := nil; end; SExtended: begin Dispose(TExtended); TExtended := nil; end; SCurrency: begin Dispose(TCurrency); TCurrency := nil; end; SPointer: TPointer := nil; end; _Type := SNULL; end;
program MyPHPX; {$R *.res} uses math, windows, SysUtils, Utils, PHPLexer, StringCASE, ValueBox; type TTestData = record ProcName: string; Times: array of Single; Diffs: array of Single; end; TMinData = record ProcName: string; BestTime: Single; end; var TestArray: array of TTestData; BaseArray: array of TMinData; NumProcs: Integer = 0; const MAXLEN = 30; procedure TestFunction(Proc: Pointer; Name: string); type TestProc = function: Boolean; var MaxTime, MinTime: Single; Len, Round: Integer; a, b: string; TimeVal: Single; StartTime, StopTime: Int64; iCounterPerSec: Int64; begin TestArray[NumProcs].ProcName := Name; MinTime := 90000; MaxTime := 0; SetLength(TestArray[NumProcs].Times, MAXLEN); SetLength(TestArray[NumProcs].Diffs, MAXLEN); if Length(BaseArray) = 0 then SetLength(BaseArray, MAXLEN); for Len := 0 to MAXLEN - 1 do begin a := StringOfChar('X', Succ(Len) * 2); b := Copy(a, 1); if QueryPerformanceCounter(StartTime) then begin for Round := 0 to 10000000 do TestProc(Proc)(); if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then begin TimeVal := (StopTime - StartTime) / iCounterPerSec; TestArray[NumProcs].Times[Len] := TimeVal; if (BaseArray[Len].BestTime = 0) or (BaseArray[Len].BestTime > TimeVal) then begin BaseArray[Len].ProcName := Name; BaseArray[Len].BestTime := TimeVal; end; if MaxTime < TimeVal then MaxTime := TimeVal; if MinTime > TimeVal then MinTime := TimeVal; end; end; end; Inc(NumProcs); Writeln(Format('[: %-20s Min: %.6f, Max: %.6f :]', [Name, MinTime, MaxTime])); end; procedure PrintResults; var Idx: Integer; Len: Integer; begin Writeln; for Len := 0 to MAXLEN - 1 do begin for Idx := 0 to NumProcs - 1 do TestArray[Idx].Diffs[Len] := TestArray[Idx].Times[Len] / BaseArray[Len].BestTime; Write((Succ(Len) * 2):2, ' | '); for Idx := 0 to NumProcs - 1 do begin if Idx > 0 then Write(' | '); Write(TestArray[Idx].Times[Len]:5:4, ' - ', TestArray[Idx].Diffs[Len]:3:2); end; Writeln(' -> ', BaseArray[Len].ProcName); end; end; procedure TestSBox(); var ss: TBox; I: Cardinal; begin ss.SetInt64(10); for I := 0 to 5 do ss.AppendPlus(I); end; procedure TestNative(); var ss: Int64; I: Cardinal; begin ss := 10; for I := 0 to 5 do Inc(ss, I); end; begin try System.SetMinimumBlockAlignment(mba16Byte); SetLength(TestArray, 2); TestFunction(@TestSBox, 'TestSBox'); TestFunction(@TestNative, 'TestNative'); PrintResults; Readln; except on e: Exception do begin Writeln(e.ClassName, ': ', e.Message); Readln; end; end; end.
program StrTest; {$APPTYPE CONSOLE} uses math, windows, SysUtils; { ---===[: Код для проведения тестирования :]===--- } type TTestData = record ProcName: string; Times: array of Single; Diffs: array of Single; end; TMinData = record ProcName: string; BestTime: Single; end; var TestArray: array of TTestData; BaseArray: array of TMinData; NumProcs: integer = 0; const MAXLEN = 30; procedure TestFunction(Proc: Pointer; Name: string; mem: Boolean = false); type TestProc = function(A, B: Pointer): Boolean; TestProc2 = function(A, B: Pointer; len: integer): Boolean; var MaxTime, MinTime: Single; len, Round: integer; A, B: string; TimeVal: Single; StartTime, StopTime: Int64; iCounterPerSec: Int64; ken, ken2: integer; begin TestArray[NumProcs].ProcName := Name; MinTime := 90000; MaxTime := 0; SetLength(TestArray[NumProcs].Times, MAXLEN); SetLength(TestArray[NumProcs].Diffs, MAXLEN); if Length(BaseArray) = 0 then SetLength(BaseArray, MAXLEN); for len := 0 to MAXLEN - 1 do begin ken := Succ(len) * 2; ken2 := ken * 2; A := StringOfChar('X', ken); B := Copy(A, 1); if QueryPerformanceCounter(StartTime) then begin if mem then begin for Round := 0 to 10000000 do if not TestProc2(Proc)(Pointer(A), Pointer(B), ken2) then begin Writeln('Error at string lengh ', ken, ' ', A); Break; end; end else begin for Round := 0 to 10000000 do if not TestProc(Proc)(Pointer(A), Pointer(B)) then begin Writeln('Error at string lengh ', ken, ' ', A); Break; end; end; if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then begin TimeVal := (StopTime - StartTime) / iCounterPerSec; TestArray[NumProcs].Times[len] := TimeVal; if (BaseArray[len].BestTime = 0) or (BaseArray[len].BestTime > TimeVal) then begin BaseArray[len].ProcName := Name; BaseArray[len].BestTime := TimeVal; end; if MaxTime < TimeVal then MaxTime := TimeVal; if MinTime > TimeVal then MinTime := TimeVal; end; end; end; inc(NumProcs); Writeln(Format('[: %-20s Min: %.6f, Max: %.6f :]', [Name, MinTime, MaxTime])); end; procedure PrintResults; var Idx: integer; len: integer; begin Writeln; for len := 0 to MAXLEN - 1 do begin for Idx := 0 to NumProcs - 1 do TestArray[Idx].Diffs[len] := TestArray[Idx].Times[len] / BaseArray[len].BestTime; Write((Succ(len) * 2):2, ' | '); for Idx := 0 to NumProcs - 1 do begin if Idx > 0 then Write(' | '); Write(TestArray[Idx].Times[len]:5:5, ' - ', TestArray[Idx].Diffs[len]:3:2); end; Writeln(' -> ', BaseArray[len].ProcName); end; end; function SSESameString(const A, B: string): Boolean; // in: eax - A, edx - B; out: eax - Result asm push ebx cmp edx, eax jz @@true test eax, eax jz @@exit // eax = 0 -> result = false test edx, edx jz @@false mov ecx, dword ptr [eax - 4] cmp ecx, dword ptr [edx - 4] jnz @@false sub edx, eax // -- unaligned 2x character test mov ebx, [eax] xor ebx, [eax + edx] jnz @@false dec ecx jz @@true dec ecx jz @@true lea eax, [eax + 4] // -- aligned 8x character loop @@l8c: movdqa xmm1, dqword ptr [eax] pcmpeqw xmm1, dqword ptr [eax + edx] pmovmskb ebx, xmm1 cmp ebx, $FFFF jnz @@tail lea eax, [eax + $10] sub ecx, 8 ja @@l8c @@true: xor eax, eax setz al pop ebx ret @@false: xor eax, eax pop ebx ret // -- check partial mask @@mask: dw $000F, $003F, $00FF, $03FF, $0FFF, $3FFF @@tail: xor eax, eax cmp ecx, 7 jae @@exit movzx edx, word ptr [@@mask + ecx * 2 - 2] and ebx, edx cmp ebx, edx setz al @@exit: pop ebx end; function cmp(const Str, Str2: string): Boolean; asm push ebx cmp edx, eax // Str = Str2 to true jz @@true test eax, eax // not eax to false jz @@false test edx, edx // not edx to false jz @@false mov ecx, DWORD PTR [eax-4] // LenStr <> LenStr2 to false cmp DWORD PTR [edx-4], ecx jne @@false sub edx, eax // Str2 := Str2 - Str; mov ebx, [eax] // Cmp 4 byte xor ebx, [eax + edx] jnz @@false sub ecx, 2 jbe @@true lea eax, [eax + 4] // Next 4 byte @@To1: movdqa xmm1, DQWORD PTR [eax] // _mm_load_si128(eax) pcmpeqw xmm1, DQWORD PTR [eax+edx] // _mm_cmpeq_epi16(xmm1, _mm_load_si128 :: eax+edx) pmovmskb ebx, xmm1 // _mm_movemask_epi8(xmm1) cmp ebx, 65535 // ebx <> 65535 jne @@Final // to goto Final add eax, 16 // To next 16 byte sub ecx, 8 // dec(ecx - (16 / SizeOf(WideChar))) ja @@To1 // ecx > 0 to goto To1 @@true: // Result true mov eax, 1 pop ebx ret @@false: // Result false mov eax, 0 pop ebx ret @@Final: cmp ecx, 7 jae @@false movzx ecx, word ptr @@mask[ecx * 2 - 2] // mask[len] and ebx, ecx // ecx & ecx cmp ebx, ecx // ebx = ecx // return ((ebx & mask[len]) == mask[len]) sete al pop ebx ret @@mask: dw $000F, $003F, $00FF, $03FF, $0FFF, $3FFF end; function CmpMem(const P1, P2: Pointer; len: integer): Boolean; asm push ebx sub edx, eax mov ebx, [eax] xor ebx, [eax + edx] jnz @@false sub ecx, 4 jbe @@true lea eax, [eax + 4] @@To1: movdqa xmm1, DQWORD PTR [eax] pcmpeqw xmm1, DQWORD PTR [eax+edx] pmovmskb ebx, xmm1 cmp ebx, 65535 jne @@Final add eax, 16 sub ecx, 16 ja @@To1 @@true: mov eax, 1 pop ebx ret @@false: mov eax, 0 pop ebx ret @@Final: cmp ecx, 15 jae @@false movzx ecx, word ptr @@mask[ecx * 2 - 2] // mask[len] and ebx, ecx cmp ebx, ecx sete al pop ebx ret @@mask: dw 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383 end; var Str, Str2: string; begin {$IFNDEF DEBUG} Write('Release'); {$ELSE} Write('Debug'); {$ENDIF} {$IF Defined(CPUX64) or Defined(CPUARM64)} Writeln(' 64bit'); {$ELSE} Writeln(' 32Bit'); {$IFEND} try System.SetMinimumBlockAlignment(mba16Byte); SetLength(TestArray, 2); // TestFunction(@CmpMem, 'CmpMem', true); TestFunction(@SSESameString, 'SSESameString'); TestFunction(@cmp, 'cmp'); PrintResults; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, windows; type PM128i = ^TM128i; PM128d = ^TM128d; TM128i = record case longint of 0: (m128i_i8: array [0 .. 15] of shortint); 1: (m128i_i16: array [0 .. 7] of smallint); 2: (m128i_i32: array [0 .. 3] of Integer); 3: (m128i_i64: array [0 .. 1] of int64); 4: (m128i_u8: array [0 .. 15] of byte); 5: (m128i_u16: array [0 .. 7] of word); 6: (m128i_u32: array [0 .. 3] of Cardinal); 7: (m128i_u64: array [0 .. 1] of UInt64); end align 16; TM128d = record m128d_f64: array [0 .. 1] of double; end align 16; procedure SetIntSSE2(var v: TM128i; a: Integer); asm movd xmm0, edx pshufd xmm0, xmm0, 0 movdqa dqword ptr [eax], xmm0 end; procedure GetIntSSE2(var v: Integer; b: TM128i); asm movss dword ptr [eax], xmm0 end; procedure Plus(a, b: TM128i); asm paddd xmm0, dqword ptr [eax] movdqa dqword ptr [eax], xmm0 end; var xmm1, xmm2: TM128i; Result: Integer; begin SetIntSSE2(xmm1, 245); SetIntSSE2(xmm2, 324); Plus(xmm1, xmm2); GetIntSSE2(Result, xmm1); Writeln(Result); // 569 Readln; end.
SetIntSSE2(xmm1, 245); SetIntSSE2(xmm2, 324); Plus(xmm1, xmm2); GetIntSSE2(Result, xmm1);
program Project1; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, windows; type PM128i = ^TM128i; PM128d = ^TM128d; TM128i = record case longint of 0: (m128i_i8: array [0 .. 15] of shortint); 1: (m128i_i16: array [0 .. 7] of smallint); 2: (m128i_i32: array [0 .. 3] of Integer); 3: (m128i_i64: array [0 .. 1] of int64); 4: (m128i_u8: array [0 .. 15] of byte); 5: (m128i_u16: array [0 .. 7] of word); 6: (m128i_u32: array [0 .. 3] of Cardinal); 7: (m128i_u64: array [0 .. 1] of UInt64); end align 16; TM128d = record m128d_f64: array [0 .. 1] of double; end align 16; function SetIntSSE2(a: Integer):TM128i; asm movd xmm0, eax pshufd xmm0, xmm0, 0 movdqa dqword ptr [Result], xmm0 end; function GetIntSSE2(b: TM128i):Integer; asm movss Result, xmm0 end; function Plus(a, b: TM128i):TM128i; asm paddd xmm0, dqword ptr [eax] movdqa dqword ptr [Result], xmm0 end; function TestPlus(A, B: Double): Double; // TM128d asm movsd xmm0, A addsd xmm0, B movsd Result, xmm0 end; var xmm1, xmm2, xmm3: TM128i; Result: Integer; begin xmm1 := SetIntSSE2(245); xmm2 := SetIntSSE2(324); xmm3 := Plus(xmm1, xmm2); Result := GetIntSSE2(xmm1); Writeln(Result); // 569 Readln; end.
program StrTest; {$APPTYPE CONSOLE} {$EXCESSPRECISION OFF} uses windows, SysUtils; var StartTime, StopTime: Int64; iCounterPerSec: Int64; procedure BeginTime; begin QueryPerformanceCounter(StartTime); end; procedure EndTime; begin if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency(iCounterPerSec) then Writeln(Format('%.6f', [(StopTime - StartTime) / iCounterPerSec])); end; var x, x1, x2, x3, x4, x5: Single; I: Integer; begin x1 := 2.1; x2 := 3.1; x3 := 4.1; x4 := 5.1; x5 := 6.1; Writeln('Standard'); BeginTime; x := 10; for I := 0 to 500000000 - 1 do begin x := x + x1; x := x + x2; x := x + x3; x := x + x4; x := x + x5; end; EndTime; Writeln(FloatToStr(x)); Writeln('XMM'); // Float (single) BeginTime; x := 10; asm movss xmm0, DWORD PTR [x] end; for I := 0 to 500000000 - 1 do begin asm addss xmm0, x1 addss xmm0, x2 addss xmm0, x3 addss xmm0, x4 addss xmm0, x5 end; end; asm movss DWORD PTR [x], xmm0 end; EndTime; Writeln(FloatToStr(x)); Readln; end.