nielsAD / lape

Scripting engine with Pascal-like syntax for FPC and Delphi
119 stars 28 forks source link

Calling a script routine issues #205

Open jarroddavis68 opened 1 month ago

jarroddavis68 commented 1 month ago

Hi, I'm trying to figure out how to properly call a script function from Delphi. This code can:

However, when it has a return, it will crash. I need assistance with setting it up properly to handle a return result. This is based on code I saw in a post on here.

function  TlmScript.Execfunction(const AProcName: string; const AParams: array of Variant;
  const AIsEvent: Boolean=False): Variant;
var
  ParamVars : TObjectList<TLapeGlobalVar>;
  m: TLapeType_Method;
  i: Integer;
  VarStack2: lptypes.TByteArray;
  LResultPtr: Pointer;

  function getVar(BaseType: TLapeType; Value: String) : lptypes.TByteArray;
  var
    LapeVar : TLapeGlobalVar;
  begin
    LapeVar := BaseType.NewGlobalVarStr(Value);
    ParamVars.Add(LapeVar);
    SetLength(Result, LapeVar.Size);
    Move(PPointer(LapeVar.Ptr)^, Result[0], LapeVar.Size);
  end;

begin
  Result := varNull;

  if not Assigned(FCompiler) then Exit;

  if (not Assigned(FCompiler[AProcName])) then
  begin
    SetError('Error exec method: - Method with name "%s" does not exists!', [AProcName]);
    Exit;
  end;

  if not Assigned(FCompiler[AProcName].VarType) then
  begin
    SetError('Error exec method: - Method with name "%s" has incorrect type!', [AProcName]);
    Exit;
  end;

  m := TLapeType_Method(FCompiler[AProcName].VarType);

  if Length(AParams) < m.Params.Count then
  begin
    SetError('Error exec method: Wrong number of parameters found (%d), expected %d',
                                [Length(AParams), m.Params.Count]);
    Exit;
  end;

  //pushing params & vars to stack
  VarStack2 := nil;

  ParamVars := TObjectList<TLapeGlobalVar>.Create();

  for i := 0 to m.Params.Count - 1 do
    VarStack2 := VarStack2 + getVar(m.Params[i].VarType, VarToStr(AParams[i]));

  if Assigned(m.Res) then
    VarStack2 := VarStack2 + getVar(m.Res, Result);

  RunCode(FCompiler.Emitter, VarStack2, PCodePos(FCompiler[AProcName].Ptr)^);

  ParamVars.Free;
end;
ollydev commented 1 month ago

Hi, results are always a pointer after the parameters, if the script method returns a int32 think of:

var myResult: Int32;
PPointer(@VarStack[Length(VarStack) - Method.Res.Size])^ := @myResult;

I just wrote this very quickly, it's very crude but just a proof of concept. I will get back to this at a later date.

type
  TInvokeScriptMethod = class
  protected
    FEmitter: TLapeCodeEmitter;
    FVarStack: TByteArray;
    FMethod: TLapeGlobalVar;
    FMethodType: TLapeType_Method;
    FParamIndex: Integer;
    FParamOffset: Integer;
    FResult: TByteArray;
  public
    constructor Create(Emitter: TLapeCodeEmitter; Method: TLapeGlobalVar);

    procedure WriteParam(Data: Pointer);
    procedure ReadResult(Data: Pointer);
    procedure Call;
  end;

constructor TInvokeScriptMethod.Create(Emitter: TLapeCodeEmitter; Method: TLapeGlobalVar);
begin
  inherited Create();

  FEmitter := Emitter;
  FMethod := Method;
  FMethodType := FMethod.VarType as TLapeType_Method;
  FParamIndex := 0;
  FParamOffset := 0;
  SetLength(FVarStack, FMethodType.ParamSize);
  SetLength(FResult, FMethodType.Res.Size);
end;

procedure TInvokeScriptMethod.WriteParam(Data: Pointer);
var
  Param: TLapeParameter;
  Dest, Src, TheVar: TLapeGlobalVar;
begin
  Param := FMethodType.Params[FParamIndex];
  Dest := Param.VarType.NewGlobalVarP(@FVarStack[FParamOffset]);
  Src := Param.VarType.NewGlobalVarP(Data);

  Param.VarType.EvalConst(op_Assign, Dest, Src, [lefAssigning]);

  Inc(FParamIndex);
  Inc(FParamOffset, Param.VarType.Size);

  Dest.Free();
  Src.Free();
end;

procedure TInvokeScriptMethod.ReadResult(Data: Pointer);
var
  Res: TLapeType;
  Dest, Src, TheVar: TLapeGlobalVar;
begin
  Res := FMethodType.Res;
  Src := Res.NewGlobalVarP(@FResult[0]);
  Dest := Res.NewGlobalVarP(Data);

  Res.EvalConst(op_Assign, Dest, Src, [lefAssigning]);

  Dest.Free();
  Src.Free();
end;

procedure TInvokeScriptMethod.Call;
begin
  PPointer(@FVarStack[Length(FVarStack) - SizeOf(Pointer)])^ := @FResult[0];

  RunCode(FEmitter, FVarStack, PCodePos(FMethod.Ptr)^);
end; 

After the script has been compiled:

someResult := '';
someInt := 123;
someString := 'Hello world';

Test := TInvokeScriptMethod.Create(Compiler.Emitter, Compiler.getGlobalVar('SomeProc'));
Test.WriteParam(@someInt);
Test.WriteParam(@someString);
Test.Call();
Test.ReadResult(@someResult);
Test.Free();
WriteLn(someResult);

with this script:

function SomeProc(a: Integer; someString: String): String;
begin
  WriteLn a;
  WriteLn someString;
  Result := 'It worked?';
end;

begin
end.
jarroddavis68 commented 1 month ago

Alright, thanks very much.