Thema: Delphi Speicherausrichtung (Align) berechnen

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.033 Beiträge
 
Delphi 12 Athens
 
#13

Re: Speicherausrichtung (Align) berechnen

  Alt 26. Nov 2009, 11:37
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.

zusammenfalten · markieren
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}
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat