From: <tw...@us...> - 2020-08-01 13:50:11
|
Revision: 3268 http://sourceforge.net/p/gexperts/code/3268 Author: twm Date: 2020-08-01 13:50:08 +0000 (Sat, 01 Aug 2020) Log Message: ----------- Bugfix: did not cmpile for older Delphi versions Modified Paths: -------------- trunk/ExternalSource/dzlib/dzlib.inc trunk/ExternalSource/dzlib/u_dzConvertUtils.pas trunk/ExternalSource/dzlib/u_dzCriticalSection.pas trunk/ExternalSource/dzlib/u_dzMiscUtils.pas trunk/ExternalSource/dzlib/u_dzTypes.pas Modified: trunk/ExternalSource/dzlib/dzlib.inc =================================================================== --- trunk/ExternalSource/dzlib/dzlib.inc 2020-08-01 11:18:30 UTC (rev 3267) +++ trunk/ExternalSource/dzlib/dzlib.inc 2020-08-01 13:50:08 UTC (rev 3268) @@ -81,6 +81,7 @@ {$IFDEF DELPHIX_TOKYO_UP} // this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo {$DEFINE HAS_INTTOHEX_FUNCTION} +{$DEFINE HAS_INTTOHEX_FUNCTION_64} {$ENDIF} {$IFOPT T+} Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-08-01 11:18:30 UTC (rev 3267) +++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-08-01 13:50:08 UTC (rev 3268) @@ -368,6 +368,11 @@ function Swap32(_Value: LongWord): LongWord; function Swap32pas(_Value: LongWord): LongWord; +///<summary> +/// returns a 64 bit value in reversed byte order e.g. $123456789ABCDEF0 -> $F0DEBC9A78563412 +/// aka converts intel (little endian) to motorola (big endian) byte order format </summary> +function Swap64(_Value: UInt64): UInt64; + function BitReverse32(v: LongWord): LongWord; {$IFDEF SUPPORTS_ENHANCED_RECORDS} @@ -674,7 +679,7 @@ {$IFDEF unicode} function isDec(const _s: AnsiString): Boolean; begin - Result := IsDec(string(_s)); + Result := isDec(string(_s)); end; {$ENDIF} @@ -1075,6 +1080,14 @@ Result := ((_Value shr 24) and $FF) + (((_Value shr 16) and $FF) shl 8) + (((_Value shr 8) and $FF) shl 16) + ((_Value and $FF) shl 24); end; +function Swap64(_Value: UInt64): UInt64; +asm + MOV EDX,_Value.Int64Rec.Lo + BSWAP EDX + MOV EAX,_Value.Int64Rec.Hi + BSWAP EAX +end; + function BitReverse32(v: LongWord): LongWord; // source (C code): // https://apps.topcoder.com/forums/?module=Thread&threadID=514884&start=2 Modified: trunk/ExternalSource/dzlib/u_dzCriticalSection.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2020-08-01 11:18:30 UTC (rev 3267) +++ trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2020-08-01 13:50:08 UTC (rev 3268) @@ -25,33 +25,8 @@ implementation -function GetCacheLineSize: Integer; -var - ProcInfo: PSystemLogicalProcessorInformation; - CurInfo: PSystemLogicalProcessorInformation; - Len: DWORD; -begin - Len := 0; - if (GetProcAddress(GetModuleHandle(kernel32), 'GetLogicalProcessorInformation') <> nil) and - not GetLogicalProcessorInformation(nil, Len) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then begin - GetMem(ProcInfo, Len); - try - GetLogicalProcessorInformation(ProcInfo, Len); - CurInfo := ProcInfo; - while Len > 0 do begin - if (CurInfo.Relationship = RelationCache) and (CurInfo.Cache.Level = 1) then begin - Result := CurInfo.Cache.LineSize; - Exit; - end; - Inc(CurInfo); - Dec(Len, SizeOf(CurInfo^)); - end; - finally - FreeMem(ProcInfo); - end; - end; - Result := 64; -end; +uses + u_dzMiscUtils; var CacheLineSize: Integer; @@ -88,6 +63,80 @@ end; {$ENDIF debug_Crit_Sect} +{$IF not declared(PSystemLogicalProcessorInformation)} +{$ALIGN ON} +{$MINENUMSIZE 4} + +type + _PROCESSOR_CACHE_TYPE = (CacheUnified { = 0}, CacheInstruction { = 1}, CacheData { = 2}, CacheTrace { = 3}); + PROCESSOR_CACHE_TYPE = _PROCESSOR_CACHE_TYPE; + TProcessorCacheType = PROCESSOR_CACHE_TYPE; +type + TCacheDescriptor = record + Level: BYTE; + Associativity: BYTE; + LineSize: WORD; + Size: DWORD; + _Type: PROCESSOR_CACHE_TYPE; + end; + +type + TLogicalProcessorRelationship = (RelationProcessorCore { = 0}, + RelationNumaNode { = 1}, + RelationCache { = 2}, + RelationProcessorPackage { = 3}, + RelationGroup { = 4}, RelationAll = $FFFF); + +type + TSystemLogicalProcessorInformation = record + ProcessorMask: ULONG_PTR; + Relationship: TLogicalProcessorRelationship; + case Integer of + 0: (Flags: BYTE); // ProcessorCore + 1: (NodeNumber: DWORD); // NumaNode + 2: (Cache: TCacheDescriptor); //Cache + 3: (Reserved: array[0..1] of ULONGLONG); + end; + PSystemLogicalProcessorInformation = ^TSystemLogicalProcessorInformation; + +function GetLogicalProcessorInformation(Buffer: PSystemLogicalProcessorInformation; var ReturnedLength: DWORD): BOOL; stdcall; + external kernel32 name 'GetLogicalProcessorInformation'; +{$IFEND} + +function GetCacheLineSize: Integer; +var + ProcInfo: PSystemLogicalProcessorInformation; + CurInfo: PSystemLogicalProcessorInformation; + Len: DWORD; + Err: DWORD; +begin + Result := 64; + + Len := 0; + if not GetLogicalProcessorInformation(nil, Len) then begin + Err := GetLastError; + if Err = ERROR_INSUFFICIENT_BUFFER then begin + GetMem(ProcInfo, Len); + try + if GetLogicalProcessorInformation(ProcInfo, Len) then begin + // it should not be possible that the second call still returns, but ... + CurInfo := ProcInfo; + while Len > 0 do begin + if (CurInfo.Relationship = RelationCache) and (CurInfo.Cache.Level = 1) then begin + Result := CurInfo.Cache.LineSize; + Exit; + end; + Inc(CurInfo); + Dec(Len, SizeOf(CurInfo^)); + end; + end; + finally + FreeMem(ProcInfo); + end; + end; + end; +end; + initialization CacheLineSize := GetCacheLineSize; end. Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 11:18:30 UTC (rev 3267) +++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 13:50:08 UTC (rev 3268) @@ -21,8 +21,8 @@ interface uses + Windows, SysUtils, - Windows, Registry, u_dzTranslator; @@ -86,6 +86,12 @@ function IntToHex(_Value: Int64): string; overload; {$ENDIF HAS_INTTOHEX_FUNCTION} +{$IFNDEF HAS_INTTOHEX_FUNCTION_64} +function IntToHex(_Value: UInt64): string; overload; +{$ENDIF HAS_INTTOHEX_FUNCTION_64} + +function PtrToHex(_Value: Pointer): string; + ///<summary> Converts an integer to a boolean. /// @param Int is the integer to convert /// @returns false, if the integer is 0, true otherwise </summary> @@ -224,6 +230,7 @@ {$ENDIF} {$ENDIF} StrUtils, + u_dzTypes, u_dzFileUtils, u_dzStringUtils, u_dzConvertUtils; @@ -528,6 +535,23 @@ end; {$ENDIF HAS_INTTOHEX_FUNCTION} +{$IFNDEF HAS_INTTOHEX_FUNCTION_64} +function IntToHex(_Value: UInt64): string; overload; +var + Buf: PUInt32; +begin + Buf := PUInt32(NativeUInt(@_Value) + 8); + Result := IntToHex(Buf^, 8); + Buf := PUInt32(@_Value); + Result := Result + IntToHex(Buf^, 8); +end; +{$ENDIF HAS_INTTOHEX_FUNCTION_64} + +function PtrToHex(_Value: Pointer): string; +begin + Result := IntToHex(NativeUInt(_Value)); +end; + type PStringDescriptor = ^TStringDescriptor; TStringDescriptor = record Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 11:18:30 UTC (rev 3267) +++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 13:50:08 UTC (rev 3268) @@ -10,6 +10,53 @@ Types; // for $IF Declared(TBytes) and TStringDynArray type + // Fixed size signed and unsigned integer types +{$IF not declared(Int8)} + Int8 = Shortint; +{$IFEND} +{$IF not declared(UInt8)} + UInt8 = Byte; +{$IFEND} +{$IF not declared(Int16)} + Int16 = Smallint; +{$IFEND} +{$IF not declared(UInt16)} + UInt16 = Word; +{$IFEND} +{$IF not declared(Int32)} + Int32 = Integer; +{$IFEND} +{$IF not declared(UInt32)} + UInt32 = Cardinal; +{$IFEND} + // Int64 is predefined + // UInt64 is predefined + +{$IF not declared(PInt8)} + PInt8 = ^Int8; +{$IFEND} +{$IF not declared(PUInt8)} + PUInt8 = ^UInt8; +{$IFEND} +{$IF not declared(PInt16)} + PInt16 = ^Int16; +{$IFEND} +{$IF not declared(PUInt16)} + PUInt16 = ^UInt16; +{$IFEND} +{$IF not declared(PInt32)} + PInt32 = ^Int32; +{$IFEND} +{$IF not declared(PUInt32)} + PUInt32 = ^UInt32; +{$IFEND} +{$IF not declared(PInt64)} + PInt64 = ^Int64; +{$IFEND} +{$IF not declared(PUInt64)} + PUInt64 = ^UInt64; +{$IFEND} +type EdzException = class(Exception) end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |