From a4c7c30e7711b82336bb332c19b5648992c4216a Mon Sep 17 00:00:00 2001 From: Raymond Date: Tue, 18 May 2010 18:53:11 +0200 Subject: [PATCH] Updated PascalScript --- Units/PascalScript/uPSC_graphics.pas | 2 +- Units/PascalScript/uPSComponent.pas | 34 +++++++++--------- Units/PascalScript/uPSR_extctrls.pas | 3 ++ Units/PascalScript/uPSR_graphics.pas | 1 + Units/PascalScript/uPSRuntime.pas | 52 +++++++++++++++------------- Units/PascalScript/x86.inc | 23 ++++-------- 6 files changed, 56 insertions(+), 59 deletions(-) diff --git a/Units/PascalScript/uPSC_graphics.pas b/Units/PascalScript/uPSC_graphics.pas index 56f8b21..03033b3 100644 --- a/Units/PascalScript/uPSC_graphics.pas +++ b/Units/PascalScript/uPSC_graphics.pas @@ -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; diff --git a/Units/PascalScript/uPSComponent.pas b/Units/PascalScript/uPSComponent.pas index f302c29..efb9bab 100644 --- a/Units/PascalScript/uPSComponent.pas +++ b/Units/PascalScript/uPSComponent.pas @@ -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) diff --git a/Units/PascalScript/uPSR_extctrls.pas b/Units/PascalScript/uPSR_extctrls.pas index 78105e2..c332bf5 100644 --- a/Units/PascalScript/uPSR_extctrls.pas +++ b/Units/PascalScript/uPSR_extctrls.pas @@ -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; diff --git a/Units/PascalScript/uPSR_graphics.pas b/Units/PascalScript/uPSR_graphics.pas index 4ad4a13..4128806 100644 --- a/Units/PascalScript/uPSR_graphics.pas +++ b/Units/PascalScript/uPSR_graphics.pas @@ -74,6 +74,7 @@ begin RegisterMethod(@TCanvasEllipse, 'ELLIPSE'); RegisterMethod(@TCanvasFillRect, 'FILLRECT'); // RegisterMethod(@TCanvasDraw, 'DRAW'); + {$IFNDEF CLX} RegisterMethod(@TCanvasFloodFill, 'FLOODFILL'); {$ENDIF} diff --git a/Units/PascalScript/uPSRuntime.pas b/Units/PascalScript/uPSRuntime.pas index 0790bf6..bfab280 100644 --- a/Units/PascalScript/uPSRuntime.pas +++ b/Units/PascalScript/uPSRuntime.pas @@ -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); diff --git a/Units/PascalScript/x86.inc b/Units/PascalScript/x86.inc index e88053e..6de1284 100644 --- a/Units/PascalScript/x86.inc +++ b/Units/PascalScript/x86.inc @@ -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;