#1337. Invalid obj file. Berlin. 64 бита

Делаем с-файл с функцией в которой есть static переменная.

Делаем obj файл в cpp builder 64 бита.

Делаем pas файл. Подключаем к нему получившийся obj.

Компилируем Delphi 64 бита.

Получаем ошибку линковки bad obj file format.

БЕЗ static - всё хорошо. Но нужен static...

Однако сами Embarcadero как-то же собирают crtl в котором есть static. И оно даже как-то линкуется.

Если переменную сделать глобальной, но не static, то получаем ошибку bad symbol.

Рафинированый пример выделять пока некогда.

Если переменную сделать глобальной и extern и инстанцировать её на стороне pas кода, то всё хорошо. Только pas коду совершенно не нужно такое знание кишков c кода.

А если в функции сделать переменную на стеке типа char [16000] то на стороне Delphi требуется определение функции __chkstk. В msdn можно найти её куцее описание.

#1336. Berlin. Баг

При запущеной IDE Berlin не работает функция OleGetClipboard. В любом приложении на Delphi. Даже не под отладчиком. Выгружаешь IDE всё хорошо. Загружаешь. Опять плохо.

#1335. Ошибка в ImageEn _DIBDrawTo. 64 бита

Было:

procedure _DIBDrawTo(DestCanvas: TCanvas; fhdib: THANDLE; orgx, orgy, orgdx, orgdy, destx, desty, destdx, destdy: integer);
var
  bminfo: ^TBITMAPINFO;
begin
  bminfo := GlobalLock(fhdib);
  SetStretchBltMode(destcanvas.handle, COLORONCOLOR);
  if bminfo^.bmiHeader.biBitCount <= 8 then
    // <=256 colors
    StretchDIBits(destcanvas.Handle, destx, desty, destdx, destdy, orgx, orgy, orgdx, orgdy,
      pointer(Cardinal(bminfo) + sizeof(TBITMAPINFOHEADER) + (1 shl bminfo^.bmiHeader.biBitCount) * 4),
      bminfo^, DIB_RGB_COLORS, SRCCOPY)
  else
    // >256 colors
    StretchDIBits(destcanvas.Handle, destx, desty, destdx, destdy, orgx, orgy, orgdx, orgdy,
      pointer(Cardinal(bminfo) + sizeof(TBITMAPINFOHEADER)),
      bminfo^, DIB_RGB_COLORS, SRCCOPY);
  GlobalUnLock(fhdib);
end; 

Надо:

procedure _DIBDrawTo(DestCanvas: TCanvas; fhdib: THANDLE; orgx, orgy, orgdx, orgdy, destx, desty, destdx, destdy: integer);
var
  bminfo: ^TBITMAPINFO;
begin
  bminfo := GlobalLock(fhdib);
  SetStretchBltMode(destcanvas.handle, COLORONCOLOR);
  if bminfo^.bmiHeader.biBitCount <= 8 then
    // <=256 colors
    StretchDIBits(destcanvas.Handle, destx, desty, destdx, destdy, orgx, orgy, orgdx, orgdy,
      pointer(PAnsiChar(bminfo) + sizeof(TBITMAPINFOHEADER) + (1 shl bminfo^.bmiHeader.biBitCount) * 4),
      bminfo^, DIB_RGB_COLORS, SRCCOPY)
  else
    // >256 colors
    StretchDIBits(destcanvas.Handle, destx, desty, destdx, destdy, orgx, orgy, orgdx, orgdy,
      pointer(PAnsiChar(bminfo) + sizeof(TBITMAPINFOHEADER)),
      bminfo^, DIB_RGB_COLORS, SRCCOPY);
  GlobalUnLock(fhdib);
end; 

Cardinal => PAnsiChar.

Вообще полезно просмотреть все исходники на предмет наличия масок:

Pointer(Cardinal
Pointer(Integer
Pointer(Longint

PChar(Cardinal
PChar(Integer
PChar(Longint

PAnsiChar(Cardinal
PAnsiChar(Integer
PAnsiChar(Longint

#1334. Ярослав Бровин про FreeAndNil и компанию

http://yaroslavbrovin.ru/object_life_cycle_in_delphi_part_1_windows_osx-ru/

"

Использование FreeAndNil

Этот способ является решением проблемы повторного удаления объекта с мусорным указателем. Забегая вперед, сразу хочу сказать, что я настоятельно рекомендую использовать только этот способ удаления объектов, поскольку он поможет вам обнаружить ошибку сразу же на месте."


Ну НАКОНЕЦ-то ЭТО было СКАЗАНО. После стольких лет перемывания из пустого в порожнее.

Коротко. "Нелюбителям" FreeAndNil
У меня проблема в ДНК? Может быть кто-нибудь объяснит мне "что хотел сказать автор"?
Почему всегда нужно использовать FreeAndNil вместо Free

#1333. Функция-помощник для стрессового тестирования длинных 64-битных адресов на предмет совместимости с Integer

Функция-помощник для тестирования длинных 64-битных адресов на предмет совместимости с Integer. Творческая переработка идей gunsmoker'а и Николая Зверева.

По мотивам:
http://programmingmindstream.blogspot.ru/2016/12/1330-win64.html
http://www.delphinotes.ru/2016/10/win64-2.html

unit l3DebugUtils;

interface

procedure l3ReserveMem;

implementation

uses
 Windows
 ;

procedure l3ReserveMem;
{$IfDef Win64}
var
 l_P : Pointer;
begin
 while true do
 begin
  l_P := VirtualAlloc(nil, 1024 * 1024, MEM_RESERVE, PAGE_NOACCESS);
  // - распределяем по мегабайту, пока не выберем "младшее" адресное пространство (меньше 4Гб).
  if (l_P = nil) then
   break;
  if (NativeUInt(l_P) >= High(Cardinal{Integer})) then
   break;
 end;//while true
end;
{$Else  Some64}
begin
end;
{$EndIf Some64}

end.

Втыкаем вызов l3ReserveMem первой строчкой в dpr и получаем, что все далее распределённые адреса будут больше $FFFFFFFF.

Далее протыкиваем наше приложение или запускаем автоматические тесты. И ловим Range Check'и и AV. Там где Pointer приводится к Integer и Cardinal и наоборот. В прямую сторону Range Check в обратную - скорее всего AV.

Я много чего наловил. И в чужом коде - тоже. В частности в ImageEn. Например в функции _DIBDrawTo. Но об этом в другой раз.

Этот код можно и в релизе оставить. И тренироваться "на пользователях".

---

У меня вызов функции в тестах вот так вставлен:

begin
 {$IfDef nsTest}
 g_CVSPath := 'w:\common\components\DailyTest';
 {$EndIf nsTest}
 //#UC START# *4B2A48AA03D4CVSPath*
 l3ReserveMem;
 //#UC END# *4B2A48AA03D4CVSPath*
 TAutoTestsSuite.Register;
 try
  if KTestRunner.NeedKTestRunner([TtoK, TItsLAW, TArchi2, TtoK64, TtoKT]) then
   KTestRunner.RunRegisteredTests
  else
  if System.IsConsole then
   TextTestRunner.RunRegisteredTests
  else
   GUITestRunner.RunRegisteredTests;
 except
  on E: Exception do
  begin
   {$If defined(MTDORB) AND defined(NoKPageTool)}
   if TKBridge.Exists then
    TKBridge.Instance.Logout;
   {$IfEnd}
   l3System.Exception2Log(E);
   TestsExitCode := 2;
  end;//Exception
 end;//try..except
{$IfNDef Some64}
 if (TestsExitCode <> 0) then
  Halt(TestsExitCode);
{$EndIf  Some64}
end.

#1332. Старый баг. Ещё Delphi 7

http://www.delphikingdom.com/asp/talktopic.asp?ID=302

Попробуйте скомпилировать данный код со включенной опцией Include TD32 debug info.

program buildL3;

const
  w_WildSet = [WideChar('?')];

begin
end.

- получаем Internal Error DBG1477.

Просто только сегодня с коллегой вспоминали.

Ну и он в тему к предыдущему - http://programmingmindstream.blogspot.ru/2017/01/1331-64.html.

#1331. Забавный баг 64-битного компилятора

const
 csRusSmallI = AnsiChar('и');
 csRusBigI = AnsiChar('И');
 csSetRusI = [csRusSmallI, csRusBigI];
begin
 Assert(#0 in csSetRusI);
 //- проверка проходит, что НЕ правильно
end.

const
 csRusSmallI = AnsiChar('и');
 csRusBigI = AnsiChar('И');
 csSetRusI : set of AnsiChar = [csRusSmallI, csRusBigI];
begin
 Assert(#0 in csSetRusI);
 //- проверка НЕ проходит, что ПРАВИЛЬНО
end.

Delphi XE4

"Понятное дело", что есть CharInSet и CharInArray, но при портировании старого кода - малость раздражает.

Да. В 32-х битах - это не повторяется. На всякий случай повторил.

И "на самом деле" в первом примере значение csSetRusI равно ['и', 'И', #0, #2, #3]. Т.е. там какой-то "мусор". Завтра погляжу как это выглядит в ассемблере.