Patch by Andrey Gruzdev

Author: pyscripter

PythonForDelphi/Components/Sources/Core/MethodCallBack.pas

@@ -97,7 +97,7 @@ procedure FreeCallBacks;
 implementation
 
 uses
- Windows, Classes;
+ {$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes;
 
 type
  PByte = ^Byte;
@@ -136,7 +136,11 @@ procedure GetCodeMem(var ptr: PByte; size: integer);
  if (page = nil) or (Longint(CodeMemPages^.CodeBlocks) - Longint(Pointer(CodeMemPages)) <= (size + 3*sizeof(PCodeMemBlock))) then
  begin
  // allocate new Page
+{$IFDEF MSWINDOWS}
  page:=VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
+{$ELSE}
+ page := GetMem(PageSize);
+{$ENDIF}
  page^.next:=CodeMemPages;
  CodeMemPages:=page;
  // init pointer to end of page
@@ -189,7 +193,11 @@ procedure FreeCodeMem(ptr: Pointer);
  CodeMemPages:=page^.Next;
 
  // free the memory
+ {$IFDEF MSWINDOWS}
  VirtualFree(page, 0, MEM_RELEASE);
+ {$ELSE}
+ FreeMem(page);
+ {$ENDIF} 
  end;
 
  exit;
@@ -233,7 +241,10 @@ function GetOfObjectCallBack( CallBack: TCallBack;
  argnum, calltype);
 end;
 
-function GetCallBack( self: TObject; method: Pointer;
+{$IFDEF MSWINDOWS}
+{$IFNDEF CPUX64}
+// win32 inplementation
+function GetCallBack( self: TObject; method: Pointer;
  argnum: Integer; calltype: tcalltype): Pointer;
 const
 // Short handling of stdcalls:
@@ -307,6 +318,187 @@ function GetCallBack( self: TObject; method: Pointer;
  end;
  result := Q;
 end;
+{$ELSE}
+procedure test;
+asm
+mov r9,[rbp+$2020]
+end;
+
+// win 64 implementation
+function GetCallBack( self: TObject; method: Pointer;
+ argnum: Integer; calltype: tcalltype): Pointer;
+const
+// 64 bit
+c64stack: array[0..14] of byte = (
+$48, $81, $ec, 00, 00, 00, 00,// sub rsp,$0
+$4c, $89, $8c, $24, $20, 00, 00, 00// mov [rsp+$20],r9
+);
+
+c64copy: array[0..14] of byte = (
+$4c, $8b, $8d, 00, 00, 00, 00,// mov r9,[rbp+0]
+$4c, $89, $8c, $24, 00, 00, 00, 00// mov [rsp+0],r9
+);
+
+c64regs: array[0..28] of byte = (
+$4d, $89, $c1, // mov r9,r8
+$49, $89, $d0, // mov r8,rdx
+$48, $89, $ca, // mov rdx,rcx
+$48, $b9, 00, 00, 00, 00, 00, 00, 00, 00, // mov rcx, self
+$48, $b8, 00, 00, 00, 00, 00, 00, 00, 00 // mov rax, method
+);
+
+c64jump: array[0..2] of byte = (
+$48, $ff, $e0 // jump rax
+);
+
+c64call: array[0..10] of byte = (
+$48, $ff, $d0, // call rax
+$48, $81,$c4, 00, 00, 00, 00, // add rsp,$0
+$c3// ret
+);
+var
+ i: Integer;
+ P,Q: PByte;
+ lCount : integer;
+ lSize : integer;
+ lOffset : integer;
+begin
+//test;
+ lCount := SizeOf(c64regs);
+ if argnum>3 then
+ Inc(lCount,sizeof(c64stack)+(argnum-4)*sizeof(c64copy)+sizeof(c64call))
+ else
+ Inc(lCount,sizeof(c64jump));
+
+ GetCodeMem(Q,lCount);
+ P := Q;
+
+ if argnum>3 then
+ begin
+ move(c64stack,P^,SizeOf(c64stack));
+ Inc(P,3);
+ lSize := (argnum +1 ) * sizeof(Int64);
+ move(lSize,P^,sizeof(Int32));
+ Inc(P,SizeOf(c64stack)-3);
+ for I := 5 to argnum do
+ begin
+ move(c64copy,P^,SizeOf(c64copy));
+ Inc(P,3);
+ lOffset := (i-1)*sizeof(Int64);
+ move(lOffset,P^,sizeof(Int32));
+ Inc(P,8);
+ lOffset := i*sizeof(Int64);
+ move(lOffset,P^,sizeof(Int32));
+ Inc(P,4);
+ end;
+ end;
+
+ move(c64regs,P^,SizeOf(c64regs));
+ Inc(P,11);
+ move(self,P^,SizeOf(self));
+ Inc(P,10);
+ move(method,P^,SizeOf(method));
+
+ Inc(P,SizeOf(c64regs)-21);
+
+ if argnum<4 then
+ move(c64jump,P^,SizeOf(c64jump))
+ else
+ begin
+ move(c64call,P^,SizeOf(c64call));
+ Inc(P,6);
+ lSize := (argnum+1) * sizeof(Int64);
+ move(lSize,P^,sizeof(Int32));
+ end;
+ result := Q;
+end;
+{$ENDIF}
+{$ELSE}
+// 32 bit with stack align
+function GetCallBack( self: TObject; method: Pointer;
+ argnum: Integer; calltype: tcalltype): Pointer;
+const
+// Short handling of stdcalls:
+S1: array [0..14] of byte = (
+$5A, //00 pop edx // pop return address
+$B8,0,0,0,0, //01 mov eax, self
+$50, //06 push eax
+$52, //07 push edx // now push return address
+// call the real callback
+$B8,0,0,0,0, //08 mov eax, Method
+$FF,$E0); //13 jmp eax
+
+//Handling for ctCDECL:
+C1: array [0..5] of byte = (
+// begin of call
+$55, //00 push ebp
+$8B,$EC, //01 mov ebp, esp
+$83,$EC,$0); //03 sub esp, align
+
+// push arguments
+// for i:= argnum-1 downto 0 do begin
+C2: array [0..3] of byte = (
+$8B,$45,0, //06+4*s mov eax,[ebp+8+4*i]
+$50); //09+4*s push eax
+// end;
+
+// self parameter
+C3: array [0..17] of byte = (
+$B8,0,0,0,0, //06+4*s mov eax, self
+$50, //11+4*s push eax
+// call the real callback
+$B8,0,0,0,0, //12+4*s mov eax,Method
+$FF,$D0, //17+4*s call eax
+// clear stack
+$83,$C4,0, //20+4*s add esp, 4+bytes+align
+$5D, //23+4*s pop ebp
+$C3); //24+4*s ret
+
+
+
+var
+ bytes: Word;
+ i: Integer;
+ P,Q: PByte;
+ align : integer;
+begin
+ if calltype = ctSTDCALL then begin
+ GetCodeMem(Q,15);
+ P := Q;
+ move(S1,P^,SizeOf(S1));
+ Inc(P,2);
+ move(self,P^,SizeOf(self));
+ Inc(P,7);
+ move(method,P^,SizeOf(method));
+ {Inc(P,6); End of proc}
+ end else begin {ctCDECL}
+ bytes := argnum * 4;
+align := ($10 - (bytes + 4{self} + 4{address} + 4{push bp}) and $f) and $f; // align to $10 for Mac compatibility
+
+ GetCodeMem(Q,24+4*argnum);
+ P := Q;
+ move(C1,P^,SizeOf(C1));
+ Inc(P,SizeOf(C1)-1);
+ p^ := align;
+ Inc(P);
+ for i:=argnum-1 downto 0 do begin
+ move(C2,P^,SizeOf(C2));
+ Inc(P,2);
+ P^:=8+4*i;
+ Inc(P,2);
+ end;
+ move(C3,P^,SizeOf(C3));
+ Inc(P,1);
+ move(self,P^,SizeOf(self));
+ Inc(P,6);
+ move(method,P^,SizeOf(method));
+ Inc(P,8);
+ P^ := 4+bytes+align;
+ {Inc(P,3); End of proc}
+ end;
+ result := Q;
+end;
+{$ENDIF}
 
 procedure DeleteCallBack( Proc: Pointer);
 begin
@@ -324,7 +516,11 @@ procedure FreeCallBacks;
  nextpage := page^.Next;
 
  // free the memory
- VirtualFree(page, 0, MEM_RELEASE);
+ {$IFDEF MSWINDOWS}
+ VirtualFree(page, 0, MEM_RELEASE);
+ {$ELSE}
+FreeMem(page);
+ {$ENDIF} 
 
  page := nextpage;
  end;