paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 07:29:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

PascalScript: fix using cardinal for object refs in some places

Browse Source 
git-svn-id: trunk@39434 -
This commit is contained in:
martin 2012-12-03 17:12:14 +00:00
parent 8100d1d064
commit 8e76ad219a
1 changed files with 28 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
components/PascalScript/Source/uPSCompiler.pas
View File

@ -1504,18 +1504,18 @@ type
function CastToType(IntoType: TPSType; var ProcNo: Cardinal): Boolean;
function Property_Find(const Name: tbtString; var Index: IPointer): Boolean;
function Property_Find(const Name: tbtString; var Index: TPSDelphiClassItem): Boolean;
function Property_Get(Index: IPointer; var ProcNo: Cardinal): Boolean;
function Property_Get(Index: TPSDelphiClassItem; var ProcNo: Cardinal): Boolean;
function Property_Set(Index: IPointer; var ProcNo: Cardinal): Boolean;
function Property_Set(Index: TPSDelphiClassItem; var ProcNo: Cardinal): Boolean;
function Property_GetHeader(Index: IPointer; Dest: TPSParametersDecl): Boolean;
function Property_GetHeader(Index: TPSDelphiClassItem; Dest: TPSParametersDecl): Boolean;
function Func_Find(const Name: tbtString; var Index: IPointer): Boolean;
function Func_Find(const Name: tbtString; var Index: TPSDelphiClassItem): Boolean;
function Func_Call(Index: IPointer; var ProcNo: Cardinal): Boolean;
function Func_Call(Index: TPSDelphiClassItem; var ProcNo: Cardinal): Boolean;
function ClassFunc_Find(const Name: tbtString; var Index: IPointer): Boolean;
@ -1576,6 +1576,8 @@ type
{$IFNDEF PS_NOINTERFACES}
TPSInterfaceMethod = class;
TPSInterface = class(TObject)
private
FOwner: TPSPascalCompiler;
@ -1617,9 +1619,9 @@ type
function CastToType(IntoType: TPSType; var ProcNo: Cardinal): Boolean;
function Func_Find(const Name: tbtString; var Index: Cardinal): Boolean;
function Func_Find(const Name: tbtString; var Index: TPSInterfaceMethod): Boolean;
function Func_Call(Index: Cardinal; var ProcNo: Cardinal): Boolean;
function Func_Call(Index: TPSInterfaceMethod; var ProcNo: Cardinal): Boolean;
end;
@ -6793,7 +6795,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
Tempp: TPSValue;
aType: TPSClassType;
procno: Cardinal;
Idx: IPointer;
Idx: TPSDelphiClassItem;
Decl: TPSParametersDecl;
begin
if p = nil then exit;
@ -6929,7 +6931,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
procedure CheckClass(var P: TPSValue; const VarType: TPSVariableType; VarNo: Cardinal; ImplicitPeriod: Boolean);
var
Procno: Cardinal;
Idx: IPointer;
Idx: TPSDelphiClassItem;
FType: TPSType;
TempP: TPSValue;
Decl: TPSParametersDecl;
@ -14575,7 +14577,7 @@ begin
end;
function TPSCompileTimeClass.Func_Call(Index: IPointer;
function TPSCompileTimeClass.Func_Call(Index: TPSDelphiClassItem;
var ProcNo: Cardinal): Boolean;
var
C: TPSDelphiClassItemMethod;
@ -14584,7 +14586,7 @@ var
s: tbtString;
begin
C := Pointer(Index);
C := Index as TPSDelphiClassItemMethod;
if c.MethodNo = InvalidVal then
begin
ProcNo := FOwner.AddUsedFunction2(P);
@ -14612,7 +14614,7 @@ begin
end;
function TPSCompileTimeClass.Func_Find(const Name: tbtString;
var Index: IPointer): Boolean;
var Index: TPSDelphiClassItem): Boolean;
var
H: Longint;
I: Longint;
@ -14628,7 +14630,7 @@ begin
C := CurrClass.FClassItems[I];
if (c is TPSDelphiClassItemMethod) and (C.NameHash = H) and (C.Name = Name) then
begin
Index := Cardinal(C);
Index := C;
Result := True;
exit;
end;
@ -14671,7 +14673,7 @@ begin
end;
function TPSCompileTimeClass.Property_Find(const Name: tbtString;
var Index: IPointer): Boolean;
var Index: TPSDelphiClassItem): Boolean;
var
H: Longint;
I: Longint;
@ -14685,7 +14687,7 @@ begin
begin
if CurrClass.FDefaultProperty <> InvalidVal then
begin
Index := Cardinal(CurrClass.FClassItems[Currclass.FDefaultProperty]);
Index := TPSDelphiClassItem(CurrClass.FClassItems[Currclass.FDefaultProperty]);
result := True;
exit;
end;
@ -14703,7 +14705,7 @@ begin
C := CurrClass.FClassItems[I];
if (c is TPSDelphiClassItemProperty) and (C.NameHash = H) and (C.Name = Name) then
begin
Index := Cardinal(C);
Index := C;
Result := True;
exit;
end;
@ -14713,7 +14715,7 @@ begin
Result := False;
end;
function TPSCompileTimeClass.Property_Get(Index: IPointer;
function TPSCompileTimeClass.Property_Get(Index: TPSDelphiClassItem;
var ProcNo: Cardinal): Boolean;
var
C: TPSDelphiClassItemProperty;
@ -14721,7 +14723,7 @@ var
s: tbtString;
begin
C := Pointer(Index);
C := Index as TPSDelphiClassItemProperty;
if c.AccessType = iptW then
begin
Result := False;
@ -14743,18 +14745,18 @@ begin
Result := True;
end;
function TPSCompileTimeClass.Property_GetHeader(Index: IPointer;
function TPSCompileTimeClass.Property_GetHeader(Index: TPSDelphiClassItem;
Dest: TPSParametersDecl): Boolean;
var
c: TPSDelphiClassItemProperty;
begin
C := Pointer(Index);
C := Index as TPSDelphiClassItemProperty;
FOwner.UseProc(c.Decl);
Dest.Assign(c.Decl);
Result := True;
end;
function TPSCompileTimeClass.Property_Set(Index: IPointer;
function TPSCompileTimeClass.Property_Set(Index: TPSDelphiClassItem;
var ProcNo: Cardinal): Boolean;
var
C: TPSDelphiClassItemProperty;
@ -14762,7 +14764,7 @@ var
s: tbtString;
begin
C := Pointer(Index);
C := Index as TPSDelphiClassItemProperty;
if c.AccessType = iptR then
begin
Result := False;
@ -15424,7 +15426,7 @@ begin
inherited Destroy;
end;
function TPSInterface.Func_Call(Index: Cardinal;
function TPSInterface.Func_Call(Index: TPSInterfaceMethod;
var ProcNo: Cardinal): Boolean;
var
c: TPSInterfaceMethod;
@ -15462,7 +15464,7 @@ begin
end;
function TPSInterface.Func_Find(const Name: tbtString;
var Index: Cardinal): Boolean;
var Index: TPSInterfaceMethod): Boolean;
var
H: Longint;
I: Longint;
@ -15478,7 +15480,7 @@ begin
C := CurrClass.FItems[I];
if (C.NameHash = H) and (C.Name = Name) then
begin
Index := Cardinal(c);
Index := c;
Result := True;
exit;
end;