Reworking DataRecords and DataFlow
This commit is contained in:
Michael Schimmel
+144
-102
@@ -9,56 +9,72 @@ uses
|
||||
System.TypInfo;
|
||||
|
||||
type
|
||||
TDataFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
|
||||
|
||||
TDataRecord = record
|
||||
public
|
||||
type
|
||||
TFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
|
||||
|
||||
TField = record
|
||||
private
|
||||
FFieldType: TDataFieldType;
|
||||
FFieldType: TFieldType;
|
||||
FName: string;
|
||||
FOffset: Integer;
|
||||
FSize: Integer;
|
||||
|
||||
procedure Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
procedure Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
procedure Finalize(P: Pointer);
|
||||
procedure FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src);
|
||||
procedure ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst);
|
||||
|
||||
procedure Assign(const [ref] Buffer: TBytes; const Src); overload;
|
||||
procedure Finalize(const [ref] Buffer: TBytes);
|
||||
|
||||
property Offset: Integer read FOffset;
|
||||
property Size: Integer read FSize;
|
||||
|
||||
constructor Create(const AName: string; AFieldType: TFieldType; AOffset: Integer);
|
||||
|
||||
function GetSize: Integer; inline;
|
||||
function GetAlignedSize: Integer; inline;
|
||||
|
||||
public
|
||||
constructor Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
|
||||
class function From<T>(const AName: string; Offset: Integer): TField; overload; static;
|
||||
class function From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField; overload; static;
|
||||
|
||||
property FieldType: TDataFieldType read FFieldType;
|
||||
property FieldType: TFieldType read FFieldType;
|
||||
property Name: string read FName;
|
||||
property Size: Integer read GetSize;
|
||||
property AlignedSize: Integer read GetAlignedSize;
|
||||
end;
|
||||
|
||||
TFieldDef = record
|
||||
public
|
||||
Name: String;
|
||||
FieldType: TFieldType
|
||||
end;
|
||||
|
||||
TLayout = record
|
||||
private
|
||||
FFields: TArray<TField>;
|
||||
public
|
||||
|
||||
constructor Create(const AFields: TArray<TField>);
|
||||
class function CreateFrom<T>: TLayout; static;
|
||||
function GetBufferSize: Integer;
|
||||
public
|
||||
class function FromRecord<T>: TLayout; static;
|
||||
class function Construct(const Def: TArray<TFieldDef>): TLayout; static;
|
||||
|
||||
function IndexOf(const Name: String): Integer;
|
||||
property Fields: TArray<TField> read FFields;
|
||||
end;
|
||||
|
||||
const
|
||||
Align = 8;
|
||||
|
||||
private
|
||||
FLayout: TLayout;
|
||||
FBuffer: TBytes;
|
||||
|
||||
public
|
||||
constructor Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
const
|
||||
DataSize: array[TFieldType] of Integer = (sizeof(Double), sizeof(Int64), sizeof(String), sizeof(TDateTime));
|
||||
|
||||
class function CreateFrom<T>: TDataRecord; overload; static;
|
||||
class function CreateFrom<T>(const Src: T): TDataRecord; overload; static;
|
||||
class function CreateFrom(const Layout: TLayout): TDataRecord; overload; static;
|
||||
procedure CopyFrom<T>(const Src: T);
|
||||
public
|
||||
constructor Create(const ALayout: TLayout; const ABuffer: TBytes = nil);
|
||||
class operator Finalize(var Dest: TDataRecord);
|
||||
|
||||
class function FromRecord<T>: TDataRecord; overload; static;
|
||||
class function FromRecord<T>(const Src: T): TDataRecord; overload; static;
|
||||
|
||||
procedure SetValue<T>(const Name: String; const Value: T); overload;
|
||||
procedure SetValue(Idx: Integer; const Value); overload;
|
||||
@@ -66,7 +82,7 @@ type
|
||||
function GetValue<T>(const Name: String): T; overload;
|
||||
procedure GetValue(Idx: Integer; out Value); overload;
|
||||
|
||||
class operator Finalize(var Dest: TDataRecord);
|
||||
procedure CopyField(Idx: Integer; Dst: TDataRecord; DstIdx: Integer);
|
||||
|
||||
property Layout: TLayout read FLayout;
|
||||
end;
|
||||
@@ -74,17 +90,41 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes,
|
||||
Myc.DataRecord.Impl;
|
||||
System.Classes;
|
||||
|
||||
constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes = nil);
|
||||
begin
|
||||
FLayout := ALayout;
|
||||
FBuffer := ABuffer;
|
||||
|
||||
var bufSize := 0;
|
||||
if Length(FLayout.Fields) > 0 then
|
||||
with FLayout.Fields[High(FLayout.Fields)] do
|
||||
bufSize := Offset + AlignedSize;
|
||||
|
||||
if FBuffer = nil then
|
||||
SetLength(FBuffer, bufSize)
|
||||
else
|
||||
Assert(Length(FBuffer) >= bufSize);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.CopyFrom<T>(const Src: T);
|
||||
procedure TDataRecord.CopyField(Idx: Integer; Dst: TDataRecord; DstIdx: Integer);
|
||||
begin
|
||||
Assert(Dst.Layout.Fields[DstIdx].FieldType = FLayout.Fields[Idx].FieldType);
|
||||
Dst.Layout.Fields[DstIdx].Assign(Dst.FBuffer, FBuffer[FLayout.Fields[DstIdx].Offset])
|
||||
end;
|
||||
|
||||
{ TDataRecord }
|
||||
|
||||
class function TDataRecord.FromRecord<T>: TDataRecord;
|
||||
begin
|
||||
Result := TDataRecord.Create(TLayout.FromRecord<T>);
|
||||
end;
|
||||
|
||||
class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord;
|
||||
begin
|
||||
Result := FromRecord<T>;
|
||||
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
var rttiFields := rttiType.GetFields;
|
||||
@@ -93,41 +133,17 @@ begin
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
var rf := rttiFields[i];
|
||||
var idx := FLayout.IndexOf(rf.Name);
|
||||
var idx := Result.Layout.IndexOf(rf.Name);
|
||||
|
||||
if (idx >= 0) then
|
||||
begin
|
||||
var fld := FLayout.Fields[idx];
|
||||
|
||||
var S: PByte := @Src;
|
||||
inc(S, rf.Offset);
|
||||
var P := @FBuffer[FLayout.Fields[idx].Offset];
|
||||
|
||||
fld.Write(rf.FieldType.Handle, S^, P);
|
||||
Result.Layout.Fields[idx].FromType(Result.FBuffer, rf.FieldType.Handle, S^);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateFrom(const Layout: TLayout): TDataRecord;
|
||||
begin
|
||||
var buf: TBytes;
|
||||
SetLength(buf, Layout.GetBufferSize);
|
||||
Result.Create(Layout, buf);
|
||||
end;
|
||||
|
||||
{ TDataRecord }
|
||||
|
||||
class function TDataRecord.CreateFrom<T>: TDataRecord;
|
||||
begin
|
||||
Result := CreateFrom(TLayout.CreateFrom<T>);
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateFrom<T>(const Src: T): TDataRecord;
|
||||
begin
|
||||
Result := CreateFrom<T>;
|
||||
Result.CopyFrom<T>(Src);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.GetValue(Idx: Integer; out Value);
|
||||
begin
|
||||
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
||||
@@ -158,51 +174,56 @@ function TDataRecord.GetValue<T>(const Name: String): T;
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Read(@FBuffer[FLayout.Fields[idx].Offset], TypeInfo(T), Result);
|
||||
FLayout.Fields[idx].ToType(FBuffer, TypeInfo(T), Result);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Write(TypeInfo(T), Value, @FBuffer[FLayout.Fields[idx].Offset]);
|
||||
FLayout.Fields[idx].FromType(FBuffer, TypeInfo(T), Value);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Finalize(var Dest: TDataRecord);
|
||||
begin
|
||||
for var i := 0 to High(Dest.FLayout.Fields) do
|
||||
Dest.FLayout.Fields[i].Finalize(@Dest.FBuffer[Dest.FLayout.Fields[i].Offset]);
|
||||
Dest.FLayout.Fields[i].Finalize(Dest.FBuffer);
|
||||
end;
|
||||
|
||||
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; AOffset: Integer);
|
||||
begin
|
||||
FName := AName;
|
||||
FFieldType := AFieldType;
|
||||
FOffset := AOffset;
|
||||
FSize := ASize;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Finalize(P: Pointer);
|
||||
procedure TDataRecord.TField.Finalize(const [ref] Buffer: TBytes);
|
||||
begin
|
||||
if not (FFieldType in [dfString]) then
|
||||
exit;
|
||||
|
||||
Assert(FOffset + Size <= Length(Buffer));
|
||||
|
||||
var P := @Buffer[FOffset];
|
||||
case FFieldType of
|
||||
dfFloat: PDouble(P)^ := 0;
|
||||
dfInteger: PInt64(P)^ := 0;
|
||||
dfString: PString(P)^ := '';
|
||||
dfTimestamp: PDateTime(P)^ := 0;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src);
|
||||
begin
|
||||
Assert(FOffset + Size <= Length(Buffer));
|
||||
|
||||
Finalize(Buffer);
|
||||
|
||||
var Dst := @Buffer[FOffset];
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
case GetTypeData(SrcType).FloatType of
|
||||
ftSingle: PDouble(P)^ := PSingle(@Src)^;
|
||||
ftDouble: PDouble(P)^ := PDouble(@Src)^;
|
||||
ftSingle: PDouble(Dst)^ := PSingle(@Src)^;
|
||||
ftDouble: PDouble(Dst)^ := PDouble(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -210,8 +231,8 @@ begin
|
||||
dfInteger:
|
||||
begin
|
||||
case SrcType.Kind of
|
||||
tkInteger: PInt64(P)^ := PInteger(@Src)^;
|
||||
tkInt64: PInt64(P)^ := PInt64(@Src)^;
|
||||
tkInteger: PInt64(Dst)^ := PInteger(@Src)^;
|
||||
tkInt64: PInt64(Dst)^ := PInt64(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -219,41 +240,31 @@ begin
|
||||
dfString:
|
||||
begin
|
||||
Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]);
|
||||
PString(P)^ := PString(@Src)^;
|
||||
PString(Dst)^ := PString(@Src)^;
|
||||
end;
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
PDateTime(P)^ := PDateTime(@Src)^;
|
||||
PDateTime(Dst)^ := PDateTime(@Src)^;
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField;
|
||||
function TDataRecord.TField.GetSize: Integer;
|
||||
begin
|
||||
case rttiType.TypeKind of
|
||||
tkInteger, tkInt64: Result.Create(AName, dfInteger, Offset, sizeof(Int64));
|
||||
tkFloat:
|
||||
if (rttiType.Name = 'TDateTime') then
|
||||
Result.Create(AName, dfTimestamp, Offset, sizeof(TDateTime))
|
||||
else
|
||||
Result.Create(AName, dfFloat, Offset, sizeof(Double));
|
||||
tkString, tkWString, tkLString, tkUString: Result.Create(AName, dfString, Offset, sizeof(String));
|
||||
else
|
||||
raise Exception.Create('Type not supported');
|
||||
end;
|
||||
Result := DataSize[FFieldType];
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From<T>(const AName: string; Offset: Integer): TField;
|
||||
function TDataRecord.TField.GetAlignedSize: Integer;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
Result := From(AName, ctx.GetType(TypeInfo(T)), Offset);
|
||||
Result := (GetSize + (Align - 1)) and not (Align - 1);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst);
|
||||
begin
|
||||
var Src := @Buffer[FOffset];
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
@@ -289,14 +300,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Assign(const [ref] Buffer: TBytes; const Src);
|
||||
begin
|
||||
Assert(FOffset + Size <= Length(Buffer));
|
||||
|
||||
Finalize(Buffer);
|
||||
|
||||
var Dst := @Buffer[FOffset];
|
||||
case FFieldType of
|
||||
dfFloat: PDouble(Dst)^ := PDouble(@Src)^;
|
||||
dfInteger: PInt64(Dst)^ := PInt64(@Src)^;
|
||||
dfString: PString(Dst)^ := PString(@Src)^;
|
||||
dfTimestamp: PDateTime(Dst)^ := PDateTime(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
|
||||
begin
|
||||
FFields := AFields;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TLayout.Construct(const Def: TArray<TFieldDef>): TLayout;
|
||||
var
|
||||
Fields: TArray<TField>;
|
||||
begin
|
||||
SetLength(Fields, Length(Def));
|
||||
var ofs := 0;
|
||||
for var i := 0 to High(Fields) do
|
||||
begin
|
||||
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ofs);
|
||||
inc(ofs, Fields[i].AlignedSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TLayout }
|
||||
|
||||
class function TDataRecord.TLayout.CreateFrom<T>: TLayout;
|
||||
class function TDataRecord.TLayout.FromRecord<T>: TLayout;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
@@ -309,24 +350,25 @@ begin
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
var rf := rttiFields[i];
|
||||
fields[i] := TField.From(rf.Name, rf.FieldType, ofs);
|
||||
inc(ofs, fields[i].Size);
|
||||
ofs := (ofs + 7) and not 7;
|
||||
|
||||
case rf.FieldType.TypeKind of
|
||||
tkInteger, tkInt64: fields[i] := TField.Create(rf.Name, dfInteger, ofs);
|
||||
tkFloat:
|
||||
if SameText(rf.FieldType.Name, 'TDateTime') then
|
||||
fields[i] := TField.Create(rf.Name, dfTimestamp, ofs)
|
||||
else
|
||||
fields[i] := TField.Create(rf.Name, dfFloat, ofs);
|
||||
tkString, tkWString, tkLString, tkUString: fields[i] := TField.Create(rf.Name, dfString, ofs);
|
||||
else
|
||||
raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');
|
||||
end;
|
||||
|
||||
inc(ofs, fields[i].AlignedSize);
|
||||
end;
|
||||
|
||||
Result.Create(fields);
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.GetBufferSize: Integer;
|
||||
begin
|
||||
if (Length(FFields) = 0) then
|
||||
exit(0);
|
||||
|
||||
var n := High(FFields);
|
||||
Result := FFields[n].FOffset + FFields[n].Size;
|
||||
Result := (Result + 7) and not 7;
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
|
||||
begin
|
||||
for var i := 0 to High(FFields) do
|
||||
|
||||
Reference in New Issue
Block a user