8 марта 2011 г.

Ответ на задачку №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;

См. также - ещё примеры важности выравнивания данных: Мораль истории: не забывайте про выравнивание ваших данных!

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

1 комментарий :

Можно использовать некоторые HTML-теги, например:

<b>Жирный</b>
<i>Курсив</i>
<a href="http://www.example.com/">Ссылка</a>

Вам необязательно регистрироваться для комментирования - для этого просто выберите из списка "Анонимный" (для анонимного комментария) или "Имя/URL" (для указания вашего имени и (опционально) ссылки на сайт). Все прочие варианты потребуют от вас входа в вашу учётку (поддерживается OpenID).

Пожалуйста, по возможности используйте "Имя/URL" вместо "Анонимный". URL можно просто не указывать.

Ваше сообщение может быть помечено как спам спам-фильтром - не волнуйтесь, оно появится после проверки администратором.