NightFlight 30 мар 2017 в 14:30

Использование code blocks из Objective-C в Delphi на macOS: как мы навели мосты

15 мин

4.5K

Delphi*Objective C*Разработка под macOS*

Многие, наверное, слышали о замечательном способе решения программистских задач под названием метод утенка (rubber duck debugging). Суть метода в том, что надо сесть в ванную, расслабиться, посадить на воду игрушечного утенка, и объяснить ему суть той проблемы, решение которой вы не можете найти. И, чудесным образом, после такой беседы решение находится.

В своей прошлой статье на Хабре, где я рассказывал о разработке программы для инспектирования Wi-Fi сетей для macOS, в роли утенка оказался сам Хабр: я пожаловался на то, что нам никак не удается придумать способ реализации code blocks из Objective-C в Delphi. И это помогло! Пришло просветление, и всё получилось. О ходе мыслей и о конечном результате я и хочу рассказать.

Итак, для тех кто не читал прошлую статью, еще раз кратко излагаю суть проблемы. Code blocks — это языковая фича С++ и Objective-C, которая не поддерживается в Delphi. Точнее, Delphi имеет свой аналог code blocks, но он несовместим с теми code blocks, которые ожидает от наc macOS API. Дело в том, что многие классы имеют функции, в которых используются code blocks в качестве handler'ов завершения. Самый простой пример — beginWithCompletionHandler классов NSSavePanel и NSOpenPanel. Передаваемый сode block выполняется в момент закрытия диалога:

- (IBAction)openExistingDocument:(id)sender {
   NSOpenPanel* panel = [NSOpenPanel openPanel];

   // This method displays the panel and returns immediately.
   // The completion handler is called when the user selects an
   // item or cancels the panel.
   [panel beginWithCompletionHandler:^(NSInteger result){
      if (result == NSFileHandlingPanelOKButton) {
         NSURL*  theDoc = [[panel URLs] objectAtIndex:0];

         // Open  the document.
      }

   }];
}

Побеседовав с утенком, я осознал, что не с того конца подходил к решению проблемы. Наверняка эта проблема существует не только в Delphi. Следовательно, надо начать с того, как решается проблема в других языках. Google в руки и мы находим очень близкий к нашей теме код для Python и JavaScript тут и тут. Хороший старт: если им это удалось, то удастся и нам. По сути, нам нужно всего лишь создать структуру в правильном формате, заполнить поля, и указатель на такую структуру и будет тем самым магическим указателем, который мы сможем передавать в те методы классов macOS, которые ожидают от нас блоков. Еще немного гугления, и мы находим хедер на сайте Apple:

struct Block_descriptor {
    unsigned long int reserved;
    unsigned long int size;
    void (*copy)(void *dst, void *src);
    void (*dispose)(void *);
};

struct Block_layout {
    void *isa;
    int flags;
    int reserved; 
    void (*invoke)(void *, ...);
    struct Block_descriptor *descriptor;
    // imported variables
};

Излагаем это на Паскале:

  Block_Descriptor = packed record
    Reserved: NativeUint;
    Size: NativeUint;
    copy_helper: pointer;
    dispose_helper: pointer;
  end;
  PBlock_Descriptor = ^Block_Descriptor;

  Block_Literal = packed record
    Isa: pointer;
    Flags: integer;
    Reserved: integer;
    Invoke: pointer;
    Descriptor: PBlock_Descriptor;
  end;
  PBlock_Literal = ^Block_Literal;

Теперь, почитав еще немного о блоках (How blocks are implemented и на Хабре, Objective-C: как работают блоки), перейдем к созданию блока, пока в самом простом варианте, на коленке:

Var
  OurBlock: Block_Literal;
function CreateBlock: pointer;
var
  aDesc:  PBlock_Descriptor;
begin
  FillChar(OurBlock, SizeOf(Block_Literal), 0);
  // Isa – первое поле нашего блока-объекта, и мы пишем в него
  // указатель на класс объекта, "NSBlock".
  OurBlock.Isa    := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
  // Указатель на наш коллбек. Это обычная функция cdecl, обявленная в нашем коде.
  OurBlock.Invoke := @InvokeCallback;
  // Аллоцируем память для Block_Descriptor
  New(aDesc);
  aDesc.Reserved       := 0;
  // прописываем размер
  aDesc.Size           := SizeOf(Block_Literal);
  OurBlock.Descriptor := aDesc;

  result:= @OurBlock;
end;

Поле flags мы пока оставляем нулевым, для простоты. Позже оно нам пригодится. Нам осталось задекларировать пока пустую функцию коллбека. Первым аргументом в коллбеке будет указатель на экземпляр класса NSBlock, а список остальных параметров зависит от конкретного метода Cocoa-класса, который будет вызывать code block. В примере выше, с NSSavePanel, это процедура с одним аргументом типа NSInteger. Так и запишем для начала:

procedure InvokeCallback (aNSBlock: pointer; i1: NSInteger); cdecl;
begin
  Sleep(0);
end;

Ответственный момент, удар по воротам:

    FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
    NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
    objc_msgSendP2(
                   (FSaveFile as ILocalObject).GetObjectID,
                   sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
                   (NSWin as ILocalObject).GetObjectID,
                   CreateBlock
                   );

Открывается диалог сохранения файла, мы жмем ОК или Cancel и … да! Мы попадем на break point, который поставили на Sleep(0), и да, в аргументе i1 будет либо 0, либо 1, в зависимости от того, какую кнопку в диалоге мы нажали. Победа! Мы с утенком счастливы, но впереди много работы:

Количество и тип аргументов коллбека могут быть разными. Есть определенные наиболее популярные наборы, но требуется гибкость.
У нас может быть в работе много код-блоков одновременно. Например, мы можем скачивать файл с вызовом completion handler по завершении и, параллельно, открывать и закрывать диалог сохранения файла. Сначала сработает код-блок, который мы создали вторым, а когда докачается файл, сработает первый код-блок. Хорошо бы вести учет.
Нам нужно как-то идентифицировать тот блок, который вызвал коллбек, и вызывать соответствующий этому блоку код Delphi.
Было бы здорово сделать мостик между анонимными методами в Delphi и код-блоками, без этого теряется всё удобство и красота. Хочется, чтобы вызов выглядел примерно так:

SomeNSClassInstance.SomeMethodWithCallback (
                Arg1,
                Arg2, 
                   TObjCBlock.CreateBlockWithProcedure(
                          procedure (p1: NSInteger)
                          begin
                            if p1 = 0
                              then ShowMessage ('Cancel')
                              else ShowMessage ('OK');
                           end)
                   );

Начнем с вида коллбеков. Очевидно, что самый простой и самый надежный способ – иметь под каждый тип функции свой коллбек:

procedure InvokeCallback1 (aNSBlock: pointer; p1: pointer); cdecl;
procedure InvokeCallback2 (aNSBlock: pointer; p1, p2: pointer); cdecl;
procedure InvokeCallback3 (aNSBlock: pointer; p1, p2, p3: pointer); cdecl;

И так далее. Но как-то это нудно и неэлегантно, правда? Поэтому мысль ведет нас дальше. Что, если объявить только один вид коллбека, проидентифицировать блок, который вызвал коллбек, узнать число аргументов и поползти по стеку, читая нужное количество аргументов?

procedure InvokeCallback (aNSBlock: pointer); cdecl;
var
  i, ArgNum: integer;
  p: PByte;
  Args: array of pointer;
begin
  i:= FindMatchingBlock(aNSBlock);
  if i >= 0 then
  begin
    p:= @aNSBlock;
    Inc(p, Sizeof(pointer));   // Прыгаем в начало списка аргументов
    ArgNum:= GetArgNum(...);
    if ArgNum > 0 then
    begin
      SetLength(Args, ArgNum);
      Move(p^, Args[0], SizeOf(pointer) * ArgNum);
    end;
  ...
end;

Хорошая мысль? Нет, плохая. Это будет работать в 32-битном коде, но грохнется к чертовой матери в 64-битном, потому что никакого cdecl в 64-битном коде не бывает, а есть одна общая calling convention, которая, в отличие от cdecl, аргументы передает не в стэке, а в регистрах процессора. Ну что же, тогда поступим еще проще, объявим коллбек так:

function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;

И просто будем читать столько аргументов, сколько нам нужно. В оставшихся аргументах будет мусор, но мы к ним и не будем обращаться. И заодно мы сменили procedure на function, на случай, если code block требует результата. Disclaimer: если вы не уверены в безопасности такого подхода, используйте отдельные коллбеки под каждый тип функции. Мне подход кажется довольно безопасным, но, как говорится, tastes differ.

Что касается идентификации блока, то тут всё оказалось довольно просто: aNSBlock, который приходит к нам, как первый аргумент в коллбеке, указывает ровно на тот же Descriptor, который мы аллоцировали при создании блока.

Теперь можно заняться анонимными методами разных типов, мы покроем процентов 90 из возможных наборов аргументов, которые встречаются на практике в классах macOS и мы всегда можем расширить список:

type

  TProc1 = TProc;
  TProc2 = TProc<pointer>;
  TProc3 = TProc<pointer, pointer>;
  TProc4 = TProc<pointer, pointer, pointer>;
  TProc5 = TProc<pointer, pointer, pointer, pointer>;
  TProc6 = TProc<NSInteger>;
  TProc7 = TFunc<NSRect, boolean>;

  TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);

  TObjCBlock = record
   private
     class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
   public
     class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
  end;

Таким образом, создание блока с процедурой, которая, например, имеет два аргумента размером SizeOf(pointer), будет выглядеть так:

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
end;

CreateBlockWithCFunc выглядит так:

class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
begin
  result:= BlockObj.AddNewBlock(aTProc, aType);
end;

То есть. мы обращается к BlockObj, singleton-экземпляру класса TObjCBlockList, который нужен для управления всем этим хозяйством и недоступен снаружи юнита:

  TBlockInfo = packed record
     BlockStructure: Block_Literal;
     LocProc: TProc;
     ProcType: TProcType;
  end;
  PBlockInfo = ^TBlockInfo;

  TObjCBlockList = class (TObject)
  private
    FBlockList: TArray<TBlockInfo>;
    procedure ClearAllBlocks;
  public
    constructor Create;
    destructor Destroy; override;
    function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
    function FindMatchingBlock(const aCurrBlock: pointer): integer;
    procedure ClearBlock(const idx: integer);
    property BlockList: TArray<TBlockInfo> read FBlockList ;
  end;

var
  BlockObj: TObjCBlockList;

"Сердце" нашего класса бьется тут:

function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
var
  aDesc:  PBlock_Descriptor;
const
  BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
begin
  // Добавляем в наш массив блоков новый элемент и обнуляем его
  SetLength(FBlockList, Length(FBlockList) + 1);
  FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);
  // Это я уже объяснял выше
  FBlockList[High(FBlockList)].BlockStructure.Isa    := NSClassFromString ((StrToNSStr('NSBlock') 
                                      as ILocalobject).GetObjectID);
  FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
  // Сообщаем системе, что наш блок будет иметь два доп. хелпера,
  // для copy и displose. Зачем? Об этом ниже.
  FBlockList[High(FBlockList)].BlockStructure.Flags  := BLOCK_HAS_COPY_DISPOSE;
  // Сохраним тип нашего анонимного метода и ссылку на него:
  FBlockList[High(FBlockList)].ProcType              := aType;
  FBlockList[High(FBlockList)].LocProc               := aTProc;

  New(aDesc);
  aDesc.Reserved       := 0;
  aDesc.Size           := SizeOf(Block_Literal);
  // Укажем адреса хелпер-функций:
  aDesc.copy_helper    := @CopyCallback;
  aDesc.dispose_helper := @DisposeCallback;
  FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;

  result:= @FBlockList[High(FBlockList)].BlockStructure;
end;

Ну вот, всё основное мы написали. Остается всего несколько тонких моментов.

Во-первых, нам нужно добавить thread safety, чтобы с экземпляром класса можно было работать из разных нитей. Это довольно просто, и мы добавили соответствующий код.

Во-вторых, нам надо бы узнать, а когда же можно наконец "прибить" созданную нами структуру, т.е. элемент массива FBlockList. На первый взгляд кажется, что как только система вызвала коллбек, блок можно удалять: загрузился файл, был вызван completion handler – всё, дело сделано. На самом деле, это не всегда так. Есть блоки, которые вызываются сколько угодно раз; например, в методе imageWithSize:flipped:drawingHandler: класса NSImage нужно передать указатель на блок, который будет отрисовывать картинку, что, как вы понимаете, может происходить хоть миллион раз. Вот тут-то нам и пригодится aDesc.dispose_helper := @DisposeCallback. Вызов процедуры DisposeCallback как раз и будет сигнализировать о том, что блок больше не нужен и его можно смело удалять.

Вишенка на торте

А давайте еще self-test напишем, прямо в том же юните? Вдруг что-то сломается в следующей версии компилятора или при переходе на 64 бита. Как можно протестировать блоки, не обращаясь к Cocoa-классам? Оказывается, для этого есть специальные низкоуровневые функции, которые нам надо для начала задекларировать в Delphi так:

  function imp_implementationWithBlock(block: id): pointer; cdecl;
                    external libobjc name _PU + 'imp_implementationWithBlock';
  function imp_removeBlock(anImp: pointer): integer; cdecl;
                    external libobjc name _PU + 'imp_removeBlock';

Первая функция возвращает указатель на C-функцию, которая вызывает блок, который мы передали как аргумент. Вторая просто "подчищает" потом память. Отлично, значит нам нужно создать блок с помощью нашего прекрасного класса, передать его в imp_implementationWithBlock, вызвать функцию по полученному адресу и с замиранием сердца посмотреть, как отработал блок. Пробуем всё это исполнить. Вариант первый, наивный:

class procedure TObjCBlock.SelfTest;
var
  p: pointer;
  test: NativeUint;
  func : procedure ( p1, p2, p3, p4: pointer); cdecl;
begin
  test:= 0;
  p:= TObjCBlock.CreateBlockWithProcedure(
                          procedure (p1, p2, p3, p4: pointer)
                          begin
                            test:= NativeUint(p1) + NativeUint(p2) +
                                   NativeUint(p3) + NativeUint(p4);
                          end);
  @func := imp_implementationWithBlock(p);
  func(pointer(1), pointer(2),  pointer(3),  pointer(4));
  imp_removeBlock(@func);
  if test <> (1 + 2 + 3 + 4)
    then raise Exception.Create('Objective-C code block self-test failed!');
end;

Запускаем и… упс. Попадаем в анонимный метод: p1=1, p2=3, p3=4, p4=мусор. What the …? Кто съел двойку? И почему в последнем параметре мусор? Оказывается, дело в том, что imp_implementationWithBlock возвращает trampoline, который позволяет вызывать блок как IMP. Проблема в том, что IMP в Objective-C всегда имеет два обязательных первых аргумента, (id self, SEL _cmd), т.е. указатели на объект и на селектор, а код-блок имеет лишь один обязательный аргумент в начале. Возвращаемый trampoline при вызове редактирует список аргументов: второй аргумент, _cmd, выкидывается за ненужностью, на его место пишется первый аргумент, а вот на место первого аргумента подставляется указатель на NSBlock.

Да, вот так, trampoline подкрался незаметно. Ладно, вариант второй, правильный:

class procedure TObjCBlock.SelfTest;
var
  p: pointer;
  test: NativeUint;
  func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
begin
  test:= 0;
  p:= TObjCBlock.CreateBlockWithProcedure(
                          procedure (p1, p2, p3, p4: pointer)
                          begin
                            test:= NativeUint(p1) + NativeUint(p2) +
                                   NativeUint(p3) + NativeUint(p4);
                          end);
  @func := imp_implementationWithBlock(p);
  // Да, _cmd будет проигнорирован!
  func(pointer(1), nil, pointer(2),  pointer(3),  pointer(4));
  imp_removeBlock(@func);
  if test <> (1 + 2 + 3 + 4)
    then raise Exception.Create('Objective-C code block self-test failed!');
end;

Вот теперь всё проходит гладко и можно наслаждаться работой с блоками. Целиком юнит можно скачать тут или посмотреть ниже. Комментарии ("ламеры, у вас тут течет память") и предложения по улучшению приветствуются.

Полный сорс-код

{*******************************************************}
{                                                       }
{     Implementation of Objective-C Code Blocks         }
{                                                       }
{       Copyright(c) 2017 TamoSoft Limited              }
{                                                       }
{*******************************************************}

{
LICENSE:

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

You may not use the Software in any projects published under viral licenses,
including, but not limited to, GNU GPL.

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE
}
//USAGE EXAMPLE
//
//    FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
//    NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
//    objc_msgSendP2(
//                   (FSaveFile as ILocalObject).GetObjectID,
//                   sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
//                   (NSWin as ILocalObject).GetObjectID,
//                   TObjCBlock.CreateBlockWithProcedure(
//                          procedure (p1: NSInteger)
//                          begin
//                            if p1 = 0
//                              then ShowMessage ('Cancel')
//                              else ShowMessage ('OK');
//                           end)
//                          );

unit Mac.CodeBlocks;

interface

uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers,
     Macapi.ObjCRuntime, Macapi.CocoaTypes;

type

  TProc1 = TProc;
  TProc2 = TProc<pointer>;
  TProc3 = TProc<pointer, pointer>;
  TProc4 = TProc<pointer, pointer, pointer>;
  TProc5 = TProc<pointer, pointer, pointer, pointer>;
  TProc6 = TProc<NSInteger>;
  TProc7 = TFunc<NSRect, boolean>;

  TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);

  TObjCBlock = record
   private
     class procedure SelfTest; static;
     class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
   public
     class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
     class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
  end;

implementation

  function imp_implementationWithBlock(block: id): pointer; cdecl;
                    external libobjc name _PU + 'imp_implementationWithBlock';
  function imp_removeBlock(anImp: pointer): integer; cdecl;
                    external libobjc name _PU + 'imp_removeBlock';

type

  Block_Descriptor = packed record
    Reserved: NativeUint;
    Size: NativeUint;
    copy_helper: pointer;
    dispose_helper: pointer;
  end;
  PBlock_Descriptor = ^Block_Descriptor;

  Block_Literal = packed record
    Isa: pointer;
    Flags: integer;
    Reserved: integer;
    Invoke: pointer;
    Descriptor: PBlock_Descriptor;
  end;
  PBlock_Literal = ^Block_Literal;

  TBlockInfo = packed record
     BlockStructure: Block_Literal;
     LocProc: TProc;
     ProcType: TProcType;
  end;
  PBlockInfo = ^TBlockInfo;

  TObjCBlockList = class (TObject)
  private
    FBlockList: TArray<TBlockInfo>;
    procedure ClearAllBlocks;
  public
    constructor Create;
    destructor Destroy; override;
    function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
    function FindMatchingBlock(const aCurrBlock: pointer): integer;
    procedure ClearBlock(const idx: integer);
    property BlockList: TArray<TBlockInfo> read FBlockList ;
  end;

var
  BlockObj: TObjCBlockList;

function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;
var
  i: integer;
  aRect: NSRect;
begin
  result:= nil;
  if Assigned(BlockObj) then
  begin
    TMonitor.Enter(BlockObj);
    try
      i:= BlockObj.FindMatchingBlock(aNSBlock);
      if i >= 0 then
      begin
        case  BlockObj.BlockList[i].ProcType of
          TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)();
          TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1);
          TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2);
          TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3);
          TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4);
          TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1));
          TProcType.pt7:
          begin
            aRect.origin.x   := CGFloat(p1);
            aRect.origin.y   := CGFloat(p2);
            aRect.size.width := CGFloat(p3);
            aRect.size.height:= CGFloat(p4);
            result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect));
          end;
        end;
      end;
    finally
      TMonitor.Exit(BlockObj);
    end;
  end;
end;

procedure DisposeCallback(aNSBlock: pointer) cdecl;
var
  i: integer;
begin
  if Assigned(BlockObj) then
  begin
    TMonitor.Enter(BlockObj);
    try
      i:= BlockObj.FindMatchingBlock(aNSBlock);
      if i >= 0
        then BlockObj.ClearBlock(i);
    finally
      TMonitor.Exit(BlockObj);
    end;
  end;
  TNSObject.Wrap(aNSBlock).release;
end;

procedure CopyCallback(scr, dst: pointer) cdecl;
begin
 //
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer;
begin
  result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7);
end;

class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
begin
  result:= nil;
  if Assigned(BlockObj) then
  begin
    TMonitor.Enter(BlockObj);
    try
      result:= BlockObj.AddNewBlock(aTProc, aType);
    finally
      TMonitor.Exit(BlockObj);
    end;
  end;
end;

class procedure TObjCBlock.SelfTest;
var
  p: pointer;
  test: NativeUint;
  // Yes, _cmd is ignored!
  func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
begin
  test:= 0;
  p:= TObjCBlock.CreateBlockWithProcedure(
                          procedure (p1, p2, p3, p4: pointer)
                          begin
                            test:= NativeUint(p1) + NativeUint(p2) +
                                   NativeUint(p3) + NativeUint(p4);
                          end);
  @func := imp_implementationWithBlock(p);
  // Yes, _cmd is ignored!
  func(pointer(1), nil, pointer(2),  pointer(3),  pointer(4));
  imp_removeBlock(@func);
  if test <> (1 + 2 + 3 + 4)
    then raise Exception.Create('Objective-C code block self-test failed!');
end;

{TObjCBlockList}

constructor TObjCBlockList.Create;
begin
  inherited;
end;

destructor TObjCBlockList.Destroy;
begin
  TMonitor.Enter(Self);
  try
    ClearAllBlocks;
  finally
    TMonitor.Exit(Self);
  end;
  inherited Destroy;
end;

procedure TObjCBlockList.ClearBlock(const idx: integer);
begin
  Dispose(FBlockList[idx].BlockStructure.Descriptor);
  FBlockList[idx].BlockStructure.isa:= nil;
  FBlockList[idx].LocProc:= nil;
  Delete(FBlockList, idx, 1);
end;

function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
var
  aDesc:  PBlock_Descriptor;
const
  BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
begin
  SetLength(FBlockList, Length(FBlockList) + 1);
  FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);

  FBlockList[High(FBlockList)].BlockStructure.Isa    := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
  FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
  FBlockList[High(FBlockList)].BlockStructure.Flags  := BLOCK_HAS_COPY_DISPOSE;
  FBlockList[High(FBlockList)].ProcType              := aType;
  FBlockList[High(FBlockList)].LocProc               := aTProc;

  New(aDesc);
  aDesc.Reserved       := 0;
  aDesc.Size           := SizeOf(Block_Literal);
  aDesc.copy_helper    := @CopyCallback;
  aDesc.dispose_helper := @DisposeCallback;
  FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;

  result:= @FBlockList[High(FBlockList)].BlockStructure;
end;

procedure TObjCBlockList.ClearAllBlocks();
var
  i: integer;
begin
  for i := High(FBlockList) downto Low(FBlockList) do
     ClearBlock(i);
end;

function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer;
var
  i: integer;
begin
  result:= -1;
  if aCurrBlock <> nil then
  begin
    for i:= Low(FBlockList) to High(FBlockList) do
    begin
      if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor
        then Exit(i);
    end;
  end;
end;

initialization
  BlockObj:=TObjCBlockList.Create;
  TObjCBlock.SelfTest;

finalization
  FreeAndNil(BlockObj);

end.

Теги:

Хабы:

Использование code blocks из Objective-C в Delphi на macOS: как мы навели мосты

Вишенка на торте

Публикации

Истории

Работа

Ближайшие события