Using code blocks from Objective-C in Delphi on macOS: how we built bridges

Many have probably heard of a great way to solve programming problems called the rubber duck debugging method . The essence of the method is to sit in the bathroom, relax, put a toy duckling on the water, and explain to him the essence of the problem, the solution of which you cannot find. And, miraculously, after such a conversation, a solution is found.

In my last article on Habr , where I talked about developing a program for inspecting Wi-Fi networks for macOS, Habr turned out to be the duckling: I complained that we couldn’t come up with a way to implement code blocks from Objective-C in Delphi . And it helped! Enlightenment came, and it all worked out. I want to talk about the train of thoughts and the final result.

So, for those who have not read the previous article, once again briefly outline the essence of the problem. Code blocks is a C ++ and Objective-C language feature that is not supported in Delphi. More precisely, Delphi has its own analog code blocks, but it is incompatible with those code blocks that it expects from the macOS API. The fact is that many classes have functions that use code blocks as completion handlers. The simplest example is the beginWithCompletionHandler classes NSSavePaneland NSOpenPanel. The transmitted code block is executed when the dialog closes:

- (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.
      }
   }];
}

After talking with the duckling, I realized that I was approaching the problem from the wrong end. Surely this problem exists not only in Delphi. Therefore, you need to start with how the problem is solved in other languages. Google is in our hands and we find code for Python and JavaScript very close to our topic here and here . A good start: if they succeeded, then we will succeed. In fact, we just need to create a structure in the correct format, fill in the fields, and a pointer to such a structure will be the magic pointer that we can pass to those methods of the macOS classes that expect blocks from us. A little more googling, and we find a header on the Apple website:

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
};

We state it in Pascal:

  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;

Now, having read a little more about blocks ( How blocks are implemented also on Habré, Objective-C: how blocks work ), we will proceed to creating a block, while in the simplest version, on the knee:

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;

flagsWe leave the field zero for simplicity. It will come in handy later. It remains for us to declare an empty callback function for now. The first argument in the callback will be a pointer to an instance of the class NSBlock, and the list of other parameters depends on the specific method of the Cocoa class, which will call code block. In the example above, c NSSavePanel, this is a procedure with one type argument NSInteger. So let's write for a start:

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

A crucial moment, shot on goal:

    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
                   );

The file save dialog opens, we press OK or Cancel and ... yes! We get to the break point that we set to Sleep(0), and yes, the argument i1will be either 0 or 1, depending on which button in the dialog we clicked. Victory! The duckling and I are happy, but there is a lot of work ahead:

• The number and type of callback arguments can be different. There are certain most popular sets, but flexibility is required.
• We can have many code blocks in operation at the same time. For example, we can download a file with a call to completion handler upon completion and, in parallel, open and close the file save dialog. First, the block code that we created the second will work, and when the file is downloaded, the first block code will work. It would be nice to keep records.
• We need to somehow identify the block that caused the callback and call the Delphi code corresponding to this block.
• It would be great to make a bridge between anonymous methods in Delphi and code blocks, without which all convenience and beauty are lost. I would like the call to look something like this:

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

Let's start with the look of callbacks. Obviously, the easiest and most reliable way is to have your own callback for each type of function:

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

Etc. But somehow it's boring and inelegant, right? Therefore, thought leads us further. What if you declare only one type of callback, identify the block that caused the callback, find out the number of arguments and crawl along the stack by reading the right number of arguments?

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;

Good idea? No, bad. This will work in 32-bit code, but it will crash to hell in 64-bit, because there is no cdecl in 64-bit code, but there is one common calling convention, which, unlike cdecl, passes arguments not in the stack , but in the processor registers. Well, then we’ll do it even easier, declare a callback like this:

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

And we’ll just read as many arguments as we need. There will be garbage in the remaining arguments, but we will not address them. And at the same time, we changed the procedure to function, in case the code block requires a result. Disclaimer: if you are not sure about the safety of this approach, use separate callbacks for each type of function. To me, the approach seems pretty safe, but as they say, tastes differ.

As for the identification of the block, everything turned out to be quite simple: the aNSBlockone that comes to us as the first argument in the callback indicates exactly the same Descriptorone that we allotted when creating the block.

Now you can deal with anonymous methods of different types, we will cover 90 percent of the possible sets of arguments that are found in practice in macOS classes and we can always expand the list:

type
  TProc1 = TProc;
  TProc2 = TProc;
  TProc3 = TProc;
  TProc4 = TProc;
  TProc5 = TProc;
  TProc6 = TProc;
  TProc7 = TFunc;
  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;

Thus, creating a block with a procedure that, for example, has two size arguments SizeOf(pointer), will look like this:

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

CreateBlockWithCFunc looks like this:

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

I.e. we turn to BlockObj, a singleton-instance of the class TObjCBlockListthat is needed to manage all this economy and is not accessible outside the unit:

  TBlockInfo = packed record
     BlockStructure: Block_Literal;
     LocProc: TProc;
     ProcType: TProcType;
  end;
  PBlockInfo = ^TBlockInfo;
  TObjCBlockList = class (TObject)
  private
    FBlockList: TArray;
    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 read FBlockList ;
  end;
var
  BlockObj: TObjCBlockList;

The "heart" of our class beats here:

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;

Well, we wrote all the basic. Only a few subtle points remain.

First, we need to add thread safety so that we can work with an instance of the class from different threads. It is quite simple, and we have added the appropriate code.

Secondly, we need to know, and when can we finally “nail” the structure we created, i.e. array element FBlockList. At first glance, it seems that as soon as the system called the callback, the block can be deleted: the file was downloaded, the completion handler was called - that's it, it's done. In fact, this is not always the case. There are blocks that are called any number of times; for example, in the method imageWithSize: flipped: drawingHandler: class NSImageneed to pass a pointer to a block that will draw a picture that, as you know, can happen a million times. This is where we come in handy aDesc.dispose_helper := @DisposeCallback. The procedure call DisposeCallbackwill signal that the block is no longer needed and can be safely deleted.

Cherry on the cake

And let's write a self-test, right in the same unit? Suddenly something will break in the next version of the compiler or when switching to 64 bits. How can I test blocks without accessing Cocoa classes? It turns out that for this there are special low-level functions that we need to declare in Delphi as follows:

  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';

The first function returns a pointer to a C function that calls the block that we passed as an argument. The second simply "cleans" then the memory. Well, that means we need to create a block with the help of our beautiful class, pass it to imp_implementationWithBlock, call the function at the received address, and with bated breath see how the block worked. We are trying to do it all. Option one, naive :

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;

Now everything goes smoothly and you can enjoy working with blocks. The whole unit can be downloaded here or see below. Comments ("lamers, your memory is flowing here") and suggestions for improvement are welcome.

{*******************************************************}
{                                                       }
{     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;
  TProc3 = TProc;
  TProc4 = TProc;
  TProc5 = TProc;
  TProc6 = TProc;
  TProc7 = TFunc;
  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;
    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 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.