paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-26 13:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

PascalScript: updates from original GIT

Browse Source 
git-svn-id: trunk@43882 -
This commit is contained in:
martin 2014-02-04 19:58:13 +00:00
parent 8d89805d46
commit ffdc4db7aa
5 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6774,7 +6774,11 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
u := rr.aType;
end;
end
{$IFDEF PS_HAVEVARIANT}else if (u.BaseType = btVariant) then break else {$ENDIF}
{$IFDEF PS_HAVEVARIANT}
else if (u.BaseType = btVariant) then break else
{$ELSE}
;
{$ENDIF}
begin
x.Free;
@ -7285,6 +7289,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
end;
FType2 := GetTypeNo(BlockInfo, Temp);
if ((typeno.BaseType = btClass){$IFNDEF PS_NOINTERFACES} or (TypeNo.basetype = btInterface){$ENDIF}) and
(ftype2<>nil) and
((ftype2.BaseType = btClass){$IFNDEF PS_NOINTERFACES} or (ftype2.BaseType = btInterface){$ENDIF}) and (TypeNo <> ftype2) then
begin
{$IFNDEF PS_NOINTERFACES}
@ -7338,7 +7343,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
FParser.Next;
Exit;
end;
if not IsCompatibleType(TypeNo, FType2, True) then
if (FType2=nil) or not IsCompatibleType(TypeNo, FType2, True) then
begin
temp.Free;
MakeError('', ecTypeMismatch, '');

7
components/PascalScript/Source/uPSDisassembly.pas
View File

@ -91,6 +91,13 @@ var
btClass: Result := 'Class';
btProcPtr: Result := 'ProcPtr';
btStaticArray: Result := 'StaticArray['+inttostR(TPSTypeRec_StaticArray(p).Size)+'] of '+BT2S(TPSTypeRec_Array(p).ArrayType);
btPChar: Result := 'PChar';
btCurrency: Result := 'Currency';
btUnicodeString: Result := 'UnicodeString';
btInterface: Result := 'Interface';
btType: Result := 'Type';
btEnum: Result := 'Enum';
btExtClass: Result := 'ExtClass';
else
Result := 'Unknown '+inttostr(p.BaseType);
end;

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

@ -9252,7 +9252,6 @@ var
SetData: PByteArray;
Val: Tbtu8;
begin
Result:=true;
TheSet:=NewTPSVariantIFC(Stack[Stack.Count-1],true);
NewMember:=NewTPSVariantIFC(Stack[Stack.Count-2],false);
Result := (TheSet.aType.BaseType = btSet) and (NewMember.aType.BaseType = btU8);
@ -9268,7 +9267,6 @@ var
SetData: PByteArray;
Val: Tbtu8;
begin
Result:=true;
TheSet:=NewTPSVariantIFC(Stack[Stack.Count-1],true);
NewMember:=NewTPSVariantIFC(Stack[Stack.Count-2],false);
Result := (TheSet.aType.BaseType = btSet) and (NewMember.aType.BaseType = btU8);
@ -11528,7 +11526,7 @@ end;
{$ENDIF}
{$ifdef fpc}
{$if defined(cpupowerpc) or defined(cpuarm) or defined(cpu64) or defined(cpusparc)}
{$if defined(cpupowerpc) or defined(cpuarm) or defined(cpu64)}
{$define empty_methods_handler}
{$ifend}
{$endif}

7
components/PascalScript/Source/uPSUtils.pas
View File

@ -873,8 +873,11 @@ begin
if FCount = 0 then Exit;
if Nr < FCount then
begin
Move(FData[Nr + 1], FData[Nr], (FCount - Nr) * PointerSize);
{dec count first, so we move one element less in the move below}
Dec(FCount);
{only move if we aren't deleting the last element}
if Nr < FCount then
Move(FData[Nr + 1], FData[Nr], (FCount - Nr) * PointerSize);
{$IFNDEF PS_NOSMARTLIST}
Inc(FCheckCount);
if FCheckCount > FMaxCheckCount then Recreate;
@ -995,7 +998,7 @@ end;
procedure TPSStringList.Clear;
begin
while List.Count > 0 do Delete(0);
while List.Count > 0 do Delete(Pred(List.Count));
end;
constructor TPSStringList.Create;

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

@ -55,7 +55,8 @@ asm
movd xmm2,_XMM2
movd xmm3,_XMM3
{$ELSE}
movsd xmm0,[_XMM0]
mov rax, [_XMM0]
movsd xmm0, qword ptr [rax]
movsd xmm1,_XMM1
movsd xmm2,_XMM2
movsd xmm3,_XMM3
@ -79,7 +80,8 @@ asm
{$IFDEF FPC}
movd [_XMM0],xmm0
{$ELSE}
movsd [_XMM0],xmm0
mov rax, [_XMM0]
movsd qword ptr [rax], xmm0
{$ENDIF}
pop r9