[fpc-pascal] assign code to a method

[Andrew Haines]

On 02/18/11 03:14, Angel Montesinos wrote:
> While waiting for a 64 bits Delphi, I am doing experimentation with
> fpc-Lazarus 64 bits. And this is my problem:
> 
> In most of my programs I use my own library for parsing and evaluating
> floating point functions like
> 
>   'x sin(y z)'
> 
> passed by the user as strings. The basic organization is as follows:

> In the debugger the exception is raised before the effective call of the
> function code. If then I press F7, then the debugger jumps to the
> following assemblies
> 
>    push    %rbp
>    mov     %esp,%ebp
>    fldpi                       {loads pi to the fpu}
>    ftspl   -0x18(%rbp)         {copy pi to stack}
>    movsd   -0x18(%rbp),%xmm0   {copies pi to XMM0, so caller
>                                {may find also there the result}
>    leaveq
>    retq
> 
> I have tried all possible combinations like V:= PChar(code), V:=
> @code[1], etc. to no avail. Thus I think something is wrong in my
> understanding of the whole business in 64 bits or in fpc-Lazarus,
> because this is not a problem in Delphi nor it was in an old version of
> fpc-Lazarus 32 bits. Please give me a tip.
> Many thanks in advance.
> 

>From the other comments it seems like you are writing some assembly to
memory at runtime then calling that code? If so then maybe the following
can help you.

I made some trampoline procedures where I wrote some executable code at
runtime and I had to, both on Window and Linux, allocate some memory
that was marked as executable. Here's a snippet of how I allocated the
memory. The code worked on Windows 7 x64/32 and Gentoo Linux x64/32

 PTrampolineBlock = ^TTrampolineBlock;
  TTrampolineBlock = record
    NextBlock: Pointer;
    Cursor: DWord;
    Size: DWord;
    Code: PtrUint; // this is actually the start of the remainder of the
allocated size
  end;

procedure TTrampolineManager.AllocateBlock;
const
  AllocSize = $1000;
var
  NewBlock: PTrampolineBlock;
begin
  {$IFDEF UNIX}
  NewBlock := fpmmap(nil, AllocSize, PROT_EXEC or PROT_READ or
PROT_WRITE, MAP_ANONYMOUS or MAP_PRIVATE, -1, 0);
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  NewBlock := VirtualAlloc(nil,AllocSize,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  {$ENDIF}

NewBlock^.Cursor:=PtrUint(@NewBlock^.Code)-PtrUint(@NewBlock^.NextBlock);
  NewBlock^.Size:=AllocSize;
  NewBlock^.NextBlock:=Block;
  Block := NewBlock;
end;

procedure TTrampolineManager.FreeBlock(var ABlock: PTrampolineBlock);
begin
  if ABlock = nil then
    Exit;
  FreeBlock(ABlock^.NextBlock);
  {$IFDEF UNIX}
  Fpmunmap(ABlock, ABlock^.Size);
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  VirtualFree(ABlock, 0, MEM_RELEASE);
  {$ENDIF}
  ABlock := nil;
end;

procedure TTrampolineManager.WriteData(const AData; ASize: Byte);
begin
  if Block = nil then AllocateBlock;
  //WriteLn('Writing: ', hexStr(PtrUint(AData), ASize*2));
  if Block^.Cursor + ASize >= Block^.Size then
    raise TrampolineBlockFullException.Create('');
  Move(AData, PByte(@Block^.Code)[Block^.Cursor], ASize);
  Inc(Block^.Cursor, ASize);
end;

so the usage would be like so
function TTrampolineManager.GenerateCode(args: ....): Pointer;
begin
try
  Result := CurrentBlock.Position; // = @Block + Block.Cursor
  repeat
    WriteData(your_data, size_of_data);
  until done;

except
    on e: TrampolineBlockFullException do
      begin
        TrampolineManager.AllocateBlock;
        Result := GenerateCode(args);
      end;
  end;
end;


Hope this helps :)

Regards,

Andrew Haines