moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-16 14:25:02 -05: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); procedure SIRegisterTPicture(CL: TPSPascalCompiler);
begin begin
with TPSCompileTimeClass(CL.AddClassN(CL.FindClass('TPersistent'),'TPicture')) do with CL.AddClassN(CL.FindClass('TPersistent'),'TPicture') do
begin begin
RegisterProperty('Bitmap','TBitmap',iptrw); RegisterProperty('Bitmap','TBitmap',iptrw);
end; end;

34
Units/PascalScript/uPSComponent.pas
View File

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

3
Units/PascalScript/uPSR_extctrls.pas
View File

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

1
Units/PascalScript/uPSR_graphics.pas
View File

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

52
Units/PascalScript/uPSRuntime.pas
View File

@ -1539,7 +1539,7 @@ begin
{$IFNDEF PS_NOWIDESTRING} {$IFNDEF PS_NOWIDESTRING}
tkWString: begin Result := ''''+tbtString(GetWideStrProp(Instance, pp))+''; end; tkWString: begin Result := ''''+tbtString(GetWideStrProp(Instance, pp))+''; end;
{$IFDEF DELPHI2009UP} {$IFDEF DELPHI2009UP}
tkUString: begin Result := ''''+tbtUnicodeString(GetUnicodeStrProp(Instance, pp))+''; end; tkUString: begin Result := ''''+tbtString(GetUnicodeStrProp(Instance, pp))+''; end;
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
@ -3988,6 +3988,10 @@ begin
begin begin
for i := 0 to Len -1 do for i := 0 to Len -1 do
begin begin
if Pointer(Dest^) <> nil then
begin
PSDynArraySetLength(Pointer(Dest^), aType, 0);
end;
Pointer(Dest^) := Pointer(Src^); Pointer(Dest^) := Pointer(Src^);
if Pointer(Dest^) <> nil then if Pointer(Dest^) <> nil then
begin begin
@ -4574,19 +4578,19 @@ begin
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
Result := False; Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
end; end;
@ -5265,19 +5269,19 @@ begin
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
Result := False; Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
end; end;
@ -6283,19 +6287,19 @@ begin
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
Result := False; Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError,tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
end; end;
@ -7181,19 +7185,19 @@ begin
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
Result := False; Result := False;
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
Result := False; Result := False;
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Exit; Exit;
end; end;
end; end;
@ -7830,17 +7834,17 @@ begin
end else end else
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Break; Break;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
Break; Break;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
Break; Break;
end; end;
end; end;
@ -8516,17 +8520,17 @@ begin
end else end else
if Tmp is EDivByZero then if Tmp is EDivByZero then
begin begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
break; break;
end; end;
if Tmp is EZeroDivide then if Tmp is EZeroDivide then
begin begin
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp); CMD_Err3(erDivideByZero, tbtString(Exception(Tmp).Message), Tmp);
break; break;
end; end;
if Tmp is EMathError then if Tmp is EMathError then
begin begin
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp); CMD_Err3(erMathError, tbtString(Exception(Tmp).Message), Tmp);
break; break;
end; end;
end; end;
@ -8794,12 +8798,12 @@ begin
12: 12:
{$IFNDEF PS_NOWIDESTRING} {$IFNDEF PS_NOWIDESTRING}
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then 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 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 else
{$ENDIF} {$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 13: Stack.SetInt(-1, Length(Stack.GetAnsiString(-2))); // Length
14: // SetLength 14: // SetLength
begin begin
@ -10123,7 +10127,7 @@ begin
v := NewPPSVariantIFC(Stack[CurrStack + 1], True); v := NewPPSVariantIFC(Stack[CurrStack + 1], True);
end else v := nil; end else v := nil;
try 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 finally
DisposePPSVariantIFC(v); DisposePPSVariantIFC(v);
DisposePPSVariantIFCList(mylist); DisposePPSVariantIFCList(mylist);
@ -10208,7 +10212,7 @@ begin
v := NewPPSVariantIFC(Stack[CurrStack + 1], True); v := NewPPSVariantIFC(Stack[CurrStack + 1], True);
end else v := nil; end else v := nil;
try 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 finally
DisposePPSVariantIFC(v); DisposePPSVariantIFC(v);
DisposePPSVariantIFCList(mylist); DisposePPSVariantIFCList(mylist);

23
Units/PascalScript/x86.inc
View File

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