* synchronized with trunk

git-svn-id: branches/z80@45010 -

.gitattributes

@@ -1039,6 +1039,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
@@ -12051,6 +12052,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
@@ -13259,6 +13261,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

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

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

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

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}

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

compiler/xtensa/xtensaatt.inc

@@ -2,6 +2,9 @@
 '',
 'abs',
 'add',
+'addx2',
+'addx4',
+'addx8',
 'add.s',
 'addi',
 'addmi',

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,

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}
 

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;

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
 

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
 

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.