Ответ на задачку №6

Ответ на задачку №6.

Напомню код в вопросе:

procedure Test(const BitmapHandle: HBITMAP; Value: Boolean);
var
  BitmapInfo: Windows.TBitmap;
begin
  if not Value then
    Exit;
  FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
  if Windows.GetObject(BitmapHandle, SizeOf(BitmapInfo), @BitmapInfo) = 0 then
    ShowMessage('FAIL');
  // ...
end;

Как было сказано, этот код иногда может работать, а иногда - нет. Нужно было объяснить что, когда и почему.

Ответ заключается в ошибке в заголовочниках Delphi (модуле Windows.pas). Если вы посмотрите на определение записи TBitmap в wingdi.h, то увидите такое определение:

typedef struct tagBITMAP
  {
    LONG        bmType;
    LONG        bmWidth;
    LONG        bmHeight;
    LONG        bmWidthBytes;
    WORD        bmPlanes;
    WORD        bmBitsPixel;
    LPVOID      bmBits;
  } BITMAP, *PBITMAP, NEAR *NPBITMAP, FAR *LPBITMAP;

В то же время в Windows.pas эта запись объявлена так:

{$ALIGN ON}
{$MINENUMSIZE 4}

...

  PBitmap = ^TBitmap;
  {$EXTERNALSYM tagBITMAP}
  tagBITMAP = packed record
    bmType: Longint;
    bmWidth: Longint;
    bmHeight: Longint;
    bmWidthBytes: Longint;
    bmPlanes: Word;
    bmBitsPixel: Word;
    bmBits: Pointer;
  end;
  TBitmap = tagBITMAP;
  {$EXTERNALSYM BITMAP}
  BITMAP = tagBITMAP;

Видите ошибку?

Дело в том, что в стандартных заголовочниках Windows применяется выравнивание записей по-умолчанию для языка C++ - это 8 байт. В Windows.pas применяется такое же выравнивание - {$ALIGN ON} (оно же - {$A+}, оно же - {$A8}, оно же - выравнивание по умолчанию в Delphi).

Казалось бы, всё корректно.

Однако запись TBitmap объявлена с ключевым словом packed. Это значит, что её выравнивание - 1 байт.

Итак, проблема оказывается в том, что запись BitmapInfo оказывается неверно выровненной в стеке. Иными словами, это - баг Delphi: неверное объявление записи в заголовочнике.

Теперь можно ответить и на вопрос задачки: когда этот код не будет работать?

Вообще-то, позвольте мне перефразировать вопрос в обратную сторону: при каких условиях этот код будет работать? Тогда все прочие случаи - это когда код не будет работать.

• Код будет работать при включенной оптимизации. Оптимизация заставляет компилятор выравнивать запись на стеке, даже хотя она явно помечена как packed.
• Код будет работать, когда размер всех локальных переменных до указанной структуры кратен двум. Постойте-ка, но у нас нет никаких других локальных переменных? Ну, вообще-то есть. Это Value. Это логическая переменная размером в 1 байт. Она располагается в стеке до BitmapInfo, приводя к тому, что запись оказывается на нечётной границе.
• Код будет работать в 64-х разрядных системах (имеется ввиду 32-х разрядное приложение через WOW64). Я не исследовал подробно этот вопрос, но, видимо, что-то там меняется.

Суммируя: код будет работать почти всегда. Очень хороший пример на тему "если что-то работает - это ещё не значит, что это правильно". Ошибка эта особенно коварна тем, что для функции GetObject нет никакого способа получить причину неудачи - эта функция не устанавливает код LastError.

Ладно. Тогда как это можно исправить?

Что вы можете сделать, но это будет неправильно:

• Включить оптимизацию
• Изменить Boolean на LongBool

А вот что можно сделать правильно:

• Исправить объявление записи, убрав слово packed. Конечно, вы не можете исправить Windows.pas, но вы можете скопировать объявление записи к себе:

  {$A+}
  
  type
    PBitmap = ^TBitmap;
    tagBITMAP = record // <- нет packed
      bmType: Longint;
      bmWidth: Longint;
      bmHeight: Longint;
      bmWidthBytes: Longint;
      bmPlanes: Word;
      bmBitsPixel: Word;
      bmBits: Pointer;
    end;
    TBitmap = tagBITMAP;
    BITMAP = tagBITMAP;
  
  // Теперь этот код работает всегда
  procedure Test(const BitmapHandle: HBITMAP; Value: Boolean);
  var
    BitmapInfo: TBitmap;
  begin
    if not Value then
      Exit;
    FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
    if Windows.GetObject(BitmapHandle, SizeOf(BitmapInfo), @BitmapInfo) = 0 then
      ShowMessage('FAIL');
  end;

• Выделять запись в куче, а не на стеке. Менеджер памяти гарантирует выделение с минимум 8-ми байтным выравниванием, поэтому:

  // Работает всегда - даже с packed-объявлением
  procedure Test(const BitmapHandle: HBITMAP; Value: Boolean);
  var
    BitmapInfo: PBitmap;
  begin
    if not Value then
      Exit;
    BitmapInfo := AllocMem(SizeOf(BitmapInfo^));
    try
      if Windows.GetObject(BitmapHandle, SizeOf(BitmapInfo^), BitmapInfo) = 0 then
        ShowMessage('FAIL');
    finally
      FreeMem(BitmapInfo);
    end;
  end;

Следует сказать, что блоки памяти, выделяемые всеми менеджерами памяти Delphi в Windows гарантируются иметь выравнивание в 8 байт и округление размера вверх на 4-х байтовую границу (минимум). Причём в некоторых версиях Delphi (т.е. новых) вы можете переключить менеджер памяти на выравнивание по 16-ти байтовой границе с помощью вызова функции SetMinimumBlockAlignment. Сторонние менеджеры памяти хотя формально обязаны следовать этому же соглашению, но я бы относился к этому скептически - ведь его достаточно легко упустить, поэтому какой-нибудь "home-made" менеджер памяти вполне может возвращать невыровненные блоки памяти.

---

Оффтопик на тему

Ещё один пример, когда выравнивание очень важно - получение контекста потока. Делается это с помощью функции GetThreadContext. Проблема в том, что это очень низкоуровневая функция и она требует особого выравнивания для своего аргумента. Причём выравнивание это зависит от текущего (целевого) процессора. К примеру, для x86-32 это 16 байт. Если запись не будет иметь нужного выравнивания, то вы получите ERROR_NOACCESS (998) - "Неверная попытка доступа к адресу памяти" ("Invalid access to memory location"). Понятно, что вы никак не сможете объявить структуру TContext в Delphi так, чтобы она имела бы корректное выравнивание - поэтому TContext нельзя размещать в стеке. Её размещение может быть только динамическим с выравниванием.

На новых Delphi вы могли бы использовать функцию SetMinimumBlockAlignment, чтобы правильно разместить запись TContext. Но что если эта функция недоступна?

Возможно, что простейший способ решить все эти проблемы с выравниванием - использовать напрямую VirtualAlloc. Она выделяет память с выравниванием на границу страницы памяти. Что для x86-32 составляет 4 Кб - более чем достаточно для любых целей. С другой стороны, это далеко не самый оптимальный способ.

Вот процедура, которую вы можете использовать (примечание: я написал её на скорую руку, в ней могут быть ошибки - проверьте):

function AllocMemAlign(const ASize, AAlign: Cardinal; out AHolder: Pointer): Pointer;
var
  Size: Cardinal;
  Shift: NativeUInt;
begin
  if AAlign <= 1 then
  begin
    AHolder := AllocMem(ASize);
    Result := AHolder;
    Exit;
  end;

  if ASize = 0 then
  begin
    AHolder := nil;
    Result := nil;
    Exit;
  end;

  Size := ASize + AAlign - 1;

  AHolder := AllocMem(Size);

  Shift := NativeUInt(AHolder) mod AAlign;
  if Shift = 0 then
    Result := AHolder
  else
    Result := Pointer(NativeUInt(AHolder) + (AAlign - Shift));
end;

Тогда взятие контекста потока выглядело бы так:

var
  Context: PContext;
  Storage: Pointer;
begin
  Context := AllocMemAlign(SizeOf(TContext), 16, Storage);
  try
    Context^.ContextFlags := CONTEXT_FULL;
    if not GetThreadContext(Handle, Context^) then
      RaiseLastOSError;
    // Работа с Context^
  finally
    FreeMem(Storage);
  end;
end;

См. также - ещё примеры важности выравнивания данных:

• Важность выравнивания даже на x86.
• Важность выравнивания даже на x86, часть 2.
• Почему структуру TFileTime нельзя рассматривать как Int64?
• Почему некоторые записи оканчиваются массивом размером 1?

Мораль истории: не забывайте про выравнивание ваших данных!

P.S. Кстати, в Delphi есть и директива для выравнивания кода - {$CODEALIGN} (и её аналог .ALIGN в ассемблерном коде). Значение по умолчанию для Windows - 4.