moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

Updated PascalScript

Browse Source
This commit is contained in:
Raymond 2010-05-18 18:53:11 +02:00
parent 2cfd77c490
commit a4c7c30e77
6 changed files with 56 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Units/PascalScript/uPSC_graphics.pas
View File

@ -261,7 +261,7 @@ end;
procedure SIRegisterTPicture(CL: TPSPascalCompiler);
begin
with TPSCompileTimeClass(CL.AddClassN(CL.FindClass('TPersistent'),'TPicture')) do
with CL.AddClassN(CL.FindClass('TPersistent'),'TPicture') do
begin
RegisterProperty('Bitmap','TBitmap',iptrw);
end;

34
Units/PascalScript/uPSComponent.pas
View File

@ -87,9 +87,9 @@ type
TPSEvent = procedure (Sender: TPSScript) of object;
TPSOnCompImport = procedure (Sender: TObject; x: TPSPascalCompiler) of object;
TPSOnCompImportEvent = procedure (Sender: TObject; x: TPSPascalCompiler) of object;
TPSOnExecImport = procedure (Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter) of object;
TPSOnExecImportEvent = procedure (Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter) of object;
{Script engine event function}
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
@ -113,8 +113,8 @@ type
FOnLine: TNotifyEvent;
FUseDebugInfo: Boolean;
FOnAfterExecute, FOnCompile, FOnExecute: TPSEvent;
FOnCompImport: TPSOnCompImport;
FOnExecImport: TPSOnExecImport;
FOnCompImport: TPSOnCompImportEvent;
FOnExecImport: TPSOnExecImportEvent;
RI: TPSRuntimeClassImporter;
FPlugins: TPSPlugins;
FPP: TPSPreProcessor;
@ -271,9 +271,9 @@ type
property OnAfterExecute: TPSEvent read FOnAfterExecute write FOnAfterExecute;
property OnCompImport: TPSOnCompImport read FOnCompImport write FOnCompImport;
property OnCompImport: TPSOnCompImportEvent read FOnCompImport write FOnCompImport;
property OnExecImport: TPSOnExecImport read FOnExecImport write FOnExecImport;
property OnExecImport: TPSOnExecImportEvent read FOnExecImport write FOnExecImport;
property UseDebugInfo: Boolean read FUseDebugInfo write FUseDebugInfo default True;
@ -367,14 +367,14 @@ type
TIFPS3DebugCompExec = class(TPSScriptDebugger);
TPSCustumPlugin = class(TPSPlugin)
TPSCustomPlugin = class(TPSPlugin)
private
FOnCompileImport2: TPSEvent;
FOnExecOnUses: TPSEvent;
FOnCompOnUses: TPSEvent;
FOnCompileImport1: TPSEvent;
FOnExecImport1: TPSOnExecImport;
FOnExecImport2: TPSOnExecImport;
FOnExecImport1: TPSOnExecImportEvent;
FOnExecImport2: TPSOnExecImportEvent;
public
procedure CompOnUses(CompExec: TPSScript); override;
procedure ExecOnUses(CompExec: TPSScript); override;
@ -389,8 +389,8 @@ type
property OnExecOnUses: TPSEvent read FOnExecOnUses write FOnExecOnUses;
property OnCompileImport1: TPSEvent read FOnCompileImport1 write FOnCompileImport1;
property OnCompileImport2: TPSEvent read FOnCompileImport2 write FOnCompileImport2;
property OnExecImport1: TPSOnExecImport read FOnExecImport1 write FOnExecImport1;
property OnExecImport2: TPSOnExecImport read FOnExecImport2 write FOnExecImport2;
property OnExecImport1: TPSOnExecImportEvent read FOnExecImport1 write FOnExecImport1;
property OnExecImport2: TPSOnExecImportEvent read FOnExecImport2 write FOnExecImport2;
end;
implementation
@ -1459,7 +1459,7 @@ begin
end;
{ TPSCustomPlugin }
procedure TPSCustumPlugin.CompileImport1(CompExec: TPSScript);
procedure TPSCustomPlugin.CompileImport1(CompExec: TPSScript);
begin
IF @FOnCompileImport1 <> nil then
FOnCompileImport1(CompExec)
@ -1467,7 +1467,7 @@ begin
inherited;
end;
procedure TPSCustumPlugin.CompileImport2(CompExec: TPSScript);
procedure TPSCustomPlugin.CompileImport2(CompExec: TPSScript);
begin
IF @FOnCompileImport2 <> nil then
FOnCompileImport2(CompExec)
@ -1475,7 +1475,7 @@ begin
inherited;
end;
procedure TPSCustumPlugin.CompOnUses(CompExec: TPSScript);
procedure TPSCustomPlugin.CompOnUses(CompExec: TPSScript);
begin
IF @FOnCompOnUses <> nil then
FOnCompOnUses(CompExec)
@ -1483,7 +1483,7 @@ begin
inherited;
end;
procedure TPSCustumPlugin.ExecImport1(CompExec: TPSScript;
procedure TPSCustomPlugin.ExecImport1(CompExec: TPSScript;
const ri: TPSRuntimeClassImporter);
begin
IF @FOnExecImport1 <> nil then
@ -1492,7 +1492,7 @@ begin
inherited;
end;
procedure TPSCustumPlugin.ExecImport2(CompExec: TPSScript;
procedure TPSCustomPlugin.ExecImport2(CompExec: TPSScript;
const ri: TPSRuntimeClassImporter);
begin
IF @FOnExecImport2 <> nil then
@ -1501,7 +1501,7 @@ begin
inherited;
end;
procedure TPSCustumPlugin.ExecOnUses(CompExec: TPSScript);
procedure TPSCustomPlugin.ExecOnUses(CompExec: TPSScript);
begin
IF @FOnExecOnUses <> nil then
FOnExecOnUses(CompExec)

3
Units/PascalScript/uPSR_extctrls.pas
View File

@ -100,11 +100,14 @@ begin
end;
procedure TNoteBookPageCount_R(Self: TNoteBook; var T: INTEGER); begin T := Self.PageCount; end;
procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
begin
with Cl.Add(TNOTEBOOK) do
begin
{$IFDEF FPC}
RegisterMethod(@TNoteBook.TabIndexAtClientPos,'TABINDEXATCLIENTPOS');
{$ENDIF}
RegisterPropertyHelper(@TNoteBookPageCount_R,nil,'PAGECOUNT');
end;
end;

1
Units/PascalScript/uPSR_graphics.pas
View File

@ -74,6 +74,7 @@ begin
RegisterMethod(@TCanvasEllipse, 'ELLIPSE');
RegisterMethod(@TCanvasFillRect, 'FILLRECT');
// RegisterMethod(@TCanvasDraw, 'DRAW');
{$IFNDEF CLX}
RegisterMethod(@TCanvasFloodFill, 'FLOODFILL');
{$ENDIF}

52
Units/PascalScript/uPSRuntime.pas
View File

@ -1539,7 +1539,7 @@ begin
{$IFNDEF PS_NOWIDESTRING}
tkWString: begin Result := ''''+tbtString(GetWideStrProp(Instance, pp))+''; end;
{$IFDEF DELPHI2009UP}
tkUString: begin Result := ''''+tbtUnicodeString(GetUnicodeStrProp(Instance, pp))+''; end;
tkUString: begin Result := ''''+tbtString(GetUnicodeStrProp(Instance, pp))+''; end;
{$ENDIF}
{$ENDIF}
{$ENDIF}
@ -3988,6 +3988,10 @@ begin
begin
for i := 0 to Len -1 do
begin
if Pointer(Dest^) <> nil then
begin
PSDynArraySetLength(Pointer(Dest^), aType, 0);
end;
Pointer(Dest^) := Pointer(Src^);
if Pointer(Dest^) <> nil then
begin
@ -4574,19 +4578,19 @@ begin
if Tmp is EDivByZero then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EZeroDivide then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EMathError then
begin
Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
end;
@ -5265,19 +5269,19 @@ begin
if Tmp is EDivByZero then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EZeroDivide then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EMathError then
begin
Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
end;
@ -6283,19 +6287,19 @@ begin
if Tmp is EDivByZero then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EZeroDivide then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EMathError then
begin
Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError,tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
end;
@ -7181,19 +7185,19 @@ begin
if Tmp is EDivByZero then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EZeroDivide then
begin
Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
if Tmp is EMathError then
begin
Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit;
end;
end;
@ -7830,17 +7834,17 @@ begin
end else
if Tmp is EDivByZero then
begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Break;
end;
if Tmp is EZeroDivide then
begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Break;
end;
if Tmp is EMathError then
begin
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Break;
end;
end;
@ -8516,17 +8520,17 @@ begin
end else
if Tmp is EDivByZero then
begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
break;
end;
if Tmp is EZeroDivide then
begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
break;
end;
if Tmp is EMathError then
begin
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
break;
end;
end;
@ -8794,12 +8798,12 @@ begin
12:
{$IFNDEF PS_NOWIDESTRING}
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
Stack.SetUnicodeString(-1, SysUtils.Trim(Stack.GetUnicodestring(-2))) // Uppercase
Stack.SetUnicodeString(-1, SysUtils.Trim(Stack.GetUnicodestring(-2))) // Trim
else if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
Stack.SetWideString(-1, SysUtils.Trim(Stack.GetWideString(-2))) // Uppercase
Stack.SetWideString(-1, SysUtils.Trim(Stack.GetWideString(-2))) // Trim
else
{$ENDIF}
Stack.SetAnsiString(-1, SysUtils.Trim(Stack.GetAnsiString(-2)));// Trim
Stack.SetAnsiString(-1, AnsiString(SysUtils.Trim(String(Stack.GetAnsiString(-2)))));// Trim
13: Stack.SetInt(-1, Length(Stack.GetAnsiString(-2))); // Length
14: // SetLength
begin
@ -10123,7 +10127,7 @@ begin
v := NewPPSVariantIFC(Stack[CurrStack + 1], True);
end else v := nil;
try
Result := Caller.InnerfuseCall(FSelf, p.Ext1, TPSCallingConvention(Integer(cc) or 64), MyList, v);
Result := Caller.InnerfuseCall(FSelf, p.Ext1, {$IFDEF FPC}TPSCallingConvention(Integer(cc) or 64){$ELSE}cc{$ENDIF}, MyList, v);
finally
DisposePPSVariantIFC(v);
DisposePPSVariantIFCList(mylist);
@ -10208,7 +10212,7 @@ begin
v := NewPPSVariantIFC(Stack[CurrStack + 1], True);
end else v := nil;
try
Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), TPSCallingConvention(Integer(cc) or 128), MyList, v);
Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), {$IFDEF FPC}TPSCallingConvention(Integer(cc) or 128){$ELSE}cc{$ENDIF}, MyList, v);
finally
DisposePPSVariantIFC(v);
DisposePPSVariantIFCList(mylist);

23
Units/PascalScript/x86.inc
View File

@ -503,28 +503,18 @@ var
Result := True;
end;
begin
if (Integer(CallingConv) and 128) <> 0 then
begin
{$ifdef FPC}
{$IFDEF FPC}
if (Integer(CallingConv) and 128) <> 0 then begin
IsVirtualCons := true;
{$endif}
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 128);
end else
begin
{$ifdef FPC}
IsVirtualCons:= false
{$endif}
end;
IsVirtualCons:= false;
if (Integer(CallingConv) and 64) <> 0 then begin
{$IFDEF FPC}
IsConstructor := true;
{$ENDIF}
IsConstructor := true;
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
end else begin
{$IFDEF FPC}
end else
IsConstructor := false;
{$ENDIF}
end;
{$ENDIF}
InnerfuseCall := False;
if Address = nil then
exit; // need address
@ -592,7 +582,6 @@ begin
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil)
else
{$ENDIF}
// {$ELSE}
tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX,
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
end;