Browse Source

--- Merging r49040 into '.':
U packages/rtl-objpas/src/inc/variants.pp
--- Recording mergeinfo for merge of r49040 into '.':
U .
--- Merging r49044 into '.':
U packages/rtl-objpas/src/inc/strutils.pp
--- Recording mergeinfo for merge of r49044 into '.':
G .
--- Merging r49047 into '.':
U packages/regexpr/src/regexpr.pas
--- Recording mergeinfo for merge of r49047 into '.':
G .
--- Merging r49101 into '.':
U rtl/win/wininc/struct.inc
--- Recording mergeinfo for merge of r49101 into '.':
G .
--- Merging r49104 into '.':
C compiler/aarch64/cgcpu.pas
A tests/webtbs/tw38695.pp
--- Recording mergeinfo for merge of r49104 into '.':
G .
Summary of conflicts:
Text conflicts: 1

# revisions: 49040,49044,49047,49101,49104
r49040 | florian | 2021-03-23 21:57:18 +0100 (Tue, 23 Mar 2021) | 1 line
Changed paths:
M /trunk/packages/rtl-objpas/src/inc/variants.pp

* patch by Arnaud Bouchez: initialize dummy_data properly, resolves #38653
r49044 | michael | 2021-03-24 11:40:03 +0100 (Wed, 24 Mar 2021) | 1 line
Changed paths:
M /trunk/packages/rtl-objpas/src/inc/strutils.pp

Fix casing, bug ID #38660
r49047 | michael | 2021-03-24 18:05:26 +0100 (Wed, 24 Mar 2021) | 1 line
Changed paths:
M /trunk/packages/regexpr/src/regexpr.pas

* Fix issue #38442
r49101 | marco | 2021-04-02 16:54:40 +0200 (Fri, 02 Apr 2021) | 1 line
Changed paths:
M /trunk/rtl/win/wininc/struct.inc

* split propsheetheader in -A and -W variants.
r49104 | florian | 2021-04-02 18:44:43 +0200 (Fri, 02 Apr 2021) | 2 lines
Changed paths:
M /trunk/compiler/aarch64/cgcpu.pas
A /trunk/tests/webtbs/tw38695.pp

* Aarch64: patch by J. Gareth Moreton: fix constant writing, resolves #38695
+ test

git-svn-id: branches/fixes_3_2@49110 -

marco 4 years ago
parent
commit
46533ea1e8

+ 1 - 0
.gitattributes

@@ -17851,6 +17851,7 @@ tests/webtbs/tw38429.pp svneol=native#text/pascal
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain
+tests/webtbs/tw38695.pp svneol=native#text/pascal
 tests/webtbs/tw3870.pp svneol=native#text/plain
 tests/webtbs/tw3870.pp svneol=native#text/plain
 tests/webtbs/tw3893.pp svneol=native#text/plain
 tests/webtbs/tw3893.pp svneol=native#text/plain
 tests/webtbs/tw3898.pp svneol=native#text/plain
 tests/webtbs/tw3898.pp svneol=native#text/plain

+ 13 - 9
compiler/aarch64/cgcpu.pas

@@ -585,6 +585,9 @@ implementation
         manipulated_a: tcgint;
         manipulated_a: tcgint;
         leftover_a: word;
         leftover_a: word;
       begin
       begin
+{$ifdef extdebug}
+        list.concat(tai_comment.Create(strpnew('Generating constant ' + tostr(a) + ' / $' + hexstr(a, 16))));
+{$endif extdebug}
         case a of
         case a of
           { Small positive number }
           { Small positive number }
           $0..$FFFF:
           $0..$FFFF:
@@ -618,7 +621,7 @@ implementation
                       Exit;
                       Exit;
                     end;
                     end;
 
 
-                  { This determines whether this write can be peformed with an ORR followed by MOVK
+                  { This determines whether this write can be performed with an ORR followed by MOVK
                     by copying the 2nd word to the 4th word for the ORR constant, then overwriting
                     by copying the 2nd word to the 4th word for the ORR constant, then overwriting
                     the 4th word (unless the word is.  The alternative would require 3 instructions }
                     the 4th word (unless the word is.  The alternative would require 3 instructions }
                   leftover_a := word(a shr 48);
                   leftover_a := word(a shr 48);
@@ -639,14 +642,15 @@ implementation
                     called for a and it returned False.  Reduces processing time. [Kit] }
                     called for a and it returned False.  Reduces processing time. [Kit] }
                   if (manipulated_a <> a) and is_shifter_const(manipulated_a, size) then
                   if (manipulated_a <> a) and is_shifter_const(manipulated_a, size) then
                     begin
                     begin
+                      { Encode value as:
+                          orr  reg,xzr,manipulated_a
+                          movk reg,#(leftover_a),lsl #48
+                      }
                       list.concat(taicpu.op_reg_reg_const(A_ORR, reg, makeregsize(NR_XZR, size), manipulated_a));
                       list.concat(taicpu.op_reg_reg_const(A_ORR, reg, makeregsize(NR_XZR, size), manipulated_a));
-                      if (leftover_a <> 0) then
-                        begin
-                          shifterop_reset(so);
-                          so.shiftmode := SM_LSL;
-                          so.shiftimm := 48;
-                          list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so));
-                        end;
+                      shifterop_reset(so);
+                      so.shiftmode := SM_LSL;
+                      so.shiftimm := 48;
+                      list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so));
                       Exit;
                       Exit;
                     end;
                     end;
 
 
@@ -659,7 +663,7 @@ implementation
                           stored as the first 16 bits followed by a shifter constant }
                           stored as the first 16 bits followed by a shifter constant }
                         case a of
                         case a of
                           TCgInt($FFFF0000FFFF0000)..TCgInt($FFFF0000FFFFFFFF):
                           TCgInt($FFFF0000FFFF0000)..TCgInt($FFFF0000FFFFFFFF):
-                            doinverted := False
+                            doinverted := False;
                           else
                           else
                             begin
                             begin
                               doinverted := True;
                               doinverted := True;

+ 34 - 9
packages/regexpr/src/regexpr.pas

@@ -1614,40 +1614,65 @@ end; { of function TRegExpr.GetModifierStr
 
 
 procedure TRegExpr.SetModifierG(AValue: boolean);
 procedure TRegExpr.SetModifierG(AValue: boolean);
 begin
 begin
-  fModifiers.G := AValue;
+  if fModifiers.G <> AValue then
+  begin
+    fModifiers.G := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierI(AValue: boolean);
 procedure TRegExpr.SetModifierI(AValue: boolean);
 begin
 begin
-  fModifiers.I := AValue;
+  if fModifiers.I <> AValue then
+  begin
+    fModifiers.I := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierM(AValue: boolean);
 procedure TRegExpr.SetModifierM(AValue: boolean);
 begin
 begin
-  fModifiers.M := AValue;
+  if fModifiers.M <> AValue then
+  begin
+    fModifiers.M := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierR(AValue: boolean);
 procedure TRegExpr.SetModifierR(AValue: boolean);
 begin
 begin
-  fModifiers.R := AValue;
+  if fModifiers.R <> AValue then
+  begin
+    fModifiers.R := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierS(AValue: boolean);
 procedure TRegExpr.SetModifierS(AValue: boolean);
 begin
 begin
-  fModifiers.S := AValue;
+  if fModifiers.S <> AValue then
+  begin
+    fModifiers.S := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierX(AValue: boolean);
 procedure TRegExpr.SetModifierX(AValue: boolean);
 begin
 begin
-  fModifiers.X := AValue;
+  if fModifiers.X <> AValue then
+  begin
+    fModifiers.X := AValue;
+    InvalidateProgramm;
+  end;
 end;
 end;
 
 
 procedure TRegExpr.SetModifierStr(const AStr: RegExprString);
 procedure TRegExpr.SetModifierStr(const AStr: RegExprString);
 begin
 begin
-  if not ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
+  if ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
+    InvalidateProgramm
+  else
     Error(reeModifierUnsupported);
     Error(reeModifierUnsupported);
-end; { of procedure TRegExpr.SetModifierStr
-  -------------------------------------------------------------- }
+end;
 
 
 { ============================================================= }
 { ============================================================= }
 { ==================== Compiler section ======================= }
 { ==================== Compiler section ======================= }

+ 6 - 6
packages/rtl-objpas/src/inc/strutils.pp

@@ -177,14 +177,14 @@ function DelSpace1(const S: string): string;
 function Tab2Space(const S: string; Numb: Byte): string;
 function Tab2Space(const S: string; Numb: Byte): string;
 function NPos(const C: string; S: string; N: Integer): SizeInt;
 function NPos(const C: string; S: string; N: Integer): SizeInt;
 
 
-Function RPosEX(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
-Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
+Function RPosEx(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
+Function RPosEx(C:Unicodechar;const S : UnicodeString;offs:cardinal):SizeInt; overload;
+Function RPosEx(Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
+Function RPosEx(Const Substr : UnicodeString; Const Source : UnicodeString;offs:cardinal) : SizeInt; overload;
 Function RPos(c:char;const S : AnsiString):SizeInt; overload;
 Function RPos(c:char;const S : AnsiString):SizeInt; overload;
-Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
-Function RPosEX(C:Unicodechar;const S : UnicodeString;offs:cardinal):SizeInt; overload;
-Function RPosex (Const Substr : UnicodeString; Const Source : UnicodeString;offs:cardinal) : SizeInt; overload;
 Function RPos(c:Unicodechar;const S : UnicodeString):SizeInt; overload;
 Function RPos(c:Unicodechar;const S : UnicodeString):SizeInt; overload;
-Function RPos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt; overload;
+Function RPos(Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
+Function RPos(Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt; overload;
 
 
 function AddChar(C: Char; const S: string; N: Integer): string;
 function AddChar(C: Char; const S: string; N: Integer): string;
 function AddCharR(C: Char; const S: string; N: Integer): string;
 function AddCharR(C: Char; const S: string; N: Integer): string;

+ 2 - 2
packages/rtl-objpas/src/inc/variants.pp

@@ -4129,7 +4129,7 @@ begin
         if not DoProcedure(Source,method_name,args) then
         if not DoProcedure(Source,method_name,args) then
         // may be function?
         // may be function?
         try
         try
-          variant(dummy_data) := Unassigned;
+          dummy_data.VType := varEmpty;
           if not DoFunction(dummy_data,Source,method_name,args) then
           if not DoFunction(dummy_data,Source,method_name,args) then
             RaiseDispError;
             RaiseDispError;
         finally
         finally
@@ -4482,7 +4482,7 @@ Var
 begin
 begin
   case (PropInfo^.PropProcs shr 2) and 3 of
   case (PropInfo^.PropProcs shr 2) and 3 of
     ptfield:
     ptfield:
-      PVariant(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;	
+      PVariant(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
     ptVirtual,ptStatic:
     ptVirtual,ptStatic:
       begin
       begin
         if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
         if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then

+ 62 - 11
rtl/win/wininc/struct.inc

@@ -6304,41 +6304,92 @@ Const
      lpemptyrecord = ^emptyrecord;
      lpemptyrecord = ^emptyrecord;
      HPROPSHEETPAGE = ^emptyrecord;
      HPROPSHEETPAGE = ^emptyrecord;
 
 
-     PROPSHEETHEADER = record
+     PROPSHEETHEADERA = record
           dwSize : DWORD;
           dwSize : DWORD;
           dwFlags : DWORD;
           dwFlags : DWORD;
           hwndParent : HWND;
           hwndParent : HWND;
           hInstance : HINST;
           hInstance : HINST;
           case longint of
           case longint of
               0 : (hIcon : HICON);
               0 : (hIcon : HICON);
-              1 : (pszIcon : LPCTSTR;
-                   pszCaption : LPCTSTR;
+              1 : (pszIcon : LPCSTR;
+                   pszCaption : LPCSTR;
                    nPages : UINT;
                    nPages : UINT;
                    case longint of
                    case longint of
                       0 : (nStartPage : UINT);
                       0 : (nStartPage : UINT);
-                      1 : (pStartPage : LPCTSTR;
+                      1 : (pStartPage : LPCSTR;
                            case longint of
                            case longint of
                               0 : (ppsp : LPCPROPSHEETPAGE);
                               0 : (ppsp : LPCPROPSHEETPAGE);
                               1 : (phpage : ^HPROPSHEETPAGE;
                               1 : (phpage : ^HPROPSHEETPAGE;
                                    pfnCallback : PFNPROPSHEETCALLBACK;
                                    pfnCallback : PFNPROPSHEETCALLBACK;
                                    case longint of
                                    case longint of
                                      0 : (hbmWatermark : HBITMAP);
                                      0 : (hbmWatermark : HBITMAP);
-                                     1 : (pszbmWatermark : LPCTSTR;
+                                     1 : (pszbmWatermark : LPCSTR;
                                           hplWatermark : HPALETTE;
                                           hplWatermark : HPALETTE;
                                           case longint of
                                           case longint of
                                              0 : (hbmHeader : HBITMAP);
                                              0 : (hbmHeader : HBITMAP);
-                                             1 : (pszbmHeader: PAnsiChar);
+                                             1 : (pszbmHeader: LPCStr);
                                          );
                                          );
                                   );
                                   );
                           );
                           );
                   );
                   );
        end;
        end;
-     LPPROPSHEETHEADER = ^PROPSHEETHEADER;
-     LPCPROPSHEETHEADER = ^PROPSHEETHEADER;
-     _PROPSHEETHEADER = PROPSHEETHEADER;
-     TPROPSHEETHEADER = PROPSHEETHEADER;
-     PPROPSHEETHEADER = ^PROPSHEETHEADER;
+     LPPROPSHEETHEADERA = ^PROPSHEETHEADERA;
+     LPCPROPSHEETHEADERA = ^PROPSHEETHEADERA;
+     _PROPSHEETHEADERA = PROPSHEETHEADERA;
+     TPROPSHEETHEADERA = PROPSHEETHEADERA;
+     PPROPSHEETHEADERA = ^PROPSHEETHEADERA;
 
 
+     PROPSHEETHEADERW = record
+          dwSize : DWORD;
+          dwFlags : DWORD;
+          hwndParent : HWND;
+          hInstance : HINST;
+          case longint of
+              0 : (hIcon : HICON);
+              1 : (pszIcon : LPCWSTR;
+                   pszCaption : LPCWSTR;
+                   nPages : UINT;
+                   case longint of
+                      0 : (nStartPage : UINT);
+                      1 : (pStartPage : LPCWSTR;
+                           case longint of
+                              0 : (ppsp : LPCPROPSHEETPAGE);
+                              1 : (phpage : ^HPROPSHEETPAGE;
+                                   pfnCallback : PFNPROPSHEETCALLBACK;
+                                   case longint of
+                                     0 : (hbmWatermark : HBITMAP);
+                                     1 : (pszbmWatermark : LPCWSTR;
+                                          hplWatermark : HPALETTE;
+                                          case longint of
+                                             0 : (hbmHeader : HBITMAP);
+                                             1 : (pszbmHeader: LPCWStr);
+                                         );
+                                  );
+                          );
+                  );
+       end;
+     LPPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+     LPCPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+     _PROPSHEETHEADERW = PROPSHEETHEADERW;
+     TPROPSHEETHEADERW = PROPSHEETHEADERW;
+     PPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+
+     {$ifdef Unicode}
+     PROPSHEETHEADER    = PROPSHEETHEADERW;
+     LPPROPSHEETHEADER  = LPPROPSHEETHEADERW;
+     LPCPROPSHEETHEADER = LPCPROPSHEETHEADERW;
+     _PROPSHEETHEADER   = _PROPSHEETHEADERW;
+     TPROPSHEETHEADER   = TPROPSHEETHEADERW;
+     PPROPSHEETHEADER   = PPROPSHEETHEADERW;
+     {$else}
+     PROPSHEETHEADER    = PROPSHEETHEADERA;
+     LPPROPSHEETHEADER  = LPPROPSHEETHEADERA;
+     LPCPROPSHEETHEADER = LPCPROPSHEETHEADERA;
+     _PROPSHEETHEADER   = _PROPSHEETHEADERA;
+     TPROPSHEETHEADER   = TPROPSHEETHEADERA;
+     PPROPSHEETHEADER   = PPROPSHEETHEADERA;
+     {$endif}
+    
      { PropertySheet callbacks  }
      { PropertySheet callbacks  }
      LPFNADDPROPSHEETPAGE = function (_para1:HPROPSHEETPAGE; _para2:LPARAM):WINBOOL;stdcall;
      LPFNADDPROPSHEETPAGE = function (_para1:HPROPSHEETPAGE; _para2:LPARAM):WINBOOL;stdcall;
      TFNADDPROPSHEETPAGE = LPFNADDPROPSHEETPAGE;
      TFNADDPROPSHEETPAGE = LPFNADDPROPSHEETPAGE;

+ 10 - 0
tests/webtbs/tw38695.pp

@@ -0,0 +1,10 @@
+{ %opt=-O- }
+var
+  q1,q2,q3 : qword;
+begin
+  q1:=$0000FFFFFFFEFFFF;
+  q2:=$FFFEFFFF;
+  q3:=$FFFF00000000;
+  if q1<>q2 or q3 then
+    halt(1);
+end.