paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 03:42:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

PascalScript: import updates from original

Browse Source 
git-svn-id: trunk@40115 -
This commit is contained in:
martin 2013-02-01 21:39:51 +00:00
parent 812eac65ea
commit bce1d81e62
5 changed files with 57 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/PascalScript/Source/pascalscript.lpk
View File

@ -9,6 +9,15 @@
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Parsing>
<SyntaxOptions>
<DelphiCompat Value="True"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other> <Other>
<Verbosity> <Verbosity>
<ShowHints Value="False"/> <ShowHints Value="False"/>

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

@ -7072,7 +7072,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
{$IFNDEF PS_NOIDISPATCH} {$IFNDEF PS_NOIDISPATCH}
procedure CheckIntf(var P: TPSValue; const VarType: TPSVariableType; VarNo: Cardinal; ImplicitPeriod: Boolean); procedure CheckIntf(var P: TPSValue; const VarType: TPSVariableType; VarNo: Cardinal; ImplicitPeriod: Boolean);
var var
Procno, Idx: Cardinal; Procno: Cardinal;
Idx: TPSInterfaceMethod;
FType: TPSType; FType: TPSType;
s: tbtString; s: tbtString;
@ -12962,6 +12963,11 @@ procedure TPSPascalCompiler.DefineStandardProcedures;
var var
p: TPSRegProc; p: TPSRegProc;
begin begin
{ The following needs to be in synch in these 3 functions:
-UPSCompiler.TPSPascalCompiler.DefineStandardProcedures
-UPSRuntime.DefProc
-UPSRuntime.TPSExec.RegisterStandardProcs
}
{$IFNDEF PS_NOINT64} {$IFNDEF PS_NOINT64}
AddFunction('function IntToStr(i: Int64): String;'); AddFunction('function IntToStr(i: Int64): String;');
{$ELSE} {$ELSE}
@ -13107,6 +13113,7 @@ begin
{$IFNDEF PS_NOINT64} {$IFNDEF PS_NOINT64}
AddFunction('function StrToInt64(s: String): int64;'); AddFunction('function StrToInt64(s: String): int64;');
AddFunction('function Int64ToStr(i: Int64): String;'); AddFunction('function Int64ToStr(i: Int64): String;');
AddFunction('function StrToInt64Def(s: String; def: int64): int64;');
{$ENDIF} {$ENDIF}
with AddFunction('function SizeOf: Longint;').Decl.AddParam do with AddFunction('function SizeOf: Longint;').Decl.AddParam do

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

@ -8709,8 +8709,13 @@ var
pex: TPSExceptionHandler; pex: TPSExceptionHandler;
Tmp: TObject; Tmp: TObject;
begin begin
{ The following needs to be in synch in these 3 functions:
-UPSCompiler.TPSPascalCompiler.DefineStandardProcedures
-UPSRuntime.DefProc
-UPSRuntime.TPSExec.RegisterStandardProcs
}
case Longint(p.Ext1) of case Longint(p.Ext1) of
0: Stack.SetAnsiString(-1, IntToStr(Stack.{$IFNDEF PS_NOINT64}GetInt64{$ELSE}GetInt{$ENDIF}(-2))); // inttostr 0: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.{$IFNDEF PS_NOINT64}GetInt64{$ELSE}GetInt{$ENDIF}(-2)))); // inttostr
1: Stack.SetInt(-1, StrToInt(Stack.GetAnsiString(-2))); // strtoint 1: Stack.SetInt(-1, StrToInt(Stack.GetAnsiString(-2))); // strtoint
2: Stack.SetInt(-1, StrToIntDef(Stack.GetAnsiString(-2), Stack.GetInt(-3))); // strtointdef 2: Stack.SetInt(-1, StrToIntDef(Stack.GetAnsiString(-2), Stack.GetInt(-3))); // strtointdef
3: 3:
@ -8770,7 +8775,7 @@ begin
7: // StrGet 7: // StrGet
begin begin
temp := NewTPSVariantIFC(Stack[Stack.Count -2], True); temp := NewTPSVariantIFC(Stack[Stack.Count -2], True);
if (temp.Dta = nil) or not (temp.aType.BaseType in [btString, btUnicodeString]) then if (temp.Dta = nil) or not (temp.aType.BaseType in [btString, btUnicodeString]) then
begin begin
Result := False; Result := False;
exit; exit;
@ -8934,8 +8939,9 @@ begin
{$IFNDEF PS_NOINT64} {$IFNDEF PS_NOINT64}
39: Stack.SetInt64(-1, StrToInt64(string(Stack.GetAnsiString(-2)))); // StrToInt64 39: Stack.SetInt64(-1, StrToInt64(string(Stack.GetAnsiString(-2)))); // StrToInt64
40: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.GetInt64(-2))));// Int64ToStr 40: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.GetInt64(-2))));// Int64ToStr
41: Stack.SetInt64(-1, StrToInt64Def(string(Stack.GetAnsiString(-2)), Stack.GetInt64(-3))); // StrToInt64Def
{$ENDIF} {$ENDIF}
41: // sizeof 42: // sizeof
begin begin
temp := NewTPSVariantIFC(Stack[Stack.Count -2], False); temp := NewTPSVariantIFC(Stack[Stack.Count -2], False);
if Temp.aType = nil then if Temp.aType = nil then
@ -8944,7 +8950,7 @@ begin
Stack.SetInt(-1, Temp.aType.RealSize) Stack.SetInt(-1, Temp.aType.RealSize)
end; end;
{$IFNDEF PS_NOWIDESTRING} {$IFNDEF PS_NOWIDESTRING}
42: // WStrGet 43: // WStrGet
begin begin
temp := NewTPSVariantIFC(Stack[Stack.Count -2], True); temp := NewTPSVariantIFC(Stack[Stack.Count -2], True);
if temp.dta = nil then begin if temp.dta = nil then begin
@ -8982,7 +8988,7 @@ begin
end; end;
end; end;
end; end;
43: // WStrSet 44: // WStrSet
begin begin
temp := NewTPSVariantIFC(Stack[Stack.Count -3], True); temp := NewTPSVariantIFC(Stack[Stack.Count -3], True);
if (temp.Dta = nil) then if (temp.Dta = nil) then
@ -9170,6 +9176,9 @@ begin
btS16 : Stack.SetInt(-1,Low(SmallInt)); //SmallInt: -32768 btS16 : Stack.SetInt(-1,Low(SmallInt)); //SmallInt: -32768
btU32 : Stack.SetInt(-1,Low(Cardinal)); //Cardinal/LongWord: 0 btU32 : Stack.SetInt(-1,Low(Cardinal)); //Cardinal/LongWord: 0
btS32 : Stack.SetInt(-1,Low(Integer)); //Integer/LongInt: -2147483648 btS32 : Stack.SetInt(-1,Low(Integer)); //Integer/LongInt: -2147483648
{$IFNDEF PS_NOINT64}
btS64 : Stack.SetInt64(-1,Low(Int64)); //Int64: -9223372036854775808
{$ENDIF}
else Result:=false; else Result:=false;
end; end;
end; end;
@ -9188,8 +9197,11 @@ begin
btS8 : Stack.SetInt(-1,High(ShortInt)); //ShortInt: 127 btS8 : Stack.SetInt(-1,High(ShortInt)); //ShortInt: 127
btU16 : Stack.SetInt(-1,High(Word)); //Word: 65535 btU16 : Stack.SetInt(-1,High(Word)); //Word: 65535
btS16 : Stack.SetInt(-1,High(SmallInt)); //SmallInt: 32767 btS16 : Stack.SetInt(-1,High(SmallInt)); //SmallInt: 32767
btU32 : Stack.SetUInt(-1,High(Cardinal)); //Cardinal/LongWord: 4294967295 btU32 : Stack.SetUInt(-1,High(Cardinal)); //Cardinal/LongWord: 4294967295
btS32 : Stack.SetInt(-1,High(Integer)); //Integer/LongInt: 2147483647 btS32 : Stack.SetInt(-1,High(Integer)); //Integer/LongInt: 2147483647
{$IFNDEF PS_NOINT64}
btS64 : Stack.SetInt64(-1,High(Int64)); //Int64: 9223372036854775807
{$ENDIF}
else Result:=false; else Result:=false;
end; end;
end; end;
@ -9207,6 +9219,9 @@ begin
btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)-1); //SmallInt btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)-1); //SmallInt
btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)-1); //Cardinal/LongWord btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)-1); //Cardinal/LongWord
btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)-1); //Integer/LongInt btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)-1); //Integer/LongInt
{$IFNDEF PS_NOINT64}
btS64 : Stack.SetInt64(-1,Tbts64(arr.dta^)-1);
{$ENDIF}
else Result:=false; else Result:=false;
end; end;
end; end;
@ -9224,6 +9239,9 @@ begin
btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)+1); //SmallInt btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)+1); //SmallInt
btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)+1); //Cardinal/LongWord btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)+1); //Cardinal/LongWord
btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)+1); //Integer/LongInt btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)+1); //Integer/LongInt
{$IFNDEF PS_NOINT64}
btS64 : Stack.SetInt64(-1,Tbts64(arr.dta^)+1);
{$ENDIF}
else Result:=false; else Result:=false;
end; end;
end; end;
@ -9241,6 +9259,11 @@ end;
procedure TPSExec.RegisterStandardProcs; procedure TPSExec.RegisterStandardProcs;
begin begin
{ The following needs to be in synch in these 3 functions:
-UPSCompiler.TPSPascalCompiler.DefineStandardProcedures
-UPSRuntime.DefProc
-UPSRuntime.TPSExec.RegisterStandardProcs
}
RegisterFunctionName('!NOTIFICATIONVARIANTSET', NVarProc, Pointer(0), nil); RegisterFunctionName('!NOTIFICATIONVARIANTSET', NVarProc, Pointer(0), nil);
RegisterFunctionName('!NOTIFICATIONVARIANTGET', NVarProc, Pointer(1), nil); RegisterFunctionName('!NOTIFICATIONVARIANTGET', NVarProc, Pointer(1), nil);
@ -9308,12 +9331,13 @@ begin
{$IFNDEF PS_NOINT64} {$IFNDEF PS_NOINT64}
RegisterFunctionName('STRTOINT64', DefProc, Pointer(39), nil); RegisterFunctionName('STRTOINT64', DefProc, Pointer(39), nil);
RegisterFunctionName('INT64TOSTR', DefProc, Pointer(40), nil); RegisterFunctionName('INT64TOSTR', DefProc, Pointer(40), nil);
RegisterFunctionName('STRTOINT64DEF', DefProc, Pointer(41), nil);
{$ENDIF} {$ENDIF}
RegisterFunctionName('SIZEOF', DefProc, Pointer(41), nil); RegisterFunctionName('SIZEOF', DefProc, Pointer(42), nil);
{$IFNDEF PS_NOWIDESTRING} {$IFNDEF PS_NOWIDESTRING}
RegisterFunctionName('WSTRGET', DefProc, Pointer(42), nil); RegisterFunctionName('WSTRGET', DefProc, Pointer(43), nil);
RegisterFunctionName('WSTRSET', DefProc, Pointer(43), nil); RegisterFunctionName('WSTRSET', DefProc, Pointer(44), nil);
{$ENDIF} {$ENDIF}
{$IFNDEF DELPHI6UP} {$IFNDEF DELPHI6UP}

8
components/PascalScript/Source/x64.inc
View File

@ -147,7 +147,7 @@ asm
@work: @work:
{$IFDEF FPC} {$IFDEF FPC}
push qword ptr [rcx] push qword ptr [rcx]
{$ELSE} {$ELSE}
push [rcx] push [rcx]
{$ENDIF} {$ENDIF}
dec r8 dec r8
@ -632,7 +632,7 @@ begin
if (length(Stack) mod 16) <> 0 then begin if (length(Stack) mod 16) <> 0 then begin
SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16)); SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
end; end;
{$ENDIF} {$ENDIF}
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8]; if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8); x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
@ -677,8 +677,8 @@ begin
if (length(Stack) mod 16) <> 0 then begin if (length(Stack) mod 16) <> 0 then begin
SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16)); SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
end; end;
{$ENDIF} {$ENDIF}
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8]; if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8); x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
{$ELSE} {$ELSE}

6
components/PascalScript/Source/x86.inc
View File

@ -562,7 +562,7 @@ begin
if (length(Stack) mod 16) <> 0 then begin if (length(Stack) mod 16) <> 0 then begin
Stack := Stack + StringOfChar(ansichar(#32), 16 - (Length(Stack) mod 16)) ; Stack := Stack + StringOfChar(ansichar(#32), 16 - (Length(Stack) mod 16)) ;
end; end;
{$ENDIF} {$ENDIF}
case res^.aType.BaseType of case res^.aType.BaseType of
btSet: btSet:
begin begin
@ -618,9 +618,9 @@ begin
if (length(Stack) mod 16) <> 0 then begin if (length(Stack) mod 16) <> 0 then begin
Stack := Stack + StringOfChar(ansichar(#32), 16 - (Length(Stack) mod 16)) ; Stack := Stack + StringOfChar(ansichar(#32), 16 - (Length(Stack) mod 16)) ;
end; end;
{$ENDIF} {$ENDIF}
RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
end; end;
Result := True; Result := True;
end; end;
cdPascal: begin cdPascal: begin