paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 14:46:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r49040 into '.':

Browse Source 
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 -
This commit is contained in:
marco 2021-04-03 09:12:47 +00:00
parent 44383938f9
commit 46533ea1e8
7 changed files with 128 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

14
compiler/aarch64/cgcpu.pas
View File

@ -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); shifterop_reset(so);
so.shiftmode := SM_LSL; so.shiftmode := SM_LSL;
so.shiftimm := 48; so.shiftimm := 48;
list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so)); list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so));
end;
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;

31
packages/regexpr/src/regexpr.pas
View File

@ -1613,41 +1613,66 @@ end; { of function TRegExpr.GetModifierStr
-------------------------------------------------------------- } -------------------------------------------------------------- }
procedure TRegExpr.SetModifierG(AValue: boolean); procedure TRegExpr.SetModifierG(AValue: boolean);
begin
if fModifiers.G <> AValue then
begin begin
fModifiers.G := AValue; fModifiers.G := AValue;
InvalidateProgramm;
end;
end; end;
procedure TRegExpr.SetModifierI(AValue: boolean); procedure TRegExpr.SetModifierI(AValue: boolean);
begin
if fModifiers.I <> AValue then
begin begin
fModifiers.I := AValue; fModifiers.I := AValue;
InvalidateProgramm;
end;
end; end;
procedure TRegExpr.SetModifierM(AValue: boolean); procedure TRegExpr.SetModifierM(AValue: boolean);
begin
if fModifiers.M <> AValue then
begin begin
fModifiers.M := AValue; fModifiers.M := AValue;
InvalidateProgramm;
end;
end; end;
procedure TRegExpr.SetModifierR(AValue: boolean); procedure TRegExpr.SetModifierR(AValue: boolean);
begin
if fModifiers.R <> AValue then
begin begin
fModifiers.R := AValue; fModifiers.R := AValue;
InvalidateProgramm;
end;
end; end;
procedure TRegExpr.SetModifierS(AValue: boolean); procedure TRegExpr.SetModifierS(AValue: boolean);
begin
if fModifiers.S <> AValue then
begin begin
fModifiers.S := AValue; fModifiers.S := AValue;
InvalidateProgramm;
end;
end; end;
procedure TRegExpr.SetModifierX(AValue: boolean); procedure TRegExpr.SetModifierX(AValue: boolean);
begin
if fModifiers.X <> AValue then
begin begin
fModifiers.X := AValue; 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 ======================= }

10
packages/rtl-objpas/src/inc/strutils.pp
View File

@ -177,13 +177,13 @@ 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(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
Function RPosex (Const Substr : AnsiString; Const Source : 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 : AnsiString; Const Source : AnsiString) : SizeInt; overload;
Function RPos(Const Substr : UnicodeString; Const Source : UnicodeString) : 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;

2
packages/rtl-objpas/src/inc/variants.pp
View File

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

73
rtl/win/wininc/struct.inc
View File

@ -6304,40 +6304,91 @@ 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; 1 : (pszIcon : LPCSTR;
pszCaption : LPCTSTR; 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; LPPROPSHEETHEADERA = ^PROPSHEETHEADERA;
LPCPROPSHEETHEADER = ^PROPSHEETHEADER; LPCPROPSHEETHEADERA = ^PROPSHEETHEADERA;
_PROPSHEETHEADER = PROPSHEETHEADER; _PROPSHEETHEADERA = PROPSHEETHEADERA;
TPROPSHEETHEADER = PROPSHEETHEADER; TPROPSHEETHEADERA = PROPSHEETHEADERA;
PPROPSHEETHEADER = ^PROPSHEETHEADER; 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;

10
tests/webtbs/tw38695.pp Normal file
View File

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