Skip to content
Permalink
Browse files

First changes for FPC trunk

  • Loading branch information...
LongDirtyAnimAlf committed Oct 28, 2019
1 parent f050f0c commit 1a93705f249987501c469f30e960803968cd00e9
Showing with 40 additions and 51 deletions.
  1. +2 −2 SQLite3/mORMot.pas
  2. +21 −6 SynCommons.pas
  3. +3 −3 SynEcc.pas
  4. +6 −25 SynFPCTypInfo.pas
  5. +6 −13 SynMongoDB.pas
  6. +1 −1 SynSQLite3Static.pas
  7. +1 −1 Synopse.inc
function TTypeInfo.AttributeTable: PFPCAttributeTable;
begin
result := GetTypeData(self);
dec(result); // re-adjust after SynFPCTypInfo.AlignTypeData() in GetTypeData()
dec(PByte(result),SizeOf(PFPCAttributeTable)); // ignore attributes table; // re-adjust after SynFPCTypInfo.AlignTypeData() in GetTypeData()
end;
{$endif FPC_PROVIDE_ATTR_TABLE}

P := GetTypeData(aInterface^);
{$ifdef FPC}
{$ifdef FPC_PROVIDE_ATTR_TABLE}
dec(PFPCAttributeTable(P)); // re-adjust our GetTypeData() to match TypInfo.pp
dec(PByte(P),SizeOf(PFPCAttributeTable)); // re-adjust our GetTypeData() to match TypInfo.pp
{$endif FPC_PROVIDE_ATTR_TABLE}
PI := P;
if PI^.Parent<>nil then
@@ -4845,7 +4845,7 @@ function ToText(k: TTypeKind): PShortString; overload;
/// map the Delphi/FPC dynamic array header (stored before each instance)
// - define globally for proper inlining with FPC
// - match tdynarray type definition in dynarr.inc
TDynArrayRec = packed record
TDynArrayRec = {packed} record
/// dynamic array reference count (basic garbage memory mechanism)
refCnt: PtrInt;
/// equals length-1
end;

{$ifdef HASALIGNTYPEDATA}
function FPCTypeInfoOverName(P: pointer): pointer; inline;
function FPCTypeInfoOverName(P: pointer): pointer;// inline;
begin // aligned result := @PAnsiChar(info)[info^.NameLen]
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
result := AlignTypeData(P+2+PTypeInfo(P)^.NameLen);
dec(PByte(result),2*SizeOf(pointer)); // -2 pointers to point on PTypeInfo^.kind
{$else}
result := AlignTypeData(P+PByte(P+1)^);
{$endif}
end;
{$endif HASALIGNTYPEDATA}

end;

function GetManagedFields(info: PTypeInfo; out firstfield: PFieldInfo): integer;
{$ifdef HASINLINE}inline;{$endif}
// {$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC_NEWRTTI}
var recInitData: PFPCRecInitData; // low-level type redirected from SynFPCTypInfo
var
recInitData: PFPCRecInitData; // low-level type redirected from SynFPCTypInfo
begin
//recInitData := GetFPCRecInitData(info^.RecInitInfo);
recInitData := GetFPCRecInitData(AlignTypeData(PByte(info)+2)); // +2=Kind+NameLen
if Assigned(info^.RecInitInfo) then
begin
recInitData := PFPCRecInitData(AlignToPtr(PTypeInfo(info^.RecInitInfo+2+PByte(info^.RecInitInfo+1)^)));
firstfield := pointer(PtrUInt(recInitData)+SizeOf(recInitData^)); // =ManagedFields[0]
result := recInitData^.ManagedFieldCount;
end
else
begin
inc(PByte(info),2);
dec(PByte(info),SizeOf(PFPCAttributeTable));
recInitData := PFPCRecInitData(pointer(info));
firstfield := pointer(PtrUInt(recInitData)+SizeOf(recInitData^)); // =ManagedFields[0]
result := recInitData^.ManagedFieldCount;
end;
{$else}
begin
firstfield := @info^.ManagedFields[0];
@@ -1896,13 +1896,13 @@ function getRandomNumber(out dest: THash256): integer;
{$ifdef CPUX64}
{$ifdef MSWINDOWS} // same .o format under Win64 for Delphi and FPC :)
{$ifdef ECC_O1}
{$L SynEcc64O1.o}
{$L static/x86_64-win64/eccwin64O1.o}
{$endif}
{$ifdef ECC_O2}
{$L SynEcc64O2.o}
{$L static/x86_64-win64/eccwin64O2.o}
{$endif}
{$ifdef ECC_O3}
{$L SynEcc64O3.o}
{$L static/x86_64-win64/eccwin64O3.o}
{$endif}
{$else}
{$ifdef FPC}
@@ -93,7 +93,6 @@ function AlignToPtr(p: pointer): pointer; inline;
{$ifdef FPC_NEWRTTI}
PFPCRecInitData = TypInfo.PRecInitData;

function GetFPCRecInitData(AlignedTypeData: Pointer): PFPCRecInitData;
{$endif FPC_NEWRTTI}

procedure FPCDynArrayClear(var a: Pointer; TypeInfo: Pointer);
@@ -106,15 +105,15 @@ procedure FPCRecordAddRef(var Data; TypeInfo : pointer);
implementation

procedure FPCDynArrayClear(var a: Pointer; TypeInfo: Pointer);
[external name 'FPC_DYNARRAY_CLEAR'];
external name 'FPC_DYNARRAY_CLEAR';
procedure FPCFinalizeArray(p: Pointer; TypeInfo: Pointer; elemCount: PtrUInt);
[external name 'FPC_FINALIZE_ARRAY'];
external name 'FPC_FINALIZE_ARRAY';
procedure FPCFinalize(Data: Pointer; TypeInfo: Pointer);
[external name 'FPC_FINALIZE'];
external name 'FPC_FINALIZE';
procedure FPCRecordCopy(const Source; var Dest; TypeInfo: pointer);
[external name 'FPC_COPY'];
external name 'FPC_COPY';
procedure FPCRecordAddRef(var Data; TypeInfo : pointer);
[external name 'FPC_ADDREF'];
external name 'FPC_ADDREF';

{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} // copied from latest typinfo.pp
function AlignToPtr(p: pointer): pointer;
@@ -145,27 +144,9 @@ TAlignCheck = record // match RTTI TTypeInfo definition
function AlignTypeData(p: pointer): pointer;
begin
result := p;
inc(PFPCAttributeTable(result)); // ignore attributes table
inc(PByte(result),SizeOf(PFPCAttributeTable)); // ignore attributes table
end;
{$endif FPC_PROVIDE_ATTR_TABLE}
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}

{$ifdef FPC_NEWRTTI}
function GetFPCRecInitData(AlignedTypeData: Pointer): PFPCRecInitData;
begin
{$ifdef FPC_PROVIDE_ATTR_TABLE}
dec(PFPCAttributeTable(AlignedTypeData)); // un-adjust AlignTypeData() above
{$endif FPC_PROVIDE_ATTR_TABLE}
if TypInfo.PTypeData(AlignedTypeData)^.RecInitInfo=nil then
result := AlignedTypeData else // no RecInitData, but regular list of fields
begin
result := TypInfo.PTypeData(AlignedTypeData)^.RecInitData;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
result := PFPCRecInitData(AlignTypeData(pointer(result)));
{$endif}
end;
end;
{$endif FPC_NEWRTTI}


end.
@@ -256,10 +256,10 @@ EBSONException = class(ESynException);

/// element types for BSON internal representation
TBSONElementType = (
betEOF, betFloat, betString, betDoc, betArray, betBinary,
betMinKey=-1, betEOF=0, betFloat, betString, betDoc, betArray, betBinary,
betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
betJSScope, betInt32, betTimestamp, betInt64, betDecimal128);
betJSScope, betInt32, betTimestamp, betInt64, betDecimal128, betMaxKey);

/// points to an element type for BSON internal representation
PBSONElementType = ^TBSONElementType;
@@ -822,13 +822,6 @@ TBSONWriter = class(TFileBufferWriter)


const
/// fake BSON element type which compares lower than all other possible values
// - element type sounds to be stored as shortint, so here $ff=-1<0=betEOF
betMinKey = TBSONElementType($ff);
/// fake BSON element type which compares higher than all other possible values
// - element type sounds to be stored as shortint, so here betInt64=$12<$7f
betMaxKey = TBSONElementType($7f);

/// kind of elements which will store a RawByteString/RawUTF8 content
// within its TBSONVariant kind
// - i.e. TBSONVariantData.VBlob/VText field is to be managed
@@ -2689,26 +2682,26 @@ procedure BSONItemsToDocVariant(Kind: TBSONElementType; BSON: PByte;
// - equals -1 for varying elements
BSON_ELEMENTSIZE: array[TBSONElementType] of integer = (
//betEOF, betFloat, betString, betDoc, betArray, betBinary,
0, sizeof(Double), -1, -1, -1, -1,
0, 0, sizeof(Double), -1, -1, -1, -1,
//betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
0, sizeof(TBSONObjectID), 1, sizeof(Int64),
//betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
0, -1, -1, -1, -1,
//betJSScope, betInt32, betTimestamp, betInt64, betDecimal128
-1, sizeof(Integer), sizeof(Int64), SizeOf(Int64), Sizeof(TDecimal128));
-1, sizeof(Integer), sizeof(Int64), SizeOf(Int64), Sizeof(TDecimal128), 0);

/// types which do not have an exact equivalency to a standard variant
// type will be mapped as varUnknown - and will be changed into
// BSONVariantType.VarType
BSON_ELEMENTTYPES: array[TBSONElementType] of word = (
//betEOF, betFloat, betString, betDoc, betArray, betBinary,
varEmpty, varDouble, varString, varUnknown, varUnknown, varUnknown,
varEmpty, varEmpty, varDouble, varString, varUnknown, varUnknown, varUnknown,
//betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
varEmpty, varUnknown, varBoolean, varDate,
//betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
varNull, varUnknown, varUnknown, varUnknown, varUnknown,
//betJSScope, betInt32, betTimestamp, betInt64, betDecimal128
varUnknown, varInteger, varUnknown, varInt64, varUnknown);
varUnknown, varInteger, varUnknown, varInt64, varUnknown, varEmpty);

function TBSONElement.ToVariant(DocArrayConversion: TBSONDocArrayConversion): variant;
begin
@@ -288,7 +288,7 @@ function log(x: double): double; cdecl; public name _PREFIX+'log'; export;
{$ifdef MSWINDOWS}
{$ifdef CPUX86} // not a compiler intrinsic on x86
function _InterlockedCompareExchange(var Dest: longint; New,Comp: longint): longint; stdcall;
[public, alias: '_InterlockedCompareExchange@12'];
public alias: '_InterlockedCompareExchange@12';
begin
result := InterlockedCompareExchange(Dest,New,Comp);
end;
@@ -259,7 +259,7 @@
{$define FPC_PROVIDE_ATTR_TABLE} // introducing TTypeData.AttributeTable
{$endif}
{$if not defined(VER3_0) and not defined(VER3_2) and not defined(VER2)}
{.$define FPC_PROVIDE_ATTR_TABLE} // to be defined since SVN 42356-42411
{$define FPC_PROVIDE_ATTR_TABLE} // to be defined since SVN 42356-42411
// on compilation error in SynFPCTypInfo, undefine the above conditional
// see https://lists.freepascal.org/pipermail/fpc-announce/2019-July/000612.html
{$ifend}

0 comments on commit 1a93705

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