PascalScript: updates from original GIT

git-svn-id: trunk@43882 -

components/PascalScript/Source/uPSCompiler.pas

@@ -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, '');

components/PascalScript/Source/uPSDisassembly.pas

@@ -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;

components/PascalScript/Source/uPSRuntime.pas

@@ -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}

components/PascalScript/Source/uPSUtils.pas

@@ -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;

components/PascalScript/Source/x64.inc

@@ -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