From 0f4ddf7b3497938dce9f1ae5b20179e13c78d03d Mon Sep 17 00:00:00 2001 From: yury Date: Wed, 22 Apr 2020 09:13:20 +0000 Subject: [PATCH 1/6] * Do not report about unimplemented unicodestring manager when HAS_WIDESTRINGMANAGER is defined (on Windows). In such case unimplemented parts are never executed unless you call them directly. * Do not assign DefaultGetStandardCodePage when HAS_WIDESTRINGMANAGER is defined (on Windows). git-svn-id: trunk@44995 - --- rtl/inc/ustrings.inc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index f32d0cbaf9..183134706c 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -2276,11 +2276,13 @@ const procedure unimplementedunicodestring; begin {$ifdef FPC_HAS_FEATURE_CONSOLEIO} +{$ifndef HAS_WIDESTRINGMANAGER} If IsConsole then begin Writeln(StdErr,SNoUnicodestrings); Writeln(StdErr,SRecompileWithUnicodestrings); end; +{$endif HAS_WIDESTRINGMANAGER} {$endif FPC_HAS_FEATURE_CONSOLEIO} HandleErrorAddrFrameInd(234{RuntimeErrorExitCodes[reCodesetConversion]},get_pc_addr,get_frame); end; @@ -2353,13 +2355,13 @@ procedure initunicodestringmanager; widestringmanager.Ansi2UnicodeMoveProc:=@DefaultAnsi2UnicodeMove; widestringmanager.UpperUnicodeStringProc:=@StubUnicodeCase; widestringmanager.LowerUnicodeStringProc:=@StubUnicodeCase; + widestringmanager.GetStandardCodePageProc:=@DefaultGetStandardCodePage; {$endif HAS_WIDESTRINGMANAGER} widestringmanager.CompareWideStringProc:=@StubCompareWideString; // widestringmanager.CompareTextWideStringProc:=@StubCompareWideString; widestringmanager.CompareUnicodeStringProc:=@StubCompareUnicodeString; widestringmanager.CharLengthPCharProc:=@DefaultCharLengthPChar; widestringmanager.CodePointLengthProc:=@DefaultCodePointLength; - widestringmanager.GetStandardCodePageProc:=@DefaultGetStandardCodePage; end; {$endif FPC_HAS_BUILTIN_WIDESTR_MANAGER} From 7b425ed4a65a9381061800c66625b7d8437c441f Mon Sep 17 00:00:00 2001 From: yury Date: Wed, 22 Apr 2020 12:04:05 +0000 Subject: [PATCH 2/6] * Moved the common interface part of the win32 and win64 System units to the syswinh.inc include file. git-svn-id: trunk@44996 - --- .gitattributes | 1 + rtl/win/syswinh.inc | 77 +++++++++++++++++++++++++++++++++++++++++++++ rtl/win32/system.pp | 68 ++------------------------------------- rtl/win64/system.pp | 63 ++----------------------------------- 4 files changed, 83 insertions(+), 126 deletions(-) create mode 100644 rtl/win/syswinh.inc diff --git a/.gitattributes b/.gitattributes index 5d00c8584c..382427fa81 100644 --- a/.gitattributes +++ b/.gitattributes @@ -12009,6 +12009,7 @@ rtl/win/systhrd.inc svneol=native#text/plain rtl/win/systlsdir.inc svneol=native#text/plain rtl/win/sysutils.pp svneol=native#text/plain rtl/win/syswin.inc svneol=native#text/plain +rtl/win/syswinh.inc svneol=native#text/plain rtl/win/tthread.inc svneol=native#text/plain rtl/win/windirs.pp svneol=native#text/plain rtl/win/wininc/Makefile svneol=native#text/plain diff --git a/rtl/win/syswinh.inc b/rtl/win/syswinh.inc new file mode 100644 index 0000000000..90b691dc40 --- /dev/null +++ b/rtl/win/syswinh.inc @@ -0,0 +1,77 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2020 by the Free Pascal development team. + + FPC Pascal system unit header part shared by win32/win64. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +const + LineEnding = #13#10; + LFNSupport = true; + DirectorySeparator = '\'; + DriveSeparator = ':'; + ExtensionSeparator = '.'; + PathSeparator = ';'; + AllowDirectorySeparators : set of char = ['\','/']; + AllowDriveSeparators : set of char = [':']; +{ FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! } + maxExitCode = 65535; + MaxPathLen = 260; + AllFilesMask = '*'; + +type + PEXCEPTION_FRAME = ^TEXCEPTION_FRAME; + TEXCEPTION_FRAME = record + next : PEXCEPTION_FRAME; + handler : pointer; + end; + +const +{ Default filehandles } + UnusedHandle : THandle = THandle(-1); + StdInputHandle : THandle = 0; + StdOutputHandle : THandle = 0; + StdErrorHandle : THandle = 0; + System_exception_frame : PEXCEPTION_FRAME =nil; + + FileNameCaseSensitive : boolean = false; + FileNameCasePreserving: boolean = true; + CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *) + + sLineBreak = LineEnding; + DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; + +var +{ C compatible arguments } + argc : longint; + argv : ppchar; +{ Win32 Info } + startupinfo : tstartupinfo deprecated; // Delphi does not have one in interface + StartupConsoleMode : dword; + cmdshow : longint; + DLLreason : dword; + DLLparam : PtrInt; +const + hprevinst: qword=0; +type + TDLL_Entry_Hook = procedure (dllparam : PtrInt); + +const + Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; + Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; + Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; + +Const + { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see + also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used + value + } + fmShareDenyNoneFlags : DWord = 3; diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index a882c76793..f0dee6a272 100644 --- a/rtl/win32/system.pp +++ b/rtl/win32/system.pp @@ -45,73 +45,11 @@ interface { include system-independent routine headers } {$I systemh.inc} - -const - LineEnding = #13#10; - LFNSupport = true; - DirectorySeparator = '\'; - DriveSeparator = ':'; - ExtensionSeparator = '.'; - PathSeparator = ';'; - AllowDirectorySeparators : set of char = ['\','/']; - AllowDriveSeparators : set of char = [':']; - -{ FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! } - maxExitCode = 65535; - MaxPathLen = 260; - AllFilesMask = '*'; - -type - PEXCEPTION_FRAME = ^TEXCEPTION_FRAME; - TEXCEPTION_FRAME = record - next : PEXCEPTION_FRAME; - handler : pointer; - end; - -const -{ Default filehandles } - UnusedHandle : THandle = THandle(-1); - StdInputHandle : THandle = 0; - StdOutputHandle : THandle = 0; - StdErrorHandle : THandle = 0; - - FileNameCaseSensitive : boolean = false; - FileNameCasePreserving: boolean = true; - CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *) - - sLineBreak = LineEnding; - DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; - - System_exception_frame : PEXCEPTION_FRAME =nil; +{ include common windows headers } +{$I syswinh.inc} var -{ C compatible arguments } - argc : longint; public name 'operatingsystem_parameter_argc'; - argv : ppchar; public name 'operatingsystem_parameter_argv'; -{ Win32 Info } - startupinfo : tstartupinfo deprecated; // Delphi does not have one in interface - MainInstance, - cmdshow : longint; - DLLreason : dword; public name 'operatingsystem_dllreason'; - DLLparam : PtrInt; public name 'operatingsystem_dllparam'; - StartupConsoleMode : DWORD; -const - hprevinst: longint=0; - -type - TDLL_Entry_Hook = procedure (dllparam : PtrInt); - -const - Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; - -Const - { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see - also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used - value - } - fmShareDenyNoneFlags : DWord = 3; + MainInstance : longint; implementation diff --git a/rtl/win64/system.pp b/rtl/win64/system.pp index e02bee63df..fc69b61215 100644 --- a/rtl/win64/system.pp +++ b/rtl/win64/system.pp @@ -42,70 +42,11 @@ interface { include system-independent routine headers } {$I systemh.inc} - -const - LineEnding = #13#10; - LFNSupport = true; - DirectorySeparator = '\'; - DriveSeparator = ':'; - ExtensionSeparator = '.'; - PathSeparator = ';'; - AllowDirectorySeparators : set of char = ['\','/']; - AllowDriveSeparators : set of char = [':']; -{ FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! } - maxExitCode = 65535; - MaxPathLen = 260; - AllFilesMask = '*'; - -type - PEXCEPTION_FRAME = ^TEXCEPTION_FRAME; - TEXCEPTION_FRAME = record - next : PEXCEPTION_FRAME; - handler : pointer; - end; - -const -{ Default filehandles } - UnusedHandle : THandle = THandle(-1); - StdInputHandle : THandle = 0; - StdOutputHandle : THandle = 0; - StdErrorHandle : THandle = 0; - System_exception_frame : PEXCEPTION_FRAME =nil; - - FileNameCaseSensitive : boolean = false; - FileNameCasePreserving: boolean = true; - CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *) - - sLineBreak = LineEnding; - DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; +{ include common windows headers } +{$I syswinh.inc} var -{ C compatible arguments } - argc : longint; - argv : ppchar; -{ Win32 Info } - startupinfo : tstartupinfo deprecated; // Delphi does not have one in interface - StartupConsoleMode : dword; MainInstance : qword; - cmdshow : longint; - DLLreason : dword; - DLLparam : PtrInt; -const - hprevinst: qword=0; -type - TDLL_Entry_Hook = procedure (dllparam : PtrInt); - -const - Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; - -Const - { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see - also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used - value - } - fmShareDenyNoneFlags : DWord = 3; implementation From 03eb114e97b512ffdc98247ddcc1275fc9ab0a63 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Wed, 22 Apr 2020 20:19:09 +0000 Subject: [PATCH 3/6] * fix for Mantis #36951: if the instruction only has one operand and it's a reference then don't internal error, but instead return OS_NO git-svn-id: trunk@44998 - --- compiler/aarch64/racpu.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/aarch64/racpu.pas b/compiler/aarch64/racpu.pas index 91d32a2ab5..6f4061b388 100644 --- a/compiler/aarch64/racpu.pas +++ b/compiler/aarch64/racpu.pas @@ -67,6 +67,8 @@ unit racpu; begin if ops<1 then internalerror(2014122001); + if (ops=1) and (operands[1].opr.typ=OPR_REFERENCE) then + exit(OS_NO); if operands[1].opr.typ<>OPR_REGISTER then internalerror(2014122002); result:=reg_cgsize(operands[1].opr.reg); From 5ef9a78f5ffafafc8c0462e455d114be9c9a90a6 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Wed, 22 Apr 2020 20:19:14 +0000 Subject: [PATCH 4/6] * fix for Mantis #36951: B and BL can take immediate literals as well + added test git-svn-id: trunk@44999 - --- .gitattributes | 1 + compiler/aarch64/aasmcpu.pas | 2 +- tests/tbs/tb0669.pp | 31 +++++++++++++++++++++++++++++++ 3 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 tests/tbs/tb0669.pp diff --git a/.gitattributes b/.gitattributes index 382427fa81..753382970a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13204,6 +13204,7 @@ tests/tbs/tb0666b.pp svneol=native#text/pascal tests/tbs/tb0667.pp svneol=native#text/pascal tests/tbs/tb0668a.pp svneol=native#text/pascal tests/tbs/tb0668b.pp svneol=native#text/pascal +tests/tbs/tb0669.pp svneol=native#text/pascal tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain tests/tbs/ub0119.pp svneol=native#text/plain diff --git a/compiler/aarch64/aasmcpu.pas b/compiler/aarch64/aasmcpu.pas index f047a8b619..eb858b6e4a 100644 --- a/compiler/aarch64/aasmcpu.pas +++ b/compiler/aarch64/aasmcpu.pas @@ -585,7 +585,7 @@ implementation exit; { "ldr literal" must be a 32/64 bit LDR and have a symbol } if (ref.refaddr=addr_pic) and - ((op<>A_LDR) or + (not (op in [A_LDR,A_B,A_BL]) or not(oppostfix in [PF_NONE,PF_W,PF_SW]) or (not assigned(ref.symbol) and not assigned(ref.symboldata))) then diff --git a/tests/tbs/tb0669.pp b/tests/tbs/tb0669.pp new file mode 100644 index 0000000000..aa62cae47e --- /dev/null +++ b/tests/tbs/tb0669.pp @@ -0,0 +1,31 @@ +{ %CPU=aarch64 } +{ %NORUN } + +program tb0669; + +Type + TSysResult = Int64; + TSysParam = Int64; + +procedure seterrno(err:longint); + +begin +end; + +function FpSysCall(sysnr:TSysParam):TSysResult; +assembler; nostackframe; +asm + {mov w8,w0 + svc #0 + tbz x0,#63,.Ldone + str x30,[sp,#-16]! + neg x0,x0} + bl seterrno + {ldr x30,[sp],#16 + mov x0,#-1 +.Ldone:} +end; + +begin + +end. From 74abe873151caecdd73cb2442631050bee0bb7d3 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 22 Apr 2020 21:03:06 +0000 Subject: [PATCH 5/6] * Xtensa: do SAR by a constant using SRAI git-svn-id: trunk@45000 - --- compiler/xtensa/cgcpu.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/xtensa/cgcpu.pas b/compiler/xtensa/cgcpu.pas index eac742d810..2319667781 100644 --- a/compiler/xtensa/cgcpu.pas +++ b/compiler/xtensa/cgcpu.pas @@ -515,6 +515,8 @@ implementation end else if (op=OP_SHL) and (a>=1) and (a<=31) then list.concat(taicpu.op_reg_reg_const(A_SLLI,dst,src,a)) + else if (op=OP_SAR) and (a>=0) and (a<=31) then + list.concat(taicpu.op_reg_reg_const(A_SRAI,dst,src,a)) else if (op=OP_SHR) and (a>=0) and (a<=15) then list.concat(taicpu.op_reg_reg_const(A_SRLI,dst,src,a)) else if (op=OP_SHR) and (a>15) and (a<=31) then From 483837ae5cdf79f77aa935f79598da4c3740caf4 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 22 Apr 2020 21:03:08 +0000 Subject: [PATCH 6/6] + Xtensa: make use of ADDX* git-svn-id: trunk@45001 - --- .gitattributes | 1 + compiler/xtensa/cpunode.pas | 2 +- compiler/xtensa/ncpumem.pas | 89 +++++++++++++++++++++++++++++++++++ compiler/xtensa/xtensaatt.inc | 3 ++ compiler/xtensa/xtensaop.inc | 3 ++ 5 files changed, 97 insertions(+), 1 deletion(-) create mode 100644 compiler/xtensa/ncpumem.pas diff --git a/.gitattributes b/.gitattributes index 753382970a..da40e16398 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1034,6 +1034,7 @@ compiler/xtensa/ncpuadd.pas svneol=native#text/pascal compiler/xtensa/ncpucnv.pas svneol=native#text/pascal compiler/xtensa/ncpuinl.pas svneol=native#text/pascal compiler/xtensa/ncpumat.pas svneol=native#text/pascal +compiler/xtensa/ncpumem.pas svneol=native#text/pascal compiler/xtensa/ncpuutil.pas svneol=native#text/pascal compiler/xtensa/racpugas.pas svneol=native#text/pascal compiler/xtensa/raxtensa.pas svneol=native#text/pascal diff --git a/compiler/xtensa/cpunode.pas b/compiler/xtensa/cpunode.pas index 4ad1118c18..bfb23719b3 100644 --- a/compiler/xtensa/cpunode.pas +++ b/compiler/xtensa/cpunode.pas @@ -35,7 +35,7 @@ implementation symcpu, aasmdef {$ifndef llvm} - ,ncpuadd,ncpumat,ncpucnv,ncpuutil,ncpuinl//,ncpumem,ncpuset,ncpucon + ,ncpuadd,ncpumat,ncpucnv,ncpuutil,ncpuinl,ncpumem//,ncpuset,ncpucon {$else llvm} llvmnode {$endif llvm} diff --git a/compiler/xtensa/ncpumem.pas b/compiler/xtensa/ncpumem.pas new file mode 100644 index 0000000000..5ba9109f5a --- /dev/null +++ b/compiler/xtensa/ncpumem.pas @@ -0,0 +1,89 @@ +{ + Copyright (c) 1998-2020 by Florian Klaempfl + + Generate xtensa assembler for in memory related nodes + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit ncpumem; + +{$i fpcdefs.inc} + +interface + uses + globtype, + cgbase,cpubase, + symtype, + nmem,ncgmem; + + type + tcpuvecnode = class(tcgvecnode) + procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint);override; + end; + +implementation + + uses + cutils,verbose, + aasmdata,aasmcpu, + cgutils,cgobj, + symconst,symcpu; + +{***************************************************************************** + TCPUVECNODE +*****************************************************************************} + + procedure tcpuvecnode.update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); + var + hreg: tregister; + op: TAsmOp; + begin + if (l in [2,4,8]) and ((location.reference.base<>NR_NO) or (location.reference.index<>NR_NO)) then + begin + case l of + 2 : op:=A_ADDX2; + 4 : op:=A_ADDX4; + 8 : op:=A_ADDX8; + else + Internalerror(2020042201); + end; + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + if location.reference.base<>NR_NO then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,hreg,maybe_const_reg,location.reference.base)); + location.reference.base:=hreg; + end + else if location.reference.index<>NR_NO then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,hreg,maybe_const_reg,location.reference.index)); + location.reference.index:=hreg; + end + else + Internalerror(2020042202); + { update alignment } + if (location.reference.alignment=0) then + internalerror(2020042203); + location.reference.alignment:=newalignment(location.reference.alignment,l); + end + else + inherited update_reference_reg_mul(maybe_const_reg,regsize,l); + end; + +begin + cvecnode:=tcpuvecnode; +end. + diff --git a/compiler/xtensa/xtensaatt.inc b/compiler/xtensa/xtensaatt.inc index 044e3d2d31..801caab32c 100644 --- a/compiler/xtensa/xtensaatt.inc +++ b/compiler/xtensa/xtensaatt.inc @@ -2,6 +2,9 @@ '', 'abs', 'add', +'addx2', +'addx4', +'addx8', 'add.s', 'addi', 'addmi', diff --git a/compiler/xtensa/xtensaop.inc b/compiler/xtensa/xtensaop.inc index 943f82a69b..5716f4ecb5 100644 --- a/compiler/xtensa/xtensaop.inc +++ b/compiler/xtensa/xtensaop.inc @@ -2,6 +2,9 @@ A_NONE, A_ABS, A_ADD, +A_ADDX2, +A_ADDX4, +A_ADDX8, A_ADD_S, A_ADDI, A_ADDMI,