How to setup a callback function?

Machine-specific discussion
Unix, Linux, OS X, OS/2, Windows, ..?
Locked
ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

How to setup a callback function?

Post by ale870 »

Hello,

I'm writing a Delphi program that uses newLisp as DLL.
I successfully used "newLispEvalStr" to evaluate newLisp code from Delphi.

Now I have a problem. My program makes the following steps:

1) Run Delphi program
2) Open newLisp DLL
3) Delphi call a newLisp function
4) NEWLISP CALL A REFRESH FUNCTION DEFINED IN DELPHI
5) newLisp function terminates

My problem is item (4). In fact, I create a delphi function to refresh values in delphi form, but I don't know to to pass this function pointer (function "delphiRefresh") to newLisp, so it can call to update data in the form.
Imagine a newLisp program like this (this small function will be called from delphi, when the user press the button "start!"):

(define (incCounter argVal) (
(+ argVal 1)
(delphiRefresh)
(+ argVal 1)
)

Obviously, this is a non-working trivial example.
I need to make a delphi function (deplhiRefresh) and call it in newLisp.

(like a callback).

Can you give me some hints how to pass to newLisp a pointer to delphi function?

Thank you.
--

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

In my neobook plugin I used a different method.
The delphi programm (neobook) calls a delphi DLL.
This DLL exports a callback function for newLisp with Pchar parameters.
newLisp use (import ...) to get the callback from the DLL.
For the EXE-DLL communication I use the neobook plugin interface.
So in a standard delphi-EXE something similar would be needed.

(Not sure about passing directly a pointer of a delphi function to newlisp)
(if possible I would be interested in the solution too!)
Hans-Peter

m35
Posts: 171
Joined: Wed Feb 14, 2007 12:54 pm
Location: Carifornia

Post by m35 »

I assume you can get the pointer to the function, right? So once you have the pointer, you should be able to pass it as an integer to the newLISP.dll. Then using a bit of hackery you can convert that integer to a newLISP function.

Code: Select all

; Function to convert a pointer to a function
(define (ptr-to-fn ptr , foo)
    ; get function template
    (set 'foo import)

    ; change type to library import and OS calling conventions
    (cpymem (pack "ld" 265) (first (dump foo)) 4) ; Win32 stdcall
    ; set code pointer
    (cpymem (pack "ld" ptr) (+ (first (dump foo)) 12) 4)
    foo
)
This code is based on some code Lutz wrote sometime somewhere that I don't remember :)

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

Thank you!
It works, but it seems it has problems for parameters passing.
In fact I cannot pass a string to my Pascal function.
Any suggestion to solve this problem?
(however, I'm "studying" to solve it :-)

Thank you!
--

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

It works, but it seems it has problems for parameters passing.
In fact I cannot pass a string to my Pascal function.
Did you use a PChar parameter type?
I used this in my callbacks into a exported functions from my DLL.

Can you post a sample project with your current solution?
Hans-Peter

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

Yes, I use PChar.
I found a solution by creating an array in Delphi, then I send to newLisp address memory of that array, and I use it as shared memory to exchange data.
I'm looking for better solutions.

Now I'm busy, but I will send you the code within today (I hope!).
--

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

Hello,

this is a piece of code I used to make a shared memory area between my Lazarus Free Pascal code newLisp dll. However, I will write a complete article on my blog within some days.

I reported only the "core" code, since I have a long source code containing many other things (not useful in this context).
One thing more: I use newLisp DLL as dynamic library:

Code: Select all

var
  DllNewLisp      : THandle;
  newLispEvalStr  : function(argExpression: pchar): pchar; stdcall;

procedure openNewLispLibrary;
begin
  DllNewLisp := LoadLibrary('newlisp.dll');
  if (DllNewLisp < HINSTANCE_ERROR) then
    raise Exception.Create('newlisp.dll' + ' library can not be loaded or not found. ' + SysErrorMessage(GetLastError));

  try
    { load an address of required procedure}
    Pointer(newLispEvalStr) := GetProcAddress(DllNewLisp, 'newlispEvalStr');

  finally
    {unload a library}

  end;
end;
And this is the code to make shared memory area:

Code: Select all

type
  TForm1 = class(TForm)
    procedure Button5Click(Sender: TObject);
  private
    { private declarations }
  public
    // This is the procedure that I call from newLisp.
    procedure xRefresh; stdcall;
  end;             

var
  // This is the shared memory area, preallocated using an array.
  pSharedMem : array[0..1000] of char;

implementation

procedure TForm1.xRefresh; stdcall;
begin
  showmessage(pSharedMem);
end;  

procedure registerAndUseSharedMemory;
var
  punta: string;
begin

  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //

  punta := '(set ''foo print)(cpymem (pack "ld" 265) (first (dump foo)) 4)(cpymem (pack "ld" ' +
    IntToStr(integer(@TForm1.xRefresh)) + ') (+ (first (dump foo)) 12) 4)' +
    '(cpymem (pack "ld" "foo") (+ (first (dump foo)) 8)  4)';

  newLispEvalStr(pchar(punta));
   
  //
  // This is the code to "register" shared memory area in newLisp.
  //
    
  punta := '(set ''gloSharedMem _gloSharedMem)(cpymem (pack "ld" '+ IntToStr(integer(@pSharedMem)) + ') (+ (first (dump gloSharedMem)) 12) 4)';

  newLispEvalStr(pchar(punta));

  //
  // Here I write a string in the shared memory area, and add a NULL char 
  // as end-of-line (based on C convention).
  //

  newLispEvalStr(pchar('(cpymem (append "Hello newLisp!" (char 0)) (address gloSharedMem) 15)'));
  newLispEvalStr(pchar('(foo)'));
end;
When I recall the function newLisp foo (TForm1.xRefresh) it will print the content inside shared memory. I suppose I'm using pchar.
--

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

I played with your code (with delphi 5) and got something to work:

Code: Select all

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1  : TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    // This is the procedure that I call from newLisp.
    procedure xRefresh(param1 : PChar); stdcall;
  end;

var
  Form1: TForm1;
  DllNewLisp      : THandle;
  newLispEvalStr  : function(argExpression: pchar): pchar; stdcall;

implementation

{$R *.DFM}

procedure openNewLispLibrary;
begin
  DllNewLisp := LoadLibrary('newlisp.dll');
  if (DllNewLisp < HINSTANCE_ERROR) then
    raise Exception.Create('newlisp.dll' + ' library can not be loaded or not found. ' + SysErrorMessage(GetLastError));
  try
    { load an address of required procedure}
    @newLispEvalStr := GetProcAddress(DllNewLisp, 'newlispEvalStr');
  finally
    {unload a library}
  end;
end;

procedure TForm1.xRefresh(param1 : PChar); stdcall;
begin
  showmessage(param1);
  showmessage(IntToStr(Strlen(param1)));
end;

procedure registerAndCall(txtparam : String);
var
  punta: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  punta := '(set ''foo print)' +
           '(cpymem (pack "ld" 265) (first (dump foo)) 4)' +
           '(cpymem (pack "ld" ' +
           IntToStr(integer(@TForm1.xRefresh)) + ') (+ (first (dump foo)) 12) 4)' +
           '(cpymem (pack "ld" "foo") (+ (first (dump foo)) 8)  4)';


  newLispEvalStr(pchar(punta));

  // I do not know why this work for me.
  punta := '(foo \"'+ txtparam + ' is the String from the edit-field")';
  newLispEvalStr(pchar(punta));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   openNewLispLibrary;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  registerAndCall(Edit1.Text);
end;

end.
As I wrote in the comment I do not know why the escaped parameter make it working!

;-)

Code: Select all

//What does the escape in newlisp here?
'(foo \"........")'
Hans-Peter

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

Some more insights:

Code: Select all

punta := '(foo nil "'+ txtparam + ' is the String from the edit-field")';
This works also since the escape-char evaluates to nil.
So it seems that the second parameter gets passed to the delphi-call.
Hans-Peter

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

That's funny!
I tried to pass params to delphi function, but it worked only once. I think there are some problems with memory allocation.
I don't know if, in delphi function call from newLisp, if newLisp allocates parameters in the stack (as the "normal" function call does). Then consider that in pascal paramter passing is from left to right, insted in C-like fashion it is from right to left (and paramters in the stack are in the reverse order).
Maybe your "nil" value set something special in the stack. But... what exactly?
Maybe someone (or Lutz ;-) ) could help us to understand that!!
--

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

Pascal calling conventions are definitely different from C, and Pascal strings are also different. I think they carry the length in the first to bytes. You may have to use 'unpack' to split of the length and string from the Pascal string-address. But you better ask some Pascal expert.

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

Currently, in order to define a formal method to exchange data using memory shared address, I'm using this record in Pascal:

Code: Select all

const
  SHARED_MEM_SIZE = 100000;

type
  TSharedMem = record
    dataLen: longint;
    dataBuffer: array[0..SHARED_MEM_SIZE] of char;
  end; 

var
  pSharedMem: TSharedMem;
Then I use this code to use the record:

Code: Select all

IntToStr(integer(@pSharedMem))
Then I use this newLisp code to fill the shared memory:

Code: Select all

(define (do-callback argData)
	(cpymem (pack "ld" (length argData)) (address gloSharedMem) 4 )
    (cpymem argData (+ (address gloSharedMem) 4) (length argData) )
    );define
In this way I put data length in the first 4 bytes (longint) and I put data in the remain buffer. In this way I avoid to use null char, furthermore I will be able to use shared memory to pass binary data (null char included!).
--

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

@Lutz:
yes, pascal does not use null char for string termination, but put char length in the first position of a string.
Look at this code:

Code: Select all

s:='Hello, World';
s[1]:='J';
s[0] is the string lenght, and the first char is s[1] (in C first char would be s[0]).
--

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

Some more test with delphi 5:

Code: Select all

unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Edit1  : TEdit; 
    Button3: TButton; 
    Edit2: TEdit; 
    Button4: TButton; 
    Edit3: TEdit; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
    // This is the procedure that I call from newLisp. 
    procedure xRefresh1(param1 : PChar); stdcall; 
    procedure xRefresh2(param1,param2 : PChar); stdcall; 
    procedure xRefresh3(param1,param2,param3 : PChar); stdcall; 
  end; 

var 
  Form1: TForm1; 
  DllNewLisp      : THandle; 
  newLispEvalStr  : function(argExpression: pchar): pchar; stdcall; 

implementation 

{$R *.DFM} 

procedure openNewLispLibrary; 
begin 
  DllNewLisp := LoadLibrary('newlisp.dll'); 
  if (DllNewLisp < HINSTANCE_ERROR) then 
    raise Exception.Create('newlisp.dll' + ' library can not be loaded or not found. ' + SysErrorMessage(GetLastError)); 
  try 
    { load an address of required procedure} 
    @newLispEvalStr := GetProcAddress(DllNewLisp, 'newlispEvalStr'); 
  finally 
    {unload a library} 
  end; 
end; 

procedure TForm1.xRefresh1(param1 : PChar); stdcall; 
begin 
  showmessage(param1); 
  showmessage(IntToStr(Strlen(param1))); 
end; 

procedure TForm1.xRefresh2(param1, param2 : PChar); stdcall; 
begin 
  showmessage(param1+' / '+param2); 
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2))); 
end; 

procedure TForm1.xRefresh3(param1, param2, param3 : PChar); stdcall; 
begin 
  showmessage(param1+' / '+param2+' / '+param3); 
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2))+' / '+IntToStr(Strlen(param3))); 
end; 

procedure registerAndCall1(txtparam : String); 
var 
  newlispstr: string; 
begin 
  // I'm using Lutz code to link Pascal function to be used in newLisp. 
  newlispstr := '(set ''foo print)' + 
                '(cpymem (pack "ld" 265) (first (dump foo)) 4)' + 
                '(cpymem (pack "ld" ' + 
                IntToStr(integer(@TForm1.xRefresh1)) + ') (+ (first (dump foo)) 12) 4)' + 
                '(cpymem (pack "ld" "foo") (+ (first (dump foo)) 8)  4)'; 


  newLispEvalStr(pchar(newlispstr)); 

  newlispstr := '(foo nil "'+ txtparam + ' is the String from the edit-field")'; 
  newLispEvalStr(pchar(newlispstr)); 
end; 

procedure registerAndCall2(txtparam1, txtparam2 : String); 
var 
  newlispstr: string; 
begin 
  // I'm using Lutz code to link Pascal function to be used in newLisp. 
  newlispstr := '(set ''foo1 print)' + 
                '(cpymem (pack "ld" 265) (first (dump foo1)) 4)' + 
                '(cpymem (pack "ld" ' + 
                IntToStr(integer(@TForm1.xRefresh2)) + ') (+ (first (dump foo1)) 12) 4)' + 
                '(cpymem (pack "ld" "foo1") (+ (first (dump foo1)) 8)  4)'; 


  newLispEvalStr(pchar(newlispstr)); 

  newlispstr := '(foo1 nil "'+ txtparam1 + ' is the String from the edit-field" "Test2:'+ txtparam2 + '")'; 
  newLispEvalStr(pchar(newlispstr)); 
end; 

procedure registerAndCall3(txtparam1, txtparam2, txtparam3 : String); 
var 
  newlispstr: string; 
begin 
  // I'm using Lutz code to link Pascal function to be used in newLisp. 
  newlispstr := '(set ''foo2 print)' + 
                '(cpymem (pack "ld" 265) (first (dump foo2)) 4)' + 
                '(cpymem (pack "ld" ' + 
                IntToStr(integer(@TForm1.xRefresh3)) + ') (+ (first (dump foo2)) 12) 4)' + 
                '(cpymem (pack "ld" "foo2") (+ (first (dump foo2)) 8)  4)'; 


  newLispEvalStr(pchar(newlispstr)); 

  newlispstr := '(foo2 nil "'+ txtparam1 + ' is the String from the edit-field" "Param2:'+ txtparam2 + '" "Param3:'+ txtparam3 + '")'; 
  newLispEvalStr(pchar(newlispstr)); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
   openNewLispLibrary; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
  registerAndCall1(Edit1.Text); 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
begin 
  registerAndCall2(Edit1.Text, Edit2.Text); 
end; 

procedure TForm1.Button4Click(Sender: TObject); 
begin 
  registerAndCall3(Edit1.Text, Edit2.Text, Edit3.Text); 
end; 

end. 
Using Pchar's I have no problem with the parameter-passing.
(And PChar's are null-terminated strings)
Even multiple paramters works as expected.
I have used PChars in my DLL-solution (neobook plugin) for years now for massiv parameter-passing between delphi and newlisp.dll without problems.
Last edited by HPW on Fri Jul 25, 2008 4:28 pm, edited 1 time in total.
Hans-Peter

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

Great!
I will make more tests in order to verify if that solution will bee good for me too.
--

m35
Posts: 171
Joined: Wed Feb 14, 2007 12:54 pm
Location: Carifornia

Post by m35 »

HPW wrote:

Code: Select all

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Edit1  : TEdit; 
    Button3: TButton; 
    Edit2: TEdit; 
    Button4: TButton; 
    Edit3: TEdit; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
    // This is the procedure that I call from newLisp. 
    procedure xRefresh1(param1 : PChar); stdcall; 
    procedure xRefresh2(param1,param2 : PChar); stdcall; 
    procedure xRefresh3(param1,param2,param3 : PChar); stdcall; 
  end; 
Maybe I'm reading your code wrong, but are you saying that newLISP is calling class instance method (TForm1.xRefresh1)?

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

You are correct. We pass the address-pointer to newlisp and newlisp call it and the params are set.
The only unclear thing is, why we need the first nil to offset the parameters by 1. Anyway, it works! ;-)
Hans-Peter

m35
Posts: 171
Joined: Wed Feb 14, 2007 12:54 pm
Location: Carifornia

Post by m35 »

When you call a C++ instance method, it secretly passes the pointer to the class instance as the first argument.

Code: Select all

class cls {
@public:
   // like declaring static void callme(cls *this, int i);
   void callme(int i); 
};

int main()
{
   cls c;
   c.callme(10); // actually becomes callme(&c, 10);
}
I may have some of the details wrong, but that's basically what happens.
I can only assume Pascal does the same.

ale870
Posts: 297
Joined: Mon Nov 26, 2007 8:01 pm
Location: Italy

Post by ale870 »

@m35 that's a very good explanation!
Do you think that if we create a procedure and not a "method" the parameter "null" could be eliminated?
--

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

Added example using a function-call with a return-string.

Code: Select all

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Edit1  : TEdit;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Edit3: TEdit;
    Button5: TButton;
    Edit4: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    // This is the procedure that I call from newLisp.
    procedure xRefresh1(param1 : PChar); stdcall;
    procedure xRefresh2(param1,param2 : PChar); stdcall;
    procedure xRefresh3(param1,param2,param3 : PChar); stdcall;
    function  xRefresh4( param1 : PChar; retValue : PChar ): BOOLEAN; stdcall;
  end;

var
  Form1: TForm1;
  DllNewLisp      : THandle;
  newLispEvalStr  : function(argExpression: pchar): pchar; stdcall;

implementation

{$R *.DFM}

procedure openNewLispLibrary;
begin
  DllNewLisp := LoadLibrary('newlisp.dll');
  if (DllNewLisp < HINSTANCE_ERROR) then
    raise Exception.Create('newlisp.dll' + ' library can not be loaded or not found. ' + SysErrorMessage(GetLastError));
  try
    { load an address of required procedure}
    @newLispEvalStr := GetProcAddress(DllNewLisp, 'newlispEvalStr');
  finally
    {unload a library}
  end;
end;

procedure TForm1.xRefresh1(param1 : PChar); stdcall;
begin
  showmessage(param1);
  showmessage(IntToStr(Strlen(param1)));
end;

procedure TForm1.xRefresh2(param1, param2 : PChar); stdcall;
begin
  showmessage(param1+' / '+param2);
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2)));
end;

procedure TForm1.xRefresh3(param1, param2, param3 : PChar); stdcall;
begin
  showmessage(param1+' / '+param2+' / '+param3);
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2))+' / '+IntToStr(Strlen(param3)));
end;

FUNCTION TForm1.xRefresh4( param1 : PChar; retValue : PChar ): BOOLEAN; stdcall;
VAR      Varstr     : PChar;
begin
    showmessage(param1);
    Varstr := 'TestReturnString';
    StrCopy ( retValue, Varstr);
    Result := True;
end;

procedure registerAndCall1(txtparam : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo print)' +
                '(cpymem (pack "ld" 265) (first (dump foo)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh1)) + ') (+ (first (dump foo)) 12) 4)' +
                '(cpymem (pack "ld" "foo") (+ (first (dump foo)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo nil "'+ txtparam + ' is the String from the edit-field")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall2(txtparam1, txtparam2 : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo1 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo1)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh2)) + ') (+ (first (dump foo1)) 12) 4)' +
                '(cpymem (pack "ld" "foo1") (+ (first (dump foo1)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo1 nil "'+ txtparam1 + ' is the String from the edit-field" "Test2:'+ txtparam2 + '")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall3(txtparam1, txtparam2, txtparam3 : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo2 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo2)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh3)) + ') (+ (first (dump foo2)) 12) 4)' +
                '(cpymem (pack "ld" "foo2") (+ (first (dump foo2)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo2 nil "'+ txtparam1 + ' is the String from the edit-field" "Param2 :'+ txtparam2 + '" "Param3: '+ txtparam3 + '")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall4(txtparam : String);
var
  newlispstr: string;
  retstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo4 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo4)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh4)) + ') (+ (first (dump foo4)) 12) 4)' +
                '(cpymem (pack "ld" "foo4") (+ (first (dump foo4)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // 16 is the length of the string which gets set in the callbackfunction. newLISP allocates the memory first.
  newlispstr := '(setq retvalue(dup " " (+ 16 1)))(foo4 nil "'+ txtparam + '" retvalue)';
  newLispEvalStr(pchar(newlispstr));
  newlispstr := '(get-string retvalue)';
  retstr := newLispEvalStr(pchar(newlispstr));
  showmessage(PChar('RetStr from Lisp: ' + retstr));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   openNewLispLibrary;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  registerAndCall1(Edit1.Text);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  registerAndCall2(Edit1.Text, Edit2.Text);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  registerAndCall3(Edit1.Text, Edit2.Text, Edit3.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  registerAndCall4(Edit4.Text);
end;

end.
Hans-Peter

HPW
Posts: 1390
Joined: Thu Sep 26, 2002 9:15 am
Location: Germany
Contact:

Post by HPW »

An optional lisp-call as a one-liner without double quotes:

Code: Select all

  newlispstr := '(silent(setq retvalue(dup " " (+ 16 1))))(foo4 nil "'+ txtparam + '" retvalue)(print(get-string retvalue))';
  retstr := newLispEvalStr(pchar(newlispstr));
Hans-Peter

Locked