Speicherausrichtung (Align) berechnen

[himitsu]

Aktuell sieht es so aus:

TXMLSerializeRDataType wären alle unterstützten Typen und daraus müßte man eigentlich alles Andere erstellen können.

Procedure TXMLSerializeRecordInfo.CalcOffsets; wäre die entscheidende Baustelle für die Berechnung.
Sitze grad an den ShortStrings und danach werd ich mal 'nen Test machen, ob das Aktuelle so überhaupt läuft und dann müßten irgendwie die Records und statischen Arrays mit rein.
Record und Array dürfte dann gleich sein, da ein Record ja eigentlich nur einem StaticArray mit Length=1 entsprechen müßte.

Delphi-Quellcode:

Type
  TXMLSerializeRDataType  = (rtByteBool, rtWordBool, rtLongBool, {rtBoolean, rtBOOL,}
    rtByte, rtWord, rtLongWord, rtWord64, {rtCardinal,}
    rtShortInt, rtSmallInt, rtLongInt, rtInt64, {rtInteger,}
    rtSingle, rtDouble, rtExtended, {rtReal,} rtCurrency, rtDateTime,
    rtAnsiCharArray, rtWideCharArray, {rtCharArray,} rtUtf8String,
    rtShortString, rtAnsiString, rtWideString, rtUnicodeString, {rtString,}
    rtBinary, rtPointer{=rtDynBinary}, rtVariant, rtObject,
    rtRecord, rtArray, rtDynArray, rtDummy, rtAlign);

  TXMLSerializeRecordInfo = Class
    Private
      _Parent:       TXMLSerializeRecordInfo;
      _Data: Array of Record
        Offset:      Integer;
        Size:        Integer;
        ElementSize: Integern;
        Name:        TWideString;
        DType:       TXMLSerializeRDataType;
        Elements:    Integer;  // for rtAnsiCharArray, rtWideCharArray, rtShortString, rtBinary, rtArray and rtDummy
        SubInfo:     TXMLSerializeRecordInfo; // for rtRecord, rtArray and rtDynArray
      End;
      _Align:        LongInt;
      _OffsetsOK:    Boolean;
      _Size:         LongInt;
      _ElementSize:  LongInt;
      _SOptions:     TXMLSerializeOptions;
      _SerProc:      TXMLSerializeProc;
      _DeSerProc:    TXMLDeserializeProc;
      _CreateProc:   TXMLClassCreateProc;
      Procedure CheckOffsets (Intern: Boolean = False);
      Procedure CalcOffsets;
      Function  GetCount:                       Integer;                 Inline;
      Function  GetFullOffset(Index:  Integer): Integer;
      Function  GetOffset    (Index:  Integer): Integer;                 Inline;
      Function  GetSize      (Index:  Integer): Integer;                 Inline;
      Function  GetName      (Index:  Integer): String;                  Inline;
      Function  GetDType     (Index:  Integer): TXMLSerializeRDataType;  Inline;
      Function  GetElements  (Index:  Integer): Integer;                 Inline;
      Function  GetSubInfo   (Index:  Integer): TXMLSerializeRecordInfo; Inline;
      Procedure Set_ObjectOpt(Source: TXMLSerializeRecordInfo);
      Procedure SetSOptions  (Value:  TXMLSerializeOptions); Inline;
      Procedure SetSerProc   (Value:  TXMLSerializeProc);    Inline;
      Procedure SetDeSerProc (Value:  TXMLDeserializeProc);  Inline;
      Procedure SetCreateProc(Value:  TXMLClassCreateProc);  Inline;
    Public
      Constructor Create;
      Destructor  Destroy; Override;
      Procedure SetAlign(     Align: LongInt = 4 {packed = 1}); Inline;
      Function  Add     (      Name: String; DType: TXMLSerializeRDataType; Elements: Integer = 1): TXMLSerializeRecordInfo;
      Function  IndexOf (Const Name: String):                  Integer; Overload;
      Function  IndexOf (RecordInfo: TXMLSerializeRecordInfo): Integer; Overload;
      Procedure Assign  (RecordInfo: TXMLSerializeRecordInfo);
      Procedure Parse   (Const S:    String);
      Procedure Clear;

      Property  Count:                      Integer                 Read GetCount;
      Property  FullOffset[Index: Integer]: Integer                 Read GetFullOffset;
      Property  Offset    [Index: Integer]: Integer                 Read GetOffset;
      Property  Size      [Index: Integer]: Integer                 Read GetSize;
      Property  Name      [Index: Integer]: String                  Read GetName;
      Property  DType     [Index: Integer]: TXMLSerializeRDataType  Read GetDType;
      Property  Elements  [Index: Integer]: Integer                 Read GetElements;
      Property  SubInfo   [Index: Integer]: TXMLSerializeRecordInfo Read GetSubInfo;
      Property  Align:                      LongInt                 Read _Align;

      // for (de)serialization of objects
      Property  SOptions:   TXMLSerializeOptions Read _SOptions   Write SetSOptions;
      Property  SerProc:    TXMLSerializeProc    Read _SerProc    Write SetSerProc;
      Property  DeSerProc:  TXMLDeserializeProc  Read _DeSerProc  Write SetDeSerProc;
      Property  CreateProc: TXMLClassCreateProc  Read _CreateProc Write SetCreateProc;
    End;

Const
  rtBoolean   = {$If SizeOf(Boolean)  = 1} rtByteBool      {$ELSE} unknown {$IFEND};
  rtBOOL      = {$If SizeOf(BOOL)     = 4} rtLongBool      {$ELSE} unknown {$IFEND};
  rtCardinal  = {$If SizeOf(Cardinal) = 4} rtLongWord      {$ELSE}
                {$If SizeOf(Cardinal) = 8} rtWord64        {$ELSE} unknown {$IFEND}{$IFEND};
  rtInteger   = {$If SizeOf(Integer)  = 4} rtLongInt       {$ELSE}
                {$If SizeOf(Integer)  = 8} rtInt64         {$ELSE} unknown {$IFEND}{$IFEND};
  rtReal      = {$If SizeOf(Real)     = 4} rtSingle        {$ELSE}
                {$If SizeOf(Real)     = 8} rtDouble        {$ELSE}
                {$If SizeOf(Real)    = 10} rtExtended      {$ELSE} unknown {$IFEND}{$IFEND}{$IFEND};
  rtCharArray = {$If SizeOf(Char)     = 1} rtAnsiCharArray {$ELSE}
                {$If SizeOf(Char)     = 2} rtWideCharArray {$ELSE} unknown {$IFEND}{$IFEND};
  rtString    = {$If SizeOf(Char)     = 1} rtAnsiString    {$ELSE}
                {$If (SizeOf(Char)    = 2) and not Declared(UnicodeString)} rtWideString    {$ELSE}
                {$IF (SizeOf(Char)    = 2) and     Declared(UnicodeString)} rtUnicodeString {$ELSE} unknown {$IFEND}{$IFEND}{$IFEND};

Procedure TXMLSerializeRecordInfo.CheckOffsets(Intern: Boolean = False);
  Var i: Integer;

  Begin
    If not Intern Then  While Assigned(_Parent) do Self := _Parent;
    For i := 0 to High(_Data) do
      If _OffsetsOK and Assigned(_Data[i].SubInfo) Then Begin
        _Data[i].SubInfo.CheckOffsets(True);
        _OffsetsOK := _OffsetsOK and _Data[i].SubInfo._OffsetsOK;
      End;
    If not _OffsetsOK Then CalcOffsets;
  End;

Procedure TXMLSerializeRecordInfo.CalcOffsets;
  Const DSize: Array[TXMLSerializeRDataType] of Byte = (1, 2, 4, 1, 2, 4, 8,
      1, 2, 4, 8, 4, 8, 10, 8, 8, 0, 0, SizeOf(Pointer), 0, SizeOf(Pointer),
      SizeOf(Pointer), SizeOf(Pointer), 0, SizeOf(Pointer), SizeOf(Variant),
      SizeOf(TObject), 0, 0, SizeOf(Pointer), 0, 0);

  Var D, i, i2: Integer;

  Begin
    _OffsetsOK := False;
    _Size      := 0;
    D          := -2;
    For i := 0 to High(_Data) do Begin
      If Assigned(_Data[i].SubInfo) Then Begin
        _Data[i].Size := DSize[_Data[i].DType];
        _Data[i].SubInfo.CalcOffsets;
      End Else _Data[i].Size := DSize[_Data[i].DType];
      If D <> _Data[i].Size Then D := -1;
      Case _Data[i].DType of
        rtByteBool, rtWordBool, rtLongBool,
        rtByte, rtWord, rtLongWord, rtWord64,
        rtShortInt, rtSmallInt, rtLongInt, rtInt64,
        rtSingle, rtDouble, rtExtended, rtCurrency, rtDateTime,
        rtUtf8String, rtAnsiString, rtWideString, rtUnicodeString,
        rtPointer, rtVariant, rtObject, rtDynArray: Begin
          i2 := _Data[i].Size;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Size);
        End;
        rtAnsiCharArray, rtBinary, rtDummy: Begin
          If D = -2 Then D := 1 Else If D <> 1 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Elements);
        End;
        rtWideCharArray: Begin
          i2 := 2;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
          Inc(_Size, _Data[i].Elements * 2);
        End;
        rtShortString: Begin

        End;
        rtRecord, rtArray: Begin

        End;
        rtAlign: Begin
          i2 := _Data[i].Elements;
          If i2 > _Align Then i2 := _Align;
          If D = -2 Then D := i2 Else If D <> i2 Then D := -1;
          Inc(_Size, (i2 - _Size mod i2) mod i2);
        End;
      End;
    End;
    _OffsetsOK := True;
  End;

Function TXMLSerializeRecordInfo.GetCount: Integer;
  {inline}

  Begin
    Result := Length(_Data);
  End;

Function TXMLSerializeRecordInfo.GetFullOffset(Index: Integer): Integer;
  Begin
    CheckOffsets;
    If (Index >= 0) and (Index < Length(_Data)) Then Begin
      Result := _Data[Index].Offset;
      If Assigned(_Parent) Then Inc(Result, _Parent.FullOffset[_Parent.IndexOf(Self)]);
    End Else Result := -1;
  End;

Function TXMLSerializeRecordInfo.GetOffset(Index: Integer): Integer;
  {inline}

  Begin
    CheckOffsets;
    If (Index < 0) or (Index >= Length(_Data)) Then Result := -1
    Else Result := _Data[Index].Offset;
  End;

Function TXMLSerializeRecordInfo.GetSize(Index: Integer): Integer;
  {inline}

  Begin
    CheckOffsets;
    If (Index < 0) or (Index >= Length(_Data)) Then Result := -1
    Else Result := _Data[Index].Size;
  End;

Function TXMLSerializeRecordInfo.GetName(Index: Integer): String;
  {inline}

  Begin
    If (Index < 0) or (Index >= Length(_Data)) Then Result := ''
    Else Result := String(_Data[Index].Name);
  End;

Function TXMLSerializeRecordInfo.GetDType(Index: Integer): TXMLSerializeRDataType;
  {inline}

  Begin
    If (Index < 0) or (Index >= Length(_Data)) Then Result := Pred(Low(TXMLSerializeRDataType))
    Else Result := _Data[Index].DType;
  End;

Function TXMLSerializeRecordInfo.GetElements(Index: Integer): Integer;
  {inline}

  Begin
    If (Index < 0) or (Index >= Length(_Data)) Then Result := -1
    Else Result := _Data[Index].Elements;
  End;

Function TXMLSerializeRecordInfo.GetSubInfo(Index: Integer): TXMLSerializeRecordInfo;
  {inline}

  Begin
    If (Index < 0) or (Index >= Length(_Data)) Then Result := nil
    Else Result := _Data[Index].SubInfo;
  End;

Procedure TXMLSerializeRecordInfo.Set_ObjectOpt(Source: TXMLSerializeRecordInfo);
  Var i: Integer;

  Begin
    _SOptions   := Source._SOptions;
    _SerProc    := Source._SerProc;
    _DeSerProc  := Source._DeSerProc;
    _CreateProc := Source._CreateProc;
    If Assigned(_Parent) and (_Parent <> Self) Then
      _Parent.Set_ObjectOpt(Self);
    For i := 0 to High(_Data) do
      If Assigned(_Data[i].SubInfo) and (_Data[i].SubInfo <> Self) Then
        _Data[i].SubInfo.Set_ObjectOpt(Self);
  End;

Procedure TXMLSerializeRecordInfo.SetSOptions(Value: TXMLSerializeOptions);
  {inline}

  Begin
    _SOptions := Value + [xsSaveClassType];
    Set_ObjectOpt(Self);
  End;

Procedure TXMLSerializeRecordInfo.SetSerProc(Value: TXMLSerializeProc);
  {inline}

  Begin
    _SerProc := Value;
    Set_ObjectOpt(Self);
  End;

Procedure TXMLSerializeRecordInfo.SetDeSerProc(Value: TXMLDeserializeProc);
  {inline}

  Begin
    _DeSerProc := Value;
    Set_ObjectOpt(Self);
  End;

Procedure TXMLSerializeRecordInfo.SetCreateProc(Value: TXMLClassCreateProc);
  {inline}

  Begin
    _CreateProc := Value;
    Set_ObjectOpt(Self);
  End;

Constructor TXMLSerializeRecordInfo.Create;
  Var X: TSearchRec;

  Begin
    Inherited;
    _Align    := Integer(@X.Size) - Integer(@X.Time);
    _SOptions := [xsSaveClassType];
  End;

Destructor TXMLSerializeRecordInfo.Destroy;
  Begin
    Clear;
    Inherited;
  End;

Procedure TXMLSerializeRecordInfo.SetAlign(Align: LongInt = 4);
  {inline}

  Begin
    _OffsetsOK := False;
    If Align in [1, 2, 4, 8] Then _Align := Align;
  End;

Function TXMLSerializeRecordInfo.Add(Name: String; DType: TXMLSerializeRDataType; Elements: Integer = 1): TXMLSerializeRecordInfo;
  Var i: Integer;

  Begin
    _OffsetsOK := False;
    i := Length(_Data);
    Name := Trim(Name);
    If Name = '' Then Name := Format('rec:%d', [i]);
    If not TXHelper.CheckString(Name, xtElement_NodeName) and (IndexOf(Name) >= 0) Then
      Raise EXMLException.Create(ClassType, 'Add', @SInvalidValue, Name);
    SetLength(_Data, i + 1);
    _Data[i].Name  := TWideString(Name);
    _Data[i].DType := DType;
    If DType in [rtAnsiCharArray, rtWideCharArray, rtShortString, rtBinary, rtArray, rtDummy, rtAlign] Then
      _Data[i].Elements := Elements Else _Data[i].Elements := 1;
    _Data[i].SubInfo := nil;
    If DType in [rtRecord, rtArray, rtDynArray] Then Begin
      _Data[i].SubInfo := TXMLSerializeRecordInfo.Create;
      _Data[i].SubInfo._Parent     := Self;
    //_Data[i].SubInfo._Align      := _Align;  // set by constructor
      _Data[i].SubInfo._SOptions   := _SOptions;
      _Data[i].SubInfo._SerProc    := _SerProc;
      _Data[i].SubInfo._DeSerProc  := _DeSerProc;
      _Data[i].SubInfo._CreateProc := _CreateProc;
    End;
    Result := _Data[i].SubInfo;
  End;

Function TXMLSerializeRecordInfo.IndexOf(Const Name: String): Integer;
  Begin
    Result := High(_Data);
    While (Result >= 0) and not TXHelper.MatchText(Name, _Data[Result].Name, False) do Dec(Result);
  End;

Function TXMLSerializeRecordInfo.IndexOf(RecordInfo: TXMLSerializeRecordInfo): Integer;
  Begin
    Result := High(_Data);
    While (Result >= 0) and (not Assigned(RecordInfo)
        or (RecordInfo <> _Data[Result].SubInfo)) do Dec(Result);
  End;

Procedure TXMLSerializeRecordInfo.Assign(RecordInfo: TXMLSerializeRecordInfo);
  Var i: Integer;

  Begin
    Clear;
    SetAlign(RecordInfo.Align);
    For i := 0 to RecordInfo.Count do Begin
      Add(RecordInfo.Name[i], RecordInfo.DType[i], RecordInfo.Elements[i]);
      If Assigned(RecordInfo.SubInfo[i]) Then SubInfo[i].Assign(RecordInfo.SubInfo[i]);
    End;
  End;

Procedure TXMLSerializeRecordInfo.Parse(Const S: String);
  Const Convert: Array[0..37] of Record
      Key:      Char;
      Typ:      TXMLSerializeRDataType;
      Size:     Char;
      Elements: Boolean;
    End = (
      (Key: 'b'; Typ: rtByteBool;      Size: '1'                ),
      (Key: 'b'; Typ: rtWordBool;      Size: '2'                ),
      (Key: 'b'; Typ: rtLongBool;      Size: '4'                ),
      (Key: 'b'; Typ: rtBoolean                                 ),
      (Key: 'b'; Typ: rtBOOL;          Size: 'x'                ),
      (Key: 'w'; Typ: rtByte;          Size: '1'                ),
      (Key: 'w'; Typ: rtWord;          Size: '2'                ),
      (Key: 'w'; Typ: rtLongWord;      Size: '4'                ),
      (Key: 'w'; Typ: rtWord64;        Size: '8'                ),
      (Key: 'w'; Typ: rtCardinal                                ),
      (Key: 'i'; Typ: rtShortInt;      Size: '1'                ),
      (Key: 'i'; Typ: rtSmallInt;      Size: '2'                ),
      (Key: 'i'; Typ: rtLongInt;       Size: '4'                ),
      (Key: 'i'; Typ: rtInt64;         Size: '8'                ),
      (Key: 'i'; Typ: rtInteger                                 ),
      (Key: 'f'; Typ: rtSingle;        Size: '4'                ),
      (Key: 'f'; Typ: rtDouble;        Size: '8'                ),
      (Key: 'f'; Typ: rtExtended;      Size: '0'                ),
      (Key: 'f'; Typ: rtReal                                    ),
      (Key: 'y'; Typ: rtCurrency                                ),
      (Key: 't'; Typ: rtDateTime                                ),
      (Key: 'c'; Typ: rtAnsiCharArray; Size: 'a'; Elements: True),
      (Key: 'c'; Typ: rtWideCharArray; Size: 'w'; Elements: True),
      (Key: 'c'; Typ: rtCharArray;                Elements: True),
      (Key: 'u'; Typ: rtUtf8String                              ),
      (Key: 's'; Typ: rtShortString;   Size: 's'; Elements: True),
      (Key: 's'; Typ: rtAnsiString;    Size: 'a'                ),
      (Key: 's'; Typ: rtWideString;    Size: 'w'                ),
      (Key: 's'; Typ: rtUnicodeString; Size: 'u'                ),
      (Key: 's'; Typ: rtString                                  ),
      (Key: 'x'; Typ: rtBinary;                   Elements: True),
      (Key: 'v'; Typ: rtVariant                                 ),
      (Key: 'o'; Typ: rtObject                                  ),
      (Key: 'r'; Typ: rtRecord                                  ),
      (Key: 'a'; Typ: rtArray;                    Elements: True),
      (Key: 'd'; Typ: rtDynArray                                ),
      (Key: 'n'; Typ: rtDummy;                    Elements: True),
      (Key: 'l'; Typ: rtAlign;                    Elements: True));

  Var C:           Char;
    S2:            String;
    i, i2, i3, i4: Integer;

  Begin
    i := 1;
    While i <= Length(S) do
      Case S[i] of
        #9, ' ': Inc(i);
        '(', '[', '{': Begin
          Case S[i] of
            '(': C := ')';
            '[': C := ']';
            Else C := '}';
          End;
          i3 := 0;
          i2 := i;
          Repeat
            If S[i2] = S[i] Then Inc(i3);
            If S[i2] = C Then Dec(i3);
            Inc(i2);
          Until (i3 = 0) or (i2 > Length(S));
          If (i3 <> 0) or not Assigned(_Data) or not Assigned(_Data[High(_Data)].SubInfo) Then
            Raise EXMLException.Create(ClassType, 'Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
          _Data[High(_Data)].SubInfo.Parse(Copy(S, i + 1, i2 - i - 2));
          i := i2;
        End;
        'P', 'p':
          If (i < Length(S)) and ((S[i + 1] = '1') or (S[i + 1] = '2')
              or (S[i + 1] = '4') or (S[i + 1] = '8')) Then Begin
            SetAlign(Ord(S[i + 1]) - Ord('0'));
            Inc(i, 2);
          End Else Raise EXMLException.Create(ClassType, 'Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
        Else Begin
          i2 := 0;
          Repeat
            If (Char(Ord(S[i]) or $20) = Convert[i2].Key) and ((Convert[i2].Size = #0) or
                ((i < Length(S)) and (Char(Ord(S[i + 1]) or $20) = Convert[i2].Size))) Then Begin
              Inc(i);
              If Convert[i2].Size <> #0 Then Inc(i);
              If Convert[i2].Elements Then Begin
                i3 := 0;
                While (i3 < $0CCCCCCC) and (i <= Length(S))
                    and (S[i] >= '0') and (S[i] <= '9') do Begin
                  i3 := i3 * 10 + (Ord(S[i]) - Ord('0'));
                  Inc(i);
                End;
              End Else i3 := 1;
              S2 := '';
              If (i < Length(S)) and (S[i] = '"') Then Begin
                i4 := i + 1;
                While (i4 < Length(S)) and (S[i4] <> '"') do Inc(i4);
                If S[i4] <> '"' Then
                  Raise EXMLException.Create(ClassType, 'Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
                S2 := Copy(S, i + 1, i4 - i - 1);
                i := i4 + 1;
              End Else If (i < Length(S)) and ((S[i] = '>') or (S[i] = '=')) Then Begin
                i4 := i + 1;
                While (i4 <= Length(S)) and (S[i4] <> ' ') and (S[i4] <> #9) do Inc(i4);
                S2 := Copy(S, i + 1, i4 - i);
                i := i4;
              End;
              Add(S2, Convert[i2].Typ, i3);
              Break;
            End;
            Inc(i2);
          Until i2 > High(Convert);
          If i2 > High(Convert) Then
            Raise EXMLException.Create(ClassType, 'Record-Parse', @SInvalidValue, [Copy(S, i, 25)]);
        End;
      End;
  End;

Procedure TXMLSerializeRecordInfo.Clear;
  Var i: Integer;

  Begin
    _OffsetsOK := False;
    For i := High(_Data) downto 0 do _Data[i].SubInfo.Free;
    _Data := nil;
  End;

Und warum kann Delphi eigentlich noch kein {$ALIGN 16}