paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 17:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

PascalScript: Added "internal" (none-native) calling for object methods

Browse Source 
git-svn-id: trunk@61895 -
This commit is contained in:
martin 2019-09-17 20:21:36 +00:00
parent 6516a8c105
commit af0f513110
1 changed files with 83 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
components/PascalScript/Source/uPSRuntime.pas
View File

@ -511,6 +511,8 @@ type
5: (PointerInList2: Pointer);
6: (); {Property helper, like 3}
7: (); {Property helper that will pass it's name}
8: (ProcPtr: TPSProcPtr; Ext1, Ext2: Pointer);
9: (ReadProcPtr, WriteProcPtr: TPSProcPtr; ExtRead1, ExtRead2, ExtWrite1, ExtWrite2: Pointer); {Property Helper}
end;
@ -992,6 +994,8 @@ type
property Exec: TPSExec read FExec;
end;
{ TPSRuntimeClass }
TPSRuntimeClass = class
protected
FClassName: tbtstring;
@ -1009,6 +1013,8 @@ type
procedure RegisterMethod(ProcPtr: Pointer; const Name: tbtstring);
procedure RegisterMethodName(const Name: tbtstring; ProcPtr: TPSProcPtr; Ext1, Ext2: Pointer);
procedure RegisterVirtualMethod(ProcPtr: Pointer; const Name: tbtstring);
procedure RegisterVirtualAbstractMethod(ClassDef: TClass; ProcPtr: Pointer; const Name: tbtstring);
@ -1017,6 +1023,12 @@ type
procedure RegisterPropertyHelperName(ReadFunc, WriteFunc: Pointer; const Name: tbtstring);
procedure RegisterPropertyNameHelper(const Name: tbtstring; ProcPtr: TPSProcPtr;
ExtRead1, ExtRead2, ExtWrite1, ExtWrite2: Pointer); overload;
procedure RegisterPropertyNameHelper(const Name: tbtstring; ProcReadPtr, ProcWritePtr: TPSProcPtr;
ExtRead1, ExtRead2, ExtWrite1, ExtWrite2: Pointer); overload;
procedure RegisterEventPropertyHelper(ReadFunc, WriteFunc: Pointer; const Name: tbtstring);
constructor Create(aClass: TClass; const AName: tbtstring);
@ -11118,6 +11130,26 @@ begin
if p.Ext2 = nil then begin result := false; exit; end;
end;
end;
8:
begin
p.ProcPtr := px^.ProcPtr;
p.Ext1 := px^.Ext1;
p.Ext2 := px^.Ext2;
end;
9:
begin
if IsRead then
begin
p.ProcPtr := px^.ReadProcPtr;
p.Ext1 := px^.ExtRead1;
p.Ext2 := px^.ExtRead2;
end else
begin
p.ProcPtr := px^.WriteProcPtr;
p.Ext1 := px^.ExtWrite1;
p.Ext2 := px^.ExtWrite2;
end;
end;
else
begin
result := false;
@ -11413,6 +11445,20 @@ begin
FClassItems.Add(p);
end;
procedure TPSRuntimeClass.RegisterMethodName(const Name: tbtstring;
ProcPtr: TPSProcPtr; Ext1, Ext2: Pointer);
var
P: PClassItem;
begin
New(P);
p^.FName := FastUppercase(Name);
p^.FNameHash := MakeHash(p^.FName);
p^.b := 8;
p^.ProcPtr := ProcPtr;
p^.Ext1 := Ext1;
p^.Ext2 := Ext2;
FClassItems.Add(p);
end;
procedure TPSRuntimeClass.RegisterPropertyHelper(ReadFunc,
WriteFunc: Pointer; const Name: tbtString);
@ -11482,6 +11528,43 @@ begin
FClassItems.Add(p);
end;
procedure TPSRuntimeClass.RegisterPropertyNameHelper(const Name: tbtstring;
ProcPtr: TPSProcPtr; ExtRead1, ExtRead2, ExtWrite1, ExtWrite2: Pointer);
var
P: PClassItem;
begin
New(P);
p^.FName := FastUppercase(Name);
p^.FNameHash := MakeHash(p^.FName);
p^.b := 9;
p^.ReadProcPtr := ProcPtr;
p^.WriteProcPtr := ProcPtr;
p^.ExtRead1 := ExtRead1;
p^.ExtRead2 := ExtRead2;
p^.ExtWrite1 := ExtWrite1;
p^.ExtWrite2 := ExtWrite2;
FClassItems.Add(p);
end;
procedure TPSRuntimeClass.RegisterPropertyNameHelper(const Name: tbtstring;
ProcReadPtr, ProcWritePtr: TPSProcPtr; ExtRead1, ExtRead2, ExtWrite1,
ExtWrite2: Pointer);
var
P: PClassItem;
begin
New(P);
p^.FName := FastUppercase(Name);
p^.FNameHash := MakeHash(p^.FName);
p^.b := 9;
p^.ReadProcPtr := ProcReadPtr;
p^.WriteProcPtr := ProcWritePtr;
p^.ExtRead1 := ExtRead1;
p^.ExtRead2 := ExtRead2;
p^.ExtWrite1 := ExtWrite1;
p^.ExtWrite2 := ExtWrite2;
FClassItems.Add(p);
end;
{ TPSRuntimeClassImporter }
function TPSRuntimeClassImporter.Add(aClass: TClass): TPSRuntimeClass;