Добираться в настоящее время входило в систему пользователь:
System.getProperty("user.name"); //platform independent
и имя узла машины:
java.net.InetAddress localMachine = java.net.InetAddress.getLocalHost();
System.out.println("Hostname of local machine: " + localMachine.getHostName());
Ответ, после того как я много бегал по сети, заключается в том, что ассемблер предполагает наличие кадра стека при вызове InternalSetDispatcher.
Похоже, что кадр стека не создавался для вызова InternalSetDispatcher.
Исправить это так же просто, как включить кадры стека с помощью директивы компилятора {$ stackframes on} и перестроить.
Спасибо Мэйсону за твою помощь в получении этого ответа. :)
Редактировать 2012-08-08 : Если вам нравится это использовать, вы можете проверить реализацию в Delphi Sping Framework . Я не тестировал его, но похоже, что он лучше справляется с различными соглашениями о вызовах, чем этот код.
Изменить: Как я и просил, моя интерпретация кода Алана ниже. Помимо необходимости включения фреймов стека, Мне также нужно было включить оптимизацию на уровне проекта , чтобы это работало:
unit MulticastEvent;
interface
uses
Classes, SysUtils, Generics.Collections, ObjAuto, TypInfo;
type
// you MUST also have optimization turned on in your project options for this
// to work! Not sure why.
{$stackframes on}
{$ifopt O-}
{$message Fatal 'optimisation _must_ be turned on for this unit to work!'}
{$endif}
TMulticastEvent = class
strict protected
type TEvent = procedure of object;
strict private
FHandlers: TList<TMethod>;
FInternalDispatcher: TMethod;
procedure InternalInvoke(Params: PParameters; StackSize: Integer);
procedure SetDispatcher(var AMethod: TMethod; ATypeData: PTypeData);
procedure Add(const AMethod: TEvent); overload;
procedure Remove(const AMethod: TEvent); overload;
function IndexOf(const AMethod: TEvent): Integer; overload;
protected
procedure InternalAdd;
procedure InternalRemove;
procedure InternalIndexOf;
procedure InternalSetDispatcher;
public
constructor Create;
destructor Destroy; override;
end;
TMulticastEvent<T> = class(TMulticastEvent)
strict private
FInvoke: T;
procedure SetEventDispatcher(var ADispatcher: T; ATypeData: PTypeData);
public
constructor Create;
procedure Add(const AMethod: T); overload;
procedure Remove(const AMethod: T); overload;
function IndexOf(const AMethod: T): Integer; overload;
property Invoke: T read FInvoke;
end;
implementation
{ TMulticastEvent }
procedure TMulticastEvent.Add(const AMethod: TEvent);
begin
FHandlers.Add(TMethod(AMethod))
end;
constructor TMulticastEvent.Create;
begin
inherited;
FHandlers := TList<TMethod>.Create;
end;
destructor TMulticastEvent.Destroy;
begin
ReleaseMethodPointer(FInternalDispatcher);
FreeAndNil(FHandlers);
inherited;
end;
function TMulticastEvent.IndexOf(const AMethod: TEvent): Integer;
begin
result := FHandlers.IndexOf(TMethod(AMethod));
end;
procedure TMulticastEvent.InternalAdd;
asm
XCHG EAX,[ESP]
POP EAX
POP EBP
JMP Add
end;
procedure TMulticastEvent.InternalIndexOf;
asm
XCHG EAX,[ESP]
POP EAX
POP EBP
JMP IndexOf
end;
procedure TMulticastEvent.InternalInvoke(Params: PParameters; StackSize: Integer);
var
LMethod: TMethod;
begin
for LMethod in FHandlers do
begin
// Check to see if there is anything on the stack.
if StackSize > 0 then
asm
// if there are items on the stack, allocate the space there and
// move that data over.
MOV ECX,StackSize
SUB ESP,ECX
MOV EDX,ESP
MOV EAX,Params
LEA EAX,[EAX].TParameters.Stack[8]
CALL System.Move
end;
asm
// Now we need to load up the registers. EDX and ECX may have some data
// so load them on up.
MOV EAX,Params
MOV EDX,[EAX].TParameters.Registers.DWORD[0]
MOV ECX,[EAX].TParameters.Registers.DWORD[4]
// EAX is always "Self" and it changes on a per method pointer instance, so
// grab it out of the method data.
MOV EAX,LMethod.Data
// Now we call the method. This depends on the fact that the called method
// will clean up the stack if we did any manipulations above.
CALL LMethod.Code
end;
end;
end;
procedure TMulticastEvent.InternalRemove;
asm
XCHG EAX,[ESP]
POP EAX
POP EBP
JMP Remove
end;
procedure TMulticastEvent.InternalSetDispatcher;
asm
XCHG EAX,[ESP]
POP EAX
POP EBP
JMP SetDispatcher;
end;
procedure TMulticastEvent.Remove(const AMethod: TEvent);
begin
FHandlers.Remove(TMethod(AMethod));
end;
procedure TMulticastEvent.SetDispatcher(var AMethod: TMethod;
ATypeData: PTypeData);
begin
if Assigned(FInternalDispatcher.Code) and Assigned(FInternalDispatcher.Data) then
ReleaseMethodPointer(FInternalDispatcher);
FInternalDispatcher := CreateMethodPointer(InternalInvoke, ATypeData);
AMethod := FInternalDispatcher;
end;
{ TMulticastEvent<T> }
procedure TMulticastEvent<T>.Add(const AMethod: T);
begin
InternalAdd;
end;
constructor TMulticastEvent<T>.Create;
var
MethInfo: PTypeInfo;
TypeData: PTypeData;
begin
MethInfo := TypeInfo(T);
TypeData := GetTypeData(MethInfo);
inherited Create;
Assert(MethInfo.Kind = tkMethod, 'T must be a method pointer type');
SetEventDispatcher(FInvoke, TypeData);
end;
function TMulticastEvent<T>.IndexOf(const AMethod: T): Integer;
begin
InternalIndexOf;
end;
procedure TMulticastEvent<T>.Remove(const AMethod: T);
begin
InternalRemove;
end;
procedure TMulticastEvent<T>.SetEventDispatcher(var ADispatcher: T;
ATypeData: PTypeData);
begin
InternalSetDispatcher;
end;
end.
Из сообщения в блоге:
Эта функция удаляет сам и непосредственный абонент из цепочка вызовов и прямые переводы управление на соответствующий "небезопасный" метод при сохранении переданного в параметр (ы).
Код удаляет кадр стека для InternalAdd, который имеет только один параметр, Self
. Это не влияет на событие, которое вы передали, поэтому его можно безопасно копировать для любой другой функции только с одним параметром и соглашением о вызове регистра .
EDIT: В ответ на комментарий , есть момент, который вам не хватает. Когда вы написали: «Я знаю, что делает код (очищает кадр стека от родительского вызова)», вы ошибались. Это не касается родительского вызова. Это не очистка кадра стека от Add, это очистка кадра стека от текущего вызова InternalAdd.
Вот немного базовой теории объектно-ориентированного подхода, так как вы, кажется, немного запутались в этом Я признаю, что это немного сбивает с толку. Add действительно не имеет одного параметра, а SetEventDispatcher не имеет двух. Их на самом деле два и три соответственно. Первым параметром любого вызова метода, который не объявлен static , является Self
, и он незаметно добавляется компилятором. Таким образом, каждая из трех внутренних функций имеет по одному параметру. Это то, что я имел в виду, когда писал это.
Код Аллена работает над ограничением компилятора. Каждое событие является указателем на метод, но для универсальных шаблонов нет «ограничения метода», поэтому компилятор не знает, что T всегда будет 8-байтовой записью, которая может быть преобразована в TMethod. (На самом деле это не обязательно. Вы можете создать TMulticastEvent
, если вы действительно хотели сломать свою программу новыми и интересными способами.) Внутренние методы используют сборку для ручной имитации преобразования типов, полностью удаляя себя из стека вызовов и выполняя JMP (в основном GOTO) для соответствующего метода, оставляя он с тем же списком параметров, что и вызывающая его функция.
Итак, когда вы видите
procedure TMulticastEvent.Add(const AMethod: T);
begin
InternalAdd;
end;
, то, что он делает, эквивалентно следующему, если он будет компилироваться:
procedure TMulticastEvent.Add(const AMethod: T);
begin
Add(TEvent(AMethod));
end;
Ваш InternalSetDispatcher захочет сделать то же самое вещь: удалить собственный вызов с одним параметром, а затем перейти к SetDispatcher с точно таким же списком параметров, что и вызывающий метод SetEventDispatcher. Неважно, какие параметры имеет вызывающая функция или к какой функции она переходит. Какая разница (а это критично!