paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-19 18:59:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/z80@45010 -
This commit is contained in:
nickysn 2020-04-22 22:43:31 +00:00
commit a189ea4b0b
13 changed files with 220 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

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

2
compiler/aarch64/aasmcpu.pas
View File

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

2
compiler/aarch64/racpu.pas
View File

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

2
compiler/xtensa/cgcpu.pas
View File

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

2
compiler/xtensa/cpunode.pas
View File

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

89
compiler/xtensa/ncpumem.pas Normal file
View File

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

3
compiler/xtensa/xtensaatt.inc
View File

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

3
compiler/xtensa/xtensaop.inc
View File

@ -2,6 +2,9 @@
A_NONE,
A_ABS,
A_ADD,
A_ADDX2,
A_ADDX4,
A_ADDX8,
A_ADD_S,
A_ADDI,
A_ADDMI,

4
rtl/inc/ustrings.inc
View File

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

77
rtl/win/syswinh.inc Normal file
View File

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

68
rtl/win32/system.pp
View File

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

63
rtl/win64/system.pp
View File

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

31
tests/tbs/tb0669.pp Normal file
View File

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