Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Вопрос по выравниванию  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 11780
Есть такая структура
  TBaseMsg = record
    Arg1Val: Integer;
    Arg1Null: WordBool;
    Arg2Val: SmallInt;
    Arg2Null: WordBool;
  end;
хочу оптимизировать запись этой структуры и объявляю ее так
  TGenRec<T> = record
    Val: T;
    IsNull: WordBool;
  end;

  TTestMsg = record
    Arg1: TGenRec<Integer>;
    Arg2: TGenRec<Smallint>;
  end;
в моем понимании я ничего не изменил. Но теперь перестало читаться поле Arg2.Val.

+ Тест
procedure Test(AData: Pointer);
var
  LInArgs1: PTestMsg absolute AData;
  LInArgs2: PBaseMsg absolute AData;
  LBuf: string;
  Li: Integer;
begin
    Writeln(LLog, '----- Use generic record --------');
    Writeln(LLog, 'Size: ', SizeOf(LInArgs1^));

    SetLength(LBuf, SizeOf(LInArgs1^) * 2);
    BinToHex(LInArgs1, PChar(LBuf), SizeOf(LInArgs1^));
    // Форматируем вывод по 4 октета
    LBuf := LBuf.PadRight((Length(LBuf) + 7) and not 7);
    Li := Length(LBuf);
    while Li > 8 do begin
      Dec(Li, 8);
      Insert(' ', LBuf, Li);
    end;
    Writeln(LLog, 'Data: ', LBuf);
    Writeln(LLog, 'Arg1: ', LInArgs1^.Arg1.Val);
    Writeln(LLog, 'Arg2: ', LInArgs1^.Arg2.Val);

    Writeln(LLog, '----- Use base record --------');
    Writeln(LLog, 'Size: ', SizeOf(LInArgs2^));

    SetLength(LBuf, SizeOf(LInArgs2^) * 2);
    BinToHex(LInArgs2, PChar(LBuf), SizeOf(LInArgs2^));
    LBuf := LBuf.PadRight((Length(LBuf) + 7) and not 7);
    Li := Length(LBuf);
    while Li > 8 do begin
      Dec(Li, 8);
      Insert(' ', LBuf, Li);
    end;
    Writeln(LLog, 'Data: ', LBuf);
    Writeln(LLog, 'Arg1: ', LInArgs2^.Arg1Val);
    Writeln(LLog, 'Arg2: ', LInArgs2^.Arg2Val);
end;
Вывод
----- Use generic record --------
Size: 12
Data: 1000000 00000FF0 000000000
Arg1: 16
Arg2: 0
----- Use base record --------
Size: 12
Data: 1000000 00000FF0 000000000
Arg1: 16
Arg2: 255
Правильное значение аргументов 16, 255. Где я не прав? Почему Smallint уезжает?
+ Полный тест
procedure Test(AData: Pointer);
var
  LInArgs1: PTestMsg absolute AData;
  LInArgs2: PBaseMsg absolute AData;
  LFileName: string;
  LLog: TextFile;
  LBuf: string;
  Li: Integer;
begin
  LFileName := ChangeFileExt(GetModuleName(HInstance), '.log');
  AssignFile(LLog, LFileName);
  if FileExists(LFileName) then
    Append(LLog)
  else
    Rewrite(LLog);
  try
    Writeln(LLog, '==================');
    Writeln(LLog, '----- Use generic record --------');
    Writeln(LLog, 'Size: ', SizeOf(LInArgs1^));

    SetLength(LBuf, SizeOf(LInArgs1^) * 2);
    BinToHex(LInArgs1, PChar(LBuf), SizeOf(LInArgs1^));
    LBuf := LBuf.PadRight((Length(LBuf) + 7) and not 7);
    Li := Length(LBuf);
    while Li > 8 do begin
      Dec(Li, 8);
      Insert(' ', LBuf, Li);
    end;
    Writeln(LLog, 'Data: ', LBuf);
    Writeln(LLog, 'Arg1: ', LInArgs1^.Arg1.Val);
    Writeln(LLog, 'Arg2: ', LInArgs1^.Arg2.Val);

    Writeln(LLog, '----- Use simple record --------');
    Writeln(LLog, 'Size: ', SizeOf(LInArgs2^));

    SetLength(LBuf, SizeOf(LInArgs2^) * 2);
    BinToHex(LInArgs2, PChar(LBuf), SizeOf(LInArgs2^));
    LBuf := LBuf.PadRight((Length(LBuf) + 7) and not 7);
    Li := Length(LBuf);
    while Li > 8 do begin
      Dec(Li, 8);
      Insert(' ', LBuf, Li);
    end;
    Writeln(LLog, 'Data: ', LBuf);
    Writeln(LLog, 'Arg1: ', LInArgs2^.Arg1Val);
    Writeln(LLog, 'Arg2: ', LInArgs2^.Arg2Val);
    Writeln(LLog, '==================');
  finally
    CloseFile(LLog);
  end;
end;

С уважением, Vasilisk
22 май 20, 16:42    [22137806]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
rgreat
Member

Откуда:
Сообщений: 5978
Что бы просто Variant не использовать?
22 май 20, 16:47    [22137808]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 11780
rgreat
Что бы просто Variant не использовать?
Структура приходит из внешнего мира
22 май 20, 16:56    [22137817]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
rgreat
Member

Откуда:
Сообщений: 5978
_Vasilisk_,

А что переложить мешает?
22 май 20, 17:01    [22137821]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 11780
rgreat
А что переложить мешает?
Еще раз. TBaseRec, где поля идут подряд, работает именно так, как нужно. Мне не понятно, почему не работает с вложенными записями.

Вопрос не как сделать, а почему не работает
22 май 20, 17:15    [22137826]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
zedxxx
Member

Откуда:
Сообщений: 10
Delphi 10.3.3 работает как ожидается:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  TGenRec<T> = record
    Val: T;
    IsNull: WordBool;
  end;

  TTestMsg = record
    Arg1: TGenRec<Integer>;
    Arg2: TGenRec<Smallint>;
  end;
  PTestMsg = ^TTestMsg;

procedure PrintData(const AData: Pointer);
var
  P: PTestMsg absolute AData;
begin
  Writeln(P.Arg1.Val, ' ', P.Arg1.IsNull);
  Writeln(P.Arg2.Val, ' ', P.Arg2.IsNull);
end;

procedure DoTest;
var
  I: Integer;
  P: Pointer;
  VMsg: TTestMsg;
begin
  I := SizeOf(VMsg);

  FillChar(VMsg, I, $EE);

  VMsg.Arg1.Val := 10;
  VMsg.Arg1.IsNull := False;

  VMsg.Arg2.Val := 20;
  VMsg.Arg2.IsNull := False;

  P := @VMsg;
  PrintData(P);
end;

begin
  try
    DoTest;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.


Картинка с другого сайта.
22 май 20, 17:20    [22137828]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 11780
zedxxx
Delphi 10.3.3 работает как ожидается:
Тест некорректный. Должно быть так
procedure DoTest;
var
  I: Integer;
  P: Pointer;
  VMsg: TBaseMsg;
begin
  I := SizeOf(VMsg);

  FillChar(VMsg, I, $EE);

  VMsg.Arg1Val := 10;
  VMsg.Arg1IsNull := False;

  VMsg.Arg2Val := 20;
  VMsg.Arg2IsNull := False;

  P := @VMsg;
  PrintData(P);
end;
22 май 20, 17:30    [22137833]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
zedxxx
Member

Откуда:
Сообщений: 10
А вот дамп памяти с вашими значениями:

10 00 00 00 00 00 EE EE FF 00 00 00

так что дело, действительно, в выравнивании. В памяти структура теперь представляется как

4 - Integer
2 - WordBool
2 - Word - мусор
2 - SmallInt
2 - WordBool

а с обычной структурой оно выравнивалось вот так:

4 - Integer
2 - WordBool
2 - SmallInt
2 - WordBool
2 - Word - мусор
22 май 20, 17:30    [22137834]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
rgreat
Member

Откуда:
Сообщений: 5978
_Vasilisk_
zedxxx
Delphi 10.3.3 работает как ожидается:
Тест некорректный. Должно быть так
procedure DoTest;
var
  I: Integer;
  P: Pointer;
  VMsg: TBaseMsg;
begin
  I := SizeOf(VMsg);

  FillChar(VMsg, I, $EE);

  VMsg.Arg1Val := 10;
  VMsg.Arg1IsNull := False;

  VMsg.Arg2Val := 20;
  VMsg.Arg2IsNull := False;

  P := @VMsg;
  PrintData(P);
end;

Хотя-бы Packed Record сделай.

Сообщение было отредактировано: 22 май 20, 17:46
22 май 20, 17:46    [22137836]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
X-Cite
Member

Откуда: Минск
Сообщений: 1703
Можно полагаться только на явное выравнивание, которое вы указали. Все что определяется автоматически в целях оптимизации - может в любой момент времени измениться.
22 май 20, 17:49    [22137837]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 11780
rgreat
Хотя-бы Packed Record сделай.
Для кого именно?
zedxxx
а с обычной структурой оно выравнивалось вот так:
Задаю вопрос третий раз. Почему два байта мусора прыгают по структуре?
22 май 20, 18:05    [22137843]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
rgreat
Member

Откуда:
Сообщений: 5978
_Vasilisk_,

https://it.wikireading.ru/34858

Просвещайся.
22 май 20, 18:09    [22137846]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
zedxxx
Member

Откуда:
Сообщений: 10
Почему два байта мусора прыгают по структуре?

Странный вопрос. Потому что вложенная структура тоже выравнивается.

Packed надо объявлять у всех структур, а там где ты предполагаешь, что должен быть мусор, пропиши его руками. Тогда не будет никаких сюрпризов.
22 май 20, 18:24    [22137852]     Ответить | Цитировать Сообщить модератору
 Re: Вопрос по выравниванию  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 50050

_Vasilisk_
Для кого именно?

Ни для кого не надо, совсем всё съедет.

Posted via ActualForum NNTP Server 1.5

22 май 20, 18:25    [22137853]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить