Skip to content
Permalink
Browse files

fpc/linux compatibility

  • Loading branch information...
Makhaon committed Aug 7, 2018
1 parent bde4549 commit e27a49450afb99dda698457b4784f5c90bc289ca
Showing 301 changed files with 16,587 additions and 141 deletions.
@@ -44,14 +44,22 @@ interface
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$IFDEF HAS_UNIT_LIBC}
{$IFNDEF FPC}
Libc,
{$ELSE FPC}
libclite,
{$ENDIF ~FPC}
{$ENDIF HAS_UNIT_LIBC}
{$IFDEF HAS_UNITSCOPE}
System.Classes,
{$ELSE ~HAS_UNITSCOPE}
Classes,
{$ENDIF ~HAS_UNITSCOPE}
JclBase, JclContainerIntf, JclSynch, JclSysUtils,
JclBase, JclContainerIntf,
{$IFDEF THREADSAFE}
JclSynch,
{$ENDIF THREADSAFE}
JclSysUtils,
JclWideStrings,
JclAnsiStrings;

@@ -703,9 +711,9 @@ TJclWideStrAbstractCollection = class(TJclWideStrAbstractContainer,
procedure AppendToStrings(Strings: TJclWideStrings);
procedure AppendFromStrings(Strings: TJclWideStrings);
function GetAsStrings: TJclWideStrings;
function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString;
procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
function GetAsDelimited(const Separator: WideString {$IFNDEF FPC} = WideLineBreak{$ENDIF}): WideString;
procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC} = WideLineBreak{$ENDIF});
procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC} = WideLineBreak{$ENDIF});
end;

{$IFDEF SUPPORTS_UNICODE_STRING}
@@ -1374,12 +1382,12 @@ function TJclAnsiStrAbstractContainer.Hash(const AString: AnsiString): Integer;
else
begin
case FEncoding of
seISO:
TJclAnsiStrEncoding.seISO:
if FCaseSensitive then
Result := AnsiStrSimpleHashConvert(AString)
else
Result := AnsiStrSimpleHashConvertI(AString);
seUTF8:
TJclAnsiStrEncoding.seUTF8:
if FCaseSensitive then
Result := AnsiStrSimpleHashConvertU(AString)
else
@@ -1397,7 +1405,7 @@ function TJclAnsiStrAbstractContainer.ItemsCompare(const A, B: AnsiString): Inte
else
begin
case FEncoding of
seISO, seUTF8:
TJclAnsiStrEncoding.seISO, TJclAnsiStrEncoding.seUTF8:
if FCaseSensitive then
Result := AnsiStrSimpleCompare(A, B)
else
@@ -1418,7 +1426,7 @@ function TJclAnsiStrAbstractContainer.ItemsEqual(const A, B: AnsiString): Boolea
else
begin
case FEncoding of
seISO, seUTF8:
TJclAnsiStrEncoding.seISO, TJclAnsiStrEncoding.seUTF8:
if FCaseSensitive then
Result := AnsiStrSimpleEqualityCompare(A, B)
else
@@ -380,8 +380,10 @@ function StrAnsiToOem(const S: AnsiString): AnsiString;
{$ENDIF MSWINDOWS}

// String Management
{$IFNDEF FPC}
procedure StrAddRef(var S: AnsiString);
procedure StrDecRef(var S: AnsiString);
{$ENDIF ~FPC}
function StrLength(const S: AnsiString): Longint;
function StrRefCount(const S: AnsiString): Longint;
procedure StrResetLength(var S: AnsiString);
@@ -518,8 +520,8 @@ procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: Siz

function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload;

function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;
function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;
function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload;
function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload;

// Explicit ANSI version of former/deprecated SysUtils PAnsiChar functions
{$IFNDEF DEPRECATED_SYSUTILS_ANSISTRINGS}
@@ -582,12 +584,20 @@ implementation

uses
{$IFDEF HAS_UNIT_LIBC}
{$IFNDEF FPC}
Libc,
{$ELSE}
libclite,
{$ENDIF ~FPC}
{$ENDIF HAS_UNIT_LIBC}
{$IFDEF SUPPORTS_UNICODE}
RtlConsts,
{$ENDIF SUPPORTS_UNICODE}
JclLogic, JclResources, JclStreams, JclSynch, JclSysUtils;
JclLogic, JclResources, JclStreams,
{$IFNDEF FPC}
JclSynch,
{$ENDIF ~ENDIF}
JclSysUtils;

//=== Internal ===============================================================

@@ -2369,6 +2379,7 @@ function StrAnsiToOem(const S: AnsiString): AnsiString;

//=== String Management ======================================================

{$IFNDEF FPC}
procedure StrAddRef(var S: AnsiString);
var
P: PAnsiStrRec;
@@ -2405,6 +2416,7 @@ procedure StrDecRef(var S: AnsiString);
end;
end;
end;
{$ENDIF ~FPC}

function StrLength(const S: AnsiString): Longint;
var
@@ -51,7 +51,7 @@ interface
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
JclAlgorithms,
JclBase, JclAbstractContainers, JclContainerIntf, JclSynch;
JclBase, JclAbstractContainers, JclContainerIntf {$IFDEF THREADSAFE}, JclSynch{$ENDIF THREADSAFE};


type
@@ -53,7 +53,10 @@ interface
{$IFDEF SUPPORTS_GENERICS}
JclAlgorithms,
{$ENDIF SUPPORTS_GENERICS}
JclBase, JclAbstractContainers, JclContainerIntf, JclArrayLists, JclSynch;
JclBase, JclAbstractContainers, JclContainerIntf, JclArrayLists
{$IFDEF THREADSAFE}
, JclSynch
{$ENDIF THREADSAFE};

type
TJclIntfArraySet = class(TJclIntfArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
@@ -145,8 +145,8 @@ procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal);

// Redefinition of ULARGE_INTEGER to relieve dependency on Windows.pas
type
{$IFNDEF FPC}
PULARGE_INTEGER = ^ULARGE_INTEGER;
{$IFDEF FPC}
{$EXTERNALSYM PULARGE_INTEGER}
ULARGE_INTEGER = record
case Integer of
@@ -223,6 +223,10 @@ ULARGE_INTEGER = record

HexFmt = HexPrefix + HexDigitFmt;

{$ifdef FPC}
ERROR_SUCCESS = 0;
{$endif}

const
BOM_UTF16_LSB: array [0..1] of Byte = ($FF,$FE);
BOM_UTF16_MSB: array [0..1] of Byte = ($FE,$FF);
@@ -331,21 +335,22 @@ function StringOf(const Bytes: Pointer; Size: Cardinal): AnsiString; overload;
{$IFDEF FPC}
TJclAddr64 = QWord;
{$IFDEF CPU64}
TJclAddr = QWord;
//TJclAddr = QWord;
{$ENDIF CPU64}
{$IFDEF CPU32}
TJclAddr = Cardinal;
//TJclAddr = Cardinal;
{$ENDIF CPU32}
{$ENDIF FPC}
{$IFDEF BORLAND}
TJclAddr64 = Int64;
{$IFDEF CPU64}
TJclAddr = TJclAddr64;
//TJclAddr = TJclAddr64;
{$ENDIF CPU64}
{$IFDEF CPU32}
TJclAddr = TJclAddr32;
//TJclAddr = TJclAddr32;
{$ENDIF CPU32}
{$ENDIF BORLAND}
TJclAddr = NativeUInt;
PJclAddr = ^TJclAddr;

EJclAddr64Exception = class(EJclError);
@@ -355,7 +360,7 @@ function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64;

{$IFDEF FPC}
type
HWND = type Windows.HWND;
HWND = type System.THandle;
{$ENDIF FPC}

{$IFDEF SUPPORTS_GENERICS}
@@ -393,12 +398,6 @@ TEquatable<T: class> = class(TInterfacedObject, IEquatable<T>, IEqualityCompar
AWSuffix = 'A';
{$ENDIF ~SUPPORTS_UNICODE}

{$IFDEF FPC}
// FPC emits a lot of warning because the first parameter of its internal
// GetMem is a var parameter, which is not initialized before the call to GetMem
procedure GetMem(out P; Size: Longint);
{$ENDIF FPC}

{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
@@ -613,16 +612,6 @@ procedure LoadAnsiReplacementCharacter;
end;
{$ENDIF ~MSWINDOWS}

{$IFDEF FPC}
// FPC emits a lot of warning because the first parameter of its internal
// GetMem is a var parameter, which is not initialized before the call to GetMem
procedure GetMem(out P; Size: Longint);
begin
Pointer(P) := nil;
GetMem(Pointer(P), Size);
end;
{$ENDIF FPC}

initialization

LoadAnsiReplacementCharacter;
@@ -50,7 +50,7 @@ interface
{$ELSE ~HAS_UNITSCOPE}
Classes,
{$ENDIF ~HAS_UNITSCOPE}
JclBase, JclAbstractContainers, JclAlgorithms, JclContainerIntf, JclSynch;
JclBase, JclAbstractContainers, JclAlgorithms, JclContainerIntf {$IFDEF THREADSAFE}, JclSynch{$ENDIF THREADSAFE};

type
TItrStart = (isFirst, isLast, isRoot);
@@ -54,7 +54,11 @@ interface
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$IFDEF HAS_UNIT_LIBC}
{$IFNDEF FPC}
Libc,
{$ELSE FPC}
libclite,
{$ENDIF ~FPC}
{$ENDIF HAS_UNIT_LIBC}
{$IFDEF HAS_UNITSCOPE}
{$IFDEF MSWINDOWS}
@@ -75,7 +79,10 @@ interface
ZLib,
{$ENDIF ZLIB_RTL}
{$ENDIF ~HAS_UNITSCOPE}
zlibh, bzip2, JclWideStrings, JclBase, JclStreams;
{$IFNDEF FPC}
zlibh, bzip2,
{$ENDIF FPC}
JclWideStrings, JclBase, JclStreams;

{$IFDEF RTL230_UP}
{$HPPEMIT '// To avoid ambiguity with System::Zlib::z_stream_s we force using ours'}
@@ -232,6 +239,7 @@ TJclDecompressStream = class(TJclCompressionStream)

TJclDecompressStreamClass = class of TJclDecompressStream;

{$IFNDEF FPC}
TJclCompressionStreamFormats = class
private
FCompressFormats: TList;
@@ -299,6 +307,7 @@ TJclZLibCompressStream = class(TJclCompressStream)
property Strategy: Integer read FStrategy write SetStrategy;
property CompressionLevel: Integer read FCompressionLevel write SetCompressionLevel;
end;
{$ENDIF FPC}

{$IFDEF ZLIB_RTL}
const
@@ -312,6 +321,7 @@ TJclZLibCompressStream = class(TJclCompressStream)
{$EXTERNALSYM PBytef}
{$ENDIF ZLIB_RTL}

{$IFNDEF FPC}
type
TJclZLibDecompressStream = class(TJclDecompressStream)
private
@@ -334,6 +344,7 @@ TJclZLibDecompressStream = class(TJclDecompressStream)

property WindowBits: Integer read FWindowBits write SetWindowBits;
end;
{$ENDIF FPC}

// GZIP Support

@@ -423,6 +434,7 @@ TJclZLibDecompressStream = class(TJclDecompressStream)
gfsMac, gfsZ, gfsCPM, gfsTOPS, gfsNTFS, gfsQDOS, gfsAcorn, gfsOther, gfsUnknown);

// Format is described in RFC 1952, http://www.faqs.org/rfcs/rfc1952.html
{$IFNDEF FPC}
TJclGZIPCompressionStream = class(TJclCompressStream)
private
FFlags: TJclGZIPFlags;
@@ -569,6 +581,7 @@ TJclBZIP2DecompressionStream = class(TJclDecompressStream)
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
end;
{$ENDIF FPC}

EJclCompressionError = class(EJclError);
EJclCompressionCancelled = class(EJclCompressionError);
@@ -577,6 +590,7 @@ EJclCompressionFalse = class(EJclCompressionError);
// callback type used in helper functions below:
TJclCompressStreamProgressCallback = procedure(FileSize, Position: Int64; UserData: Pointer) of object;

{$IFNDEF FPC}
{helper functions - one liners by wpostma}
function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean;
@@ -595,6 +609,7 @@ procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
procedure UnBZip2Stream(SourceStream, DestinationStream: TStream;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
{$ENDIF FPC}

// archive ancestor classes
{$IFDEF MSWINDOWS}
@@ -2401,6 +2416,7 @@ destructor TJclDecompressStream.Destroy;
inherited Destroy;
end;

{$IFNDEF FPC}
//=== { TJclCompressionStreamFormats } =======================================

constructor TJclCompressionStreamFormats.Create;
@@ -3591,6 +3607,8 @@ procedure InternalCompress(SourceStream: TStream; CompressStream: TJclCompressSt
ProgressCallback(SourceStreamSize, SourceStreamPosition, UserData);
end;

{$ENDIF FPC}

procedure InternalDecompress(SourceStream, DestStream: TStream;
DecompressStream: TJclDecompressStream;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer);
@@ -3629,6 +3647,8 @@ procedure InternalDecompress(SourceStream, DestStream: TStream;

{ Compress to a .gz file - one liner - NEW MARCH 2007 }

{$IFNDEF FPC}

function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean;
var
@@ -3832,6 +3852,8 @@ procedure UnBZip2Stream(SourceStream, DestinationStream: TStream;
end;
end;

{$ENDIF FPC}

{$IFDEF MSWINDOWS}

function OpenFileStream(const FileName: TFileName; StreamAccess: TJclStreamAccess): TStream;
@@ -55,7 +55,11 @@ interface
{$ENDIF MSWINDOWS}
{$ENDIF ~HAS_UNITSCOPE}
{$IFDEF HAS_UNIT_LIBC}
{$IFNDEF FPC}
Libc,
{$ELSE FPC}
libclite,
{$ENDIF ~FPC}
{$ENDIF HAS_UNIT_LIBC}
JclBase;

Oops, something went wrong.

0 comments on commit e27a494

Please sign in to comment.
You can’t perform that action at this time.