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

Many have probably heard of a great way to solve programmer tasks called duckling (rubber duck debugging). The essence of the method is that it is necessary to sit in the bathroom, relax, put a toy duck on the water, and explain to it the essence of the problem that you cannot find a solution to. And, miraculously, after such a conversation, the solution is found.

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

So, for those who have not read the previous article, I once again summarize 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 analogue of code blocks, but it is incompatible with those code blocks that it expects from macOS API. The fact is that many classes have functions that use code blocks as handler's for completion. The simplest example is the beginWithCompletionHandler classes NSSavePanel and NSOpenPanel . The transmitted code block is executed at the moment of closing the dialog:

 - (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 had not approached the solution to the problem from the wrong end. Surely this problem exists not only in Delphi. Therefore, we must start with how the problem is solved in other languages. Google in hand and we find very close to our topic code for Python and JavaScript here and here . Good start: if they succeeded, then we will succeed. In essence, 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 very magic pointer that we can pass into those macOS class methods that expect blocks from us. A little more googling, and we find the 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 put 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, after reading a little more about blocks ( How blocks are implemented and on Habré, Objective-C: how blocks work ), let's move on 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; 

We still leave the flags field zero, for simplicity. Later it will be useful to us. It remains for us to declare as long as the empty function of the callback. The first argument in the callback will be a pointer to an instance of the NSBlock class, and the list of other parameters depends on the specific method of the Cocoa class that will call the code block. In the example above, with NSSavePanel , this is a procedure with a single argument of type NSInteger . So we write to start:

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

Responsible 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 saving dialog opens, we click OK or Cancel and ... yes! We will get to the break point, which was set to Sleep(0) , and yes, in the argument i1 will be either 0 or 1, depending on which button in the dialog we pressed. Victory! We are happy with the duckling, but there is a lot of work ahead:

• The number and type of callback arguments can be different. There are certain most popular kits, but flexibility is required.
• We may have a lot of code blocks working at the same time. For example, we can download the file with the completion handler call upon completion and, in parallel, open and close the file save dialog. First, the code block that we created second will work, and when the file is downloaded, the first code block will work. It would be good 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 is lost. I want 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 kind of callbacks. Obviously, the easiest and most reliable way is to have a 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; 

And so on. But somehow it is tedious and inelegant, right? Therefore, thought leads us further. What if you declare only one kind of callback, identify the block that caused the callback, find out the number of arguments and crawl along the stack, reading the required 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. It will work in 32-bit code, but crashes to hell in 64-bit, because no cdecl in 64-bit code happens, but there is one general calling convention, which, unlike cdecl, passes arguments in a stack , and in the registers of the processor. Well, then let's act even easier, we will declare a callback like this:

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

And we will just read as many arguments as we need. The remaining arguments will be rubbish, but we will not turn to 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 security of this approach, use separate callbacks for each type of function. I think the approach is quite safe, but, as they say, tastes differ.

As for block identification, everything turned out to be quite simple: aNSBlock , which comes to us, as the first argument in the callback, points to exactly the same Descriptor that we allocated when creating the block.

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

 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; 

Thus, creating a block with a procedure that, for example, has two arguments of size 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 refer to BlockObj, a singleton instance of the TObjCBlockList class, which is needed to manage the entire farm and is not accessible from outside the unit:

  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; 

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 main things. There are only a few subtle points.

First, we need to add thread safety so that we can work with a class instance from different threads. It's pretty simple, and we added the appropriate code.

Secondly, we need to find out, and when it is possible to finally “beat” the structure created by us, 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 loaded, the completion handler was called - everything is done. In fact, this is not always the case. There are blocks that are called as many times as necessary; For example, in the imageWithSize: flipped: drawingHandler: NSImage you need to pass a pointer to a block that will draw a picture, which, as you understand, can occur at least a million times. This is where aDesc.dispose_helper := @DisposeCallback useful to aDesc.dispose_helper := @DisposeCallback . A call to the DisposeCallback procedure will signal that the block is no longer needed and can be safely removed.

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 referring to Cocoa classes? It turns out that for this there are special low-level functions that we first need to declare in Delphi like this:

  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, which calls the block we passed as an argument. The second simply cleans up the memory. Great, then we need to create a block using our beautiful class, transfer it to imp_implementationWithBlock , call the function at the received address and look at how the unit worked with a sinking heart. We try to fulfill all this. 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; 

Run and ... oops. We fall into an anonymous method: p1 = 1, p2 = 3, p3 = 4, p4 = garbage. What the ...? Who ate a deuce? And why is garbage in the last parameter? It turns out that the point is that imp_implementationWithBlock returns a trampoline, which allows you to call a block as an IMP . The problem is that IMP in Objective-C always have two required first arguments, (id self, SEL _cmd) , i.e. pointers to the object and to the selector, and the code block has only one mandatory argument at the beginning. The returned trampoline, when called, edits the list of arguments: the second argument, _cmd , is thrown out for uselessness, the first argument is written in its place, but the pointer to NSBlock substituted for the first argument.

Yes, like this, the trampoline crept unnoticed. Ok, second variant, correct :

 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 runs smoothly and you can enjoy working with blocks. The whole unit can be downloaded here or viewed below. Comments ("lamers, you have a memory 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<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.