I am a developer on a project that uses PascalScript, we use FreePascal.

I've written these methods for it and would like to share.

Insert (and Append): https://github.com/MerlijnWajer/Simba/blob/master/Units/MMLAddon/mmlpsthread.pas#L1015
Delete: https://github.com/MerlijnWajer/Simba/blob/master/Units/MMLAddon/mmlpsthread.pas#L1096

If anyone would like to modify them to fix my problem and make them cross-compiler, feel free.

My problem is I can't seem to get it to work with static arrays or figure out how to even tell if an array is static.

Currently I'm using a workaround. (Only accept variables as parameters)

Hello,

Please apply this patch:

From 179a796c4253c6d051ca60dbfcc2cbb151ca5149 Mon Sep 17 00:00:00 2001
From: Silvio Clecio <[email protected]>
Date: Fri, 13 Sep 2013 17:15:03 -0300
Subject: [PATCH] Clean up.

---
 Source/PascalScriptFCL.lpk | 1 -
 1 file changed, 1 deletion(-)

diff --git a/Source/PascalScriptFCL.lpk b/Source/PascalScriptFCL.lpk
index 9907f4e..659f3bd 100644
--- a/Source/PascalScriptFCL.lpk
+++ b/Source/PascalScriptFCL.lpk
@@ -2,7 +2,6 @@
 <CONFIG>
   <Package Version="4">
     <Name Value="PascalScriptFCL"/>
-    <AddToProjectUsesSection Value="True"/>
     <Author Value="Carlo Kok"/>
     <CompilerOptions>
       <Version Value="11"/>
-- 
1.8.1.msysgit.1

(or http://www.sendspace.com/file/3msfn9)

It removes automatic unit declaration for RT packages.

Thank you!

Hello,

I sent a patch to Lazarus team. Please see it here: http://bugs.freepascal.org/view.php?id=24855.

Thank you!

The following code:

var
p : PChar;
s : string;
begin
p:='123';
s:=p;
Writeln(s);
end.

Results in '12', not '123' in Delphi7. If p:='1234' it will be displayed '1234', so it cut off last odd symbol.

Delphi 2010 gives right result.
The problem in uPSRuntime.pas in

function PSGetAnsiString(Src: Pointer; aType: TPSTypeRec): tbtString;
begin
...
case aType.BaseType of
btU8: Result := tbtchar(tbtu8(src^));
btChar: Result := tbtchar(Src^);
btPchar: Result := pansichar(src^); // after that src^ is cutted off
...

[BC49736]

63572: Connect pascalscript: Weird problem using standard Trim function using unicode

In some cases Trim returns ???????? for unicode string

As a workaround we can use:
AddFunction('Function Trim(s : WideString) : WideString;'); //instead o AnyString

Should also check other string functions which contain AnyString

Now only published properties are accessible, adding at least "EOF", "Next", "Prev" and "First" will be very useful.

[BC37426]

All right. That seems to be where the problem is, then. Carlo, any idea
why it's doing that?

"irohanihoheto" wrote in message news:ftqh4d$il6$[email protected]...

'Code Block' problem ????

//-- ErrorScript (Invalid Jump Error) --//
// FLabelsInBlock.Count = 0 ('HasInvalidJumps' in uPSCompiler.pas)
program ErrorScript;
label L1;
var
i: Integer;
begin
i := 1;
case i of
0:
begin
{...}
end;
1:
begin
goto L1;
end;
end; //<-- case
Exit;

L1:
Writeln('Label L1');
end.
//-- End of ErrorScript --//

//-- OKScript --//
program OKScript;
label L1;
var
i: Integer;
begin
i := 1;
case i of
0:
begin
{...}
end;
1:
begin
goto L1;
Exit;
L1: Writeln('Label L1');
end;
end; //<-- case
end.
//-- End of OKScript --//

[BC26399]

User wrote:

I am trying to go around the ANSI source code limitations by preprocessing the script and replacing Unicode characters inside strings with explicit character codes (e.g #1074). Everything works fine except for one little thing:

s := 'abc' + #1074#1099;

This expression is evaluated incorrectly. The evaluation fails at compile stage. Same goes to comparing string or char to Unicode string. Runtime seems to work fine.

Hi,

When I use PSCompiler, uPSRuntime or both?

I'm planing to use your project here: silvioprog/brookframework#51.

Thank you!

Import sample:
Compile the following script
Program Test;
Begin
End

(without dot after end)

Error message will be
Error: period ('.') expected

If we save this script and compile it - error position will be right. It connected with using TPSPreProcessor component and doing
xpre.AdjustMessages(x1);

Checking for filename is performed in uPSPreProcessor.pas

function TPSLineInfoList.GetLineInfo(const ModuleName: tbtstring; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
var
...
begin
...
if (Pos >= Item.StartPos) and (Pos < Item.EndPos) and
(lModuleName = '') or (lModuleName = Item.FileName) then
...
end;

[BC49926]

Hello,

I made some samples partly compatible with Lazarus. Please see this issue:

http://bugs.freepascal.org/view.php?id=24857

Starting today I will report all bugs just here on Github.

Thank you very much! 👍

60743: Connect pascalscript: array of const

testcase:

program sample1;
uses
uPSCompiler,
uPSRuntime,
uPSC_DateUtils,
uPSR_DateUtils,
SysUtils;

{$IFDEF UNICODE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: AnsiString): Boolean;
{$ELSE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
{$ENDIF}
begin
if Name = 'SYSTEM' then
begin
RegisterDateTimeLibrary_C(Sender);
Sender.AddDelphiFunction('procedure Out_WriteFmt(Data: string; const Args : array of const)');

Result := True;

end else
Result := False;
end;

procedure Out_WriteFmt(Data: string; const Args : array of const);
begin
Writeln(Format(Data, Args));
end;

procedure ExecuteScript(const Script: string);
var
Compiler: TPSPascalCompiler;
Exec: TPSExec;
{$IFDEF UNICODE}Data: AnsiString;{$ELSE}Data: string;{$ENDIF}
begin
Compiler := TPSPascalCompiler.Create; // create an instance of the compiler.
Compiler.OnUses := ScriptOnUses; // assign the OnUses event.
if not Compiler.Compile(Script) then // Compile the Pascal script into bytecode.
begin
Compiler.Free;
Exit;
end;

Compiler.GetOutput(Data); // Save the output of the compiler in the string Data.
Compiler.Free; // After compiling the script, there is no need for the compiler anymore.

Exec := TPSExec.Create; // Create an instance of the executer.

RegisterDateTimeLibrary_R(Exec);
Exec.RegisterDelphiFunction(@Out_WriteFmt, 'Out_WriteFmt', cdRegister);

if not Exec.LoadData(Data) then // Load the data from the Data string.
begin
Exec.Free;
Exit;
end;

Exec.RunScript; // Run the script.
Exec.Free; // Free the executer.
end;

const
Script =
'var s:String; begin s := DateToStr(Now); Out_WriteFmt(''date is %s %s'', [s,s]); end.';

begin
ExecuteScript(Script);
Readln;
end.

When I division two numbers:
100/3
result is 33.
Of course that result is bad. Is not Integer number, it is Double.
Do not be surprised if I made 100 div 3.

The problem is no comma.
Try, 100/3.0 or 100/3.00
then result is correct, 33.333333333333

Another example:

var a: integer; b: double;
begin
a:=3;
b:=100/a;
writeln(Floattostr(b));
end.
As you might guess result is 33.000000000000. Wrong.

http://connect.remobjects.com/discussion/3639/importing-interfaces
We get AV when we try to use interfaces in our project

add support for unicode strings

[BC43827]

When the decimal point character is set to ',' (as it is in, e.g. the French locale), literal floats in PascalScript (using '.' as the decimal point, as I'd expect in a programming language) produce an 'Invalid float' error.

Following code does not work:

type
  TDay = (dMon, dTue, dWed, dThu, dFri, dSat, dSun);

procedure OnMissionStart;
var 
  a: set of TDay;
  i: TDay;
begin
  i := dMon;
  a := [dMon, dTue] + [i]; //<- type mismatch error here. Expectedly sets can be combined
  for i := dMon to dSun do //<-- type mismatch error here. Expectedly enums can be iterated
    a := a + i;
end;

From: "Mason Wheeler"
Newsgroups: remobjects.public.pascalscript

Subject: Re: Label/Goto unsupported?

One more problem.
For whatever reason, declaring labels as you demonstrated in your example
works just fine as long as there's no "uses" clause at the top of the
script. But if there is a "uses", then attempting to declare a label causes
the compiler to raise a "Type Mismatch" exception.
Would you mind looking into this?

Mason

"Carlo Kok [RemObjects Software]" [email protected] wrote in message

Mason Wheeler wrote:

I'm trying to write a scripting engine for a game engine that will be
compatible with another game and able to import its data files.
Unfortunately, the older game's scripting was somewhat primitive and,
lacking support for more advanced control structures, tended to make
heavy use of labels and GOTOs. So now, although we all know that using
them is bad programming, I need a way to support them, for compatibility
reasons. But it seems that PascalScript doesn't support either labels or
the goto command. Am I missing something? If not ,are there any plans
to add support for them?

something like:

Program test;
label A;
begin
a:
writeln('test');
goto a;
end.

works for me.

Carlo Kok

RemObjects Software
The Infrastructure Company
http://www.remobjects.com

[BC23934]

this script shows message "100", but should not

procedure TestProc;
begin
{----}
end;

procedure Button1OnClick(Sender : TObject);
var i: Integer;
begin
i := 0;
while i < 100 do
begin
try
i := i + 1;
exit;
finally
TestProc;
end;
end;
ShowMessage(IntToStr(i));
end;

[BC26768]

Functions with a string return type crash with access violation.
But this belongs only to functions which defined with "AddDelphiFunction"/"RegisterDelphiFunction" (for example: DateToStr()).
Internal functions (for example: IntToStr() / defined with "RegisterFunctionName") works fine.

Point of crash: function x64call() in x64.inc

Hi to all,
I don't know if this is an already available feature but
I would like to know if it's possible to insert in my
pascal code way to say to Unit Importer to exclude a
piece of code.
I'm using a lot of unit code either for normal Delphi program
and either for importing with UnitImporter and use in ROPS.
Unfortunately there is some part of this code like this:
....
const
IID_Memento: TGUID = '{8F50CE52-4311-45A6-A928-CA15E25ED249}';
IID_Persistable: TGUID = '{F66DB7BE-FB3A-4BE1-8A4F-5C438D4D14AA}';
....
that I would like to exclude in unit importing phase because
in ROPS TGUID is a record and not a string. Something like:
{$IFNDEF EXCLUDE_UNIT_IMPORTING}
const
IID_Memento: TGUID = '{8F50CE52-4311-45A6-A928-CA15E25ED249}';
IID_Persistable: TGUID = '{F66DB7BE-FB3A-4BE1-8A4F-5C438D4D14AA}';
{$ENDIF}
so Delphi compile the code but unit importing passes away.
Thank you very much for replies.
Silverio

[BC46289]

Support Int64 for Inc, Dec, Low, and High functions

[BC48314]

Some samples don't work on Linux(Console\sample8)

[BC48941]

60743: Connect pascalscript: array of const

'Now' function returns 0

ide.dpr uses missing files
uFrmGotoLine in 'uFrmGotoLine.pas' {frmGotoLine},
dlgSearchText in 'dlgSearchText.pas' {TextSearchDialog},
dlgConfirmReplace in 'dlgConfirmReplace.pas' {ConfirmReplaceDialog},
dlgReplaceText in 'dlgReplaceText.pas' {TextReplaceDialog};

[BC45782]

program Test;

var f, d: double;
begin
f := 1.0; d := 2.0; f := f + d; // 3 -> Good
writeln(Floattostr(f));
f := 1.0; d := 2.0; f := d + f; // 4 -> Bad
writeln(Floattostr(f));
end.

produces

Compiling
Compiler: Error: Unknown identifier 'writeln'
Compiling failed

[BC53964]

Hello,

Would be nice if the PS accepted the new FOR structure of Free Pascal / XE. E.g.:

var
  s: string;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Add('A');
    sl.Add('B');
    sl.Add('C');
    for s in sl do
      WriteLn(s);
  finally
    sl.Free;
  end;
end;

Issued on: http://bugs.freepascal.org/view.php?id=24859

We get an error:
C:\Program Files (x86)\RemObjects Software\Pascal Script for Delphi\Source\x64.inc(17,34) Error: Identifier not found "IntPtr"

FPC 2.6.1
Lazarus 0.9.31 x64

Should be simple, i think the equivalent of "IntPtr" for FPC is NativeInt but not sure.

Setting callbacks like the OnClick event for script-generated Objects doesn't work on x64.

Ive got a patch here that solves passing "procedure () of object"-types to the respective Property Helpers, but it might only be valid for FPC/Laz.

Seccond thing is, that on x64, calling the event handler endet with empty_method_handler defined in uPSRuntime, and not respective MyAllMethodsHandler was defined for x64.

I don't want to post the patch in here, its rather long (I guess), it's in: http://pastebin.com/c8A81kju

Please note that this is far from perfect, but it worked for me.

This issue is related to #29 and #32.

Under delphi XE2 / windows / x64, the assembly code used to read/write xmm0 is not correct

line 58 movsd xmm0,[_XMM0] register xmm0 end up with the address of the _XMM0 parameter instead of the value.

line 82 movsd [_XMM0],xmm0 adress of parameter _XMM0 is overwritten instead of the value itself.

I'm not proficient enough in assembly to make a patch, but hopefully someone who does will.

Related to:
63927: Pascal Script - Win32 'C/C++' DLL Access With Callback

if we call the DLL passing the address of a Pascal Script procedure
or function we are unable to call it back from within the DLL.

//dll source:

library MyLibrary;

uses
SysUtils,
Classes;

{$R *.res}

type
TCB=procedure();

function DoCallBack(callback:TCB): Integer; cdecl;
begin
callback();
end;

exports DoCallBack;

begin
end.

//exe source

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uPSComponent, uPSCompiler, uPSUtils;

type
TForm1 = class(TForm)
Button1: TButton;
PSScript: TPSScript;
PSDllPlugin1: TPSDllPlugin;
Button2: TButton;
mmScript: TMemo;
mmOutput: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

type
TCB=procedure();
TDoCallBack = function(callback:TCB): Integer; cdecl;

procedure MyCallback;
begin
ShowMessage('Hello');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
l:THandle;
p:TDoCallBack;
begin
l:= LoadLibrary('MyLibrary.dll');
p := GetProcAddress(l, 'DoCallBack');
p(@Mycallback);
FreeLibrary(l);
end;

procedure TForm1.Button2Click(Sender: TObject);
procedure OutputMessages;
var
l: Longint;
b: Boolean;
begin

b := False;

for l := 0 to PSScript.CompilerMessageCount - 1 do
begin
  mmOutput.Lines.Add('Compiler: '+ PSScript.CompilerErrorToStr(l));
  if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
  begin
    b := True;
    //PSScript.SelStart := PSScript.CompilerMessages[l].Pos;
  end;
end;

end;
begin
PSScript.Script.Assign(mmScript.Lines);
mmOutput.Lines.Add('Compiling');
if PSScript.Compile then
begin
OutputMessages;
mmOutput.Lines.Add('Compiled succesfully');
if not PSScript.Execute then
begin
mmOutput.SelStart := PSScript.ExecErrorPosition;
mmOutput.Lines.Add(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'+Inttostr(PSScript.ExecErrorByteCodePosition));
end else mmOutput.Lines.Add('Succesfully executed');
end else
begin
OutputMessages;
mmOutput.Lines.Add('Compiling failed');
end;
end;

end.

PS source:

type

TCB=procedure();

function DoCallBack(callback: TCB) :
integer; external '[email protected] cdecl';

procedure TestCallback();
begin
end;

begin
DoCallback(@TestCallback);
end.

1399: Connect pascalscript: Bug when idispatch is enabled record properties will not work in class

Steps:

Regster type and class for PS like:

TEvResult = record
dblResult : double;
end;

TKomponenta = class(TComponent)
private
fValue: TEvResult;
published
property Value : TEvResult read fValue;
end;

PS code:

program Test;
var
lkomp:TKomponenta;
x:double;

begin
lkomp:=TKomponenta.Create(nil);
x=lkomp.value.dblResult;
end.

Returns Unknown Identifier

TBits methods doesn't work properly

workaround:

uPSR_classes.pas

procedure TBITSSIZE_R(Self: TBITS; var T: INTEGER); begin T := Self.SIZE;end;
procedure TBITSSIZE_W(Self: TBITS; T: INTEGER); begin Self.SIZE := T; end;

[BC51152]

Please apply this small clean up in the FCL package:

http://www.sendspace.com/file/zsibsy

Hello,

Please see this patch:

http://bugs.freepascal.org/file_download.php?file_id=18672&type=bug (issued on: http://bugs.freepascal.org/view.php?id=24855)

It separates core (FCL) of IDE (LCL), turning PS compatible with non-LCL projects too (like console or CGI/fastCGI apps).

Thank you!

PSScript component isn't created on main form

[BC47931]

It happens when used function which returns structure.

type myType = record
myVar: Integer;
end;

function myFunc: myType;
begin
Result.myVar := 1;
end;

begin
if (myFunc.myVar = 1) then Writeln('');
end.

[BC45329]

I found TPSPascalCompiler.OnTranslateLineInfo which works there, and is nice. Downside: when using TPSScript, this is set to nil or an internal handler in TPSScript.Compile. It would be better to not make this event visible outside the units if it is used internally. My workaround here was to patch uPSComponent, and setting it to nil only if it has been set to CompTranslateLineInfo before (used PreProcessor before).

[BC50040]

You can test the limit by:
const
MAXInt64 = $7FFFFFFFFFFFFFFF;

xxl:= 2;
for i:= 1 to 6 do begin
if i <= 5 then xxl:= xxl_xxl
else xxl:= ((xxl)_(xxl div 2)-1);

[BC55336]

x64 calling convention require that the stack pointer stay aligned on a 16 byte boundary. The current code does not enforce that which cause problem with exception handling.

Adding the following check before x64call correct this
if length(Stack) mod 16<>0 then
setlength(Stack,16*((length(Stack) div 16)+1));

program test;

uses
SysUtils, uPSRuntime,uPSCompiler,uPSUtils,uPSDebugger;

// 4 parameters passed in register and 1 of 8 bytes on the stack resulting in a stack frame size not a multiple of 16
procedure DummyFonc(eA : int64;eB : int64;eC : int64;eD : int64;eE : int64);
begin
raise Exception.Create('Error Message'+inttostr(5));
end;

function DoUses(Sender: TPSPascalCompiler; const Name: tbtString): Boolean;
begin
if Name='SYSTEM' then
begin
Sender.AddDelphiFunction('procedure DummyFonc(eA : int64;eB : int64;eC : int64;eD : int64;eE : int64);');
result:=true;
end
else
result:=false;
end;

var
lComp : TPSPascalCompiler;
lExec : TPSCustomDebugExec;
lCode : AnsiString;
begin
lComp:=TPSPascalCompiler.Create;
lComp.OnUses:=DoUses;

lExec:=TPSCustomDebugExec.Create;
if lComp.Compile('begin'+#13#10+'DummyFonc(0,0,0,0,0);'+#13#10+'end.') then
begin
lComp.GetOutput(lCode);
lExec.RegisterDelphiFunction(@DummyFonc,'DummyFonc',cdRegister);
if lExec.LoadData(lCode) then
lExec.RunScript;
end;

Currently, PS does not use the right calling convention under windows x64 when using delphi xe2. defining
{$DEFINE PS_RESBEFOREPARAMETERS}
{$DEFINE x64_string_result_as_varparameter}

seem to do the right things.

The problem might easily be replicated by importing a function returning a unicode string.

I wrote a simple script text with Unicode (Chinese characters: 一二三四) and compile in Delphi XE2/XE3.

The result I got is always "????".

After examine the PascalScript source, I found this method

function TPSPascalCompiler.Compile(const s: tbtString): Boolean;

always translate the script text into AnsiString as TbtString is declared as:

TbtString = {$IFDEF DELPHI2009UP}AnsiString{$ELSE}String{$ENDIF};

Here is my sample source code:

var FValue: WideString;

procedure TForm1.Button1Click(Sender: TObject);
var p: TPSScript;
    sValue: string;
begin
  p := TPSScript.Create(nil);
  try
    sValue := TEncoding.Unicode.GetString(TBytes.Create($00, $4E, $8C, $4E, $09, $4E, $DB, $56));

    p.OnCompile := Self.OnCompile;
    p.OnExecute := Self.OnExecute;
    p.Script.Text :=
    'begin ' +
      Format('v := ''%s'';', [sValue]) +
    'end.';

    if not p.Compile then
      ShowMessage(p.CompilerErrorToStr(0))
    else begin
      if not p.Execute then
        ShowMessage(p.ExecErrorToString)
      else
        ShowMessage(FValue);
    end;
  finally
    p.Free;
  end;
end;

procedure TForm1.OnCompile(Sender: TPSScript);
begin
  Sender.AddRegisteredPTRVariable('v', 'Widestring');
end;

procedure TForm1.OnExecute(Sender: TPSScript);
begin
  Sender.SetPointerToData('v', @FValue, Sender.FindBaseType(btWideString));
end;

RegisterMethod('procedure Error(Ident:Integer)');
should be
RegisterMethod('procedure Error(const Ident: String)');

RegisterMethod('function TokenInt:LongInt');
should be
RegisterMethod('function TokenInt: Int64');

[BC51584]

Hello,

I detected a memory leak in PascalScript. You can see it in this simple project:

program project1;

{$mode objfpc}{$H+}

uses
  heaptrc,
  uPSComponent,
  uPSComponent_Default,
  uPSCompiler,
  sysutils;

type

  { TApp }

  TApp = class
  private
    FPS: TPSScript;
  public
    constructor Create;
    destructor Destroy; override;
    property PS: TPSScript read FPS;
  end;

const
  le = LineEnding;
  SCRIPT =
    'var' + le +
    '  J: TStringList;' + le +
    'begin' + le +
    '  J := TStringList.Create;' + le +
    '  J.Free;' + le +
    'end.';

  { TApp }

  constructor TApp.Create;
  begin
    inherited Create;
    FPS := TPSScript.Create(nil);
  end;

  destructor TApp.Destroy;
  begin
    FPS.Free;
    inherited Destroy;
  end;

var
  I: Integer;
  App: TApp;
  M: TPSPascalCompilerMessage;
  P1, P2: TPSPlugin;
begin
  App := TApp.Create;
  P1 := TPSImport_DateUtils.Create(nil);
  P2 := TPSImport_Classes.Create(nil);
  try
    TPSPluginItem(App.PS.Plugins.Add).Plugin := P1;
    TPSPluginItem(App.PS.Plugins.Add).Plugin := P2;
    App.PS.Script.Text := SCRIPT;
    if App.PS.Compile then
    begin
      for I := 0 to Pred(App.PS.Comp.MsgCount) do
      begin
        M := App.PS.Comp.Msg[I];
        WriteLn(M.MessageToString);
      end;
      if not App.PS.Execute then
        WriteLn(Format('[Runtime error] (%d:%d): %s', [App.PS.ExecErrorRow,
          App.PS.ExecErrorCol, App.PS.ExecErrorToString]));
    end;
  finally
    P1.Free;
    P2.Free;
    App.Free;
  end;
  DeleteFile('HEAP.TRC');
  SetHeapTraceOutput('HEAP.TRC');
end.

You can download the full sample here:

http://www.sendspace.com/file/cs0dqu

And the leak is:

Heap dump by heaptrc unit
6131 memory blocks allocated : 281473/298456
6130 memory blocks freed     : 281464/298440
1 unfreed memory blocks : 9
True heap size : 229376 (96 used in System startup)
True free heap : 229184
Should be : 229200
Call trace for block $02DB3528 size 9
  $004673AF  CLASSCALLPROCCONSTRUCTOR,  line 10213 of uPSRuntime.pas
  $0046006B  TPSEXEC__RUNSCRIPT,  line 7844 of uPSRuntime.pas
  $0041432B  TPSSCRIPT__EXECUTE,  line 678 of uPSComponent.pas
  $0040199D  main,  line 69 of project1.lpr
  $0040FFCB
  $0041456A  TPSSCRIPT__SCRIPTUSES,  line 771 of uPSComponent.pas
  $0041395D  COMPSCRIPTUSES,  line 426 of uPSComponent.pas
  $0042CCBB  TPSPASCALCOMPILER__COMPILE,  line 11917 of uPSCompiler.pas

I'm trying to fix it, but, without success.

Thank you!

Hello,

I'm trying to register a pointer in my compiler:

  CL.AddTypeS('TJSONCharType', 'string');
  CL.AddTypeS('PJSONCharType', '^TJSONCharType');

But it returns "Unable to register type PJSONCharType".

So, can I register a pointer in my compiler?

Thank you!

PS doesn't support BCD variant type

a workaround:

uPSRuntime.pas
function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; CalcType: Cardinal): Boolean;
............
begin
if VarIsFloat(variant(var1^)) or VarIsFMTBcd(variant(var1^)) then //<==fixed
Variant(var1^) := Variant(var1^) / tvar
else
Variant(var1^) := Variant(var1^) div tvar;

[BC47467]

In function uPSRuntime.InitializeVariant btSingle, bts32 and btU32 variables are initialized with Pointer(P^) := nil; in x64, this cause to write data past the end of allocated memory. Line 1773 should be btSingle, bts32, btU32: tbtu32(p^) := 0;

Hi!
Windows 64 bit platform: if you import a function returning a double value and use it in a script, the function will always returns 0 as result.
Same behaviour calling the functions Date or Now of the uPSR_dateutils unit.

Domenico

User wants to import interface

procedure SIRegister_IXMLNode(CL: TPSPascalCompiler);
begin
with CL.AddInterface(CL.FindInterface('IUNKNOWN'),IXMLNode, 'IXMLNode') do
begin
RegisterMethod('Function GetAttribute( const AttrName : DOMString) : OleVariant', cdRegister);
RegisterMethod('Function GetAttributeNodes : IXMLNodeList', cdRegister);
etc...
RegisterMethod('Procedure SetAttribute( const AttrName : DOMString; const Value : OleVariant)', cdRegister);

AV when assign a new event to TDataSet.OnNewRecord

PascalScript
procedure TestNew(DataSet: TDataSet);
begin
end;

begin
MyDataSet.OnNewRecord := @testnew;
end.

Delphi Code
procedure TForm1.PSScript1Compile(Sender: TPSScript);
begin
Sender.AddRegisteredVariable('MyDataSet', 'TDataSet');
end;

procedure TForm1.PSScript1Execute(Sender: TPSScript);
begin
Sender.SetVarToInstance('MyDataSet', ClientDataSet1);
end;

[BC43588]