Многие, наверное, слышали о замечательном способе решения программистских задач под названием метод утенка (rubber duck debugging). Суть метода в том, что надо сесть в ванную, расслабиться, посадить на воду игрушечного утенка, и объяснить ему суть той проблемы, решение которой вы не можете найти. И, чудесным образом, после такой беседы решение находится.
В своей прошлой статье на Хабре, где я рассказывал о разработке TamoGraph Site Survey для 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.ссылка на оригинал статьи https://habrahabr.ru/post/325204/
Добавить комментарий