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

+ completed x86-64/linux system unit

Browse Source
This commit is contained in:
florian 2004-02-05 01:16:12 +00:00
parent 9393dc18bb
commit c9122a4719
12 changed files with 264 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/i386/i386.inc
View File

@ -25,12 +25,14 @@ procedure fpc_cpuinit;
begin
end;
function geteipasebx : pointer;assembler;[public,alias:'FPC_GETEIPINEBX'];
asm
movl (%esp),%ebx
ret
end;
{$ifndef FPC_SYSTEM_HAS_MOVE}
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:longint);assembler;
@ -1455,7 +1457,10 @@ end;
{
$Log$
Revision 1.58 2004-01-11 11:10:07 jonas
Revision 1.59 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.58 2004/01/11 11:10:07 jonas
+ cgeneric.inc: implementations of rtl routines based on libc
* system.inc: include cgeneric.inc before powerpc.inc/i386.inc/... if
FPC_USE_LIBC is defined

7
rtl/inc/except.inc
View File

@ -38,7 +38,7 @@ Type
TExceptObjectClass = Class of TObject;
Const
CatchAllExceptions = SizeInt(-1);
CatchAllExceptions : PtrInt = -1;
{$ifdef SUPPORT_THREADVAR}
ThreadVar
{$else SUPPORT_THREADVAR}
@ -311,7 +311,10 @@ begin
end;
{
$Log$
Revision 1.13 2003-11-26 20:12:08 michael
Revision 1.14 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.13 2003/11/26 20:12:08 michael
+ New runerror 231 (exception stack error) and 232 (nothread support)
Revision 1.12 2003/10/06 15:59:20 florian

9
rtl/inc/filerec.inc
View File

@ -26,8 +26,8 @@ const
type
FileRec = Packed Record
Handle : THandle;
Mode,
RecSize : longint;
Mode : longint;
RecSize : SizeInt;
_private : array[1..32] of byte;
UserData : array[1..16] of byte;
name : array[0..filerecnamelength] of char;
@ -35,7 +35,10 @@ type
{
$Log$
Revision 1.4 2003-11-03 09:42:27 marco
Revision 1.5 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.4 2003/11/03 09:42:27 marco
* Peter's Cardinal<->Longint fixes patch
Revision 1.3 2002/09/07 15:07:45 peter

7
rtl/inc/textrec.inc
View File

@ -32,7 +32,7 @@ type
bufsize,
_private,
bufpos,
bufend : longint;
bufend : SizeInt;
bufptr : ^textbuf;
openfunc,
inoutfunc,
@ -45,7 +45,10 @@ type
{
$Log$
Revision 1.4 2003-11-03 09:42:28 marco
Revision 1.5 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.4 2003/11/03 09:42:28 marco
* Peter's Cardinal<->Longint fixes patch
Revision 1.3 2002/09/07 15:07:46 peter

9
rtl/linux/i386/sighnd.inc
View File

@ -77,12 +77,13 @@ end;
{
$Log$
Revision 1.2 2003-11-01 01:58:11 marco
Revision 1.3 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.2 2003/11/01 01:58:11 marco
* more small fixes.
Revision 1.1 2003/11/01 01:27:20 marco
* initial version from 1.0.x branch
}

9
rtl/linux/ossysc.inc
View File

@ -361,6 +361,10 @@ type
{$define OLDMMAP}
{$endif cpuarm}
{$ifdef cpux86_64}
{$define OLDMMAP}
{$endif cpux86_64}
Function Fpmmap(adr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;off:off_t):pointer; [public, alias : 'FPC_SYSC_MMAP'];
// OFF_T procedure, and returns a pointer, NOT cint.
@ -475,7 +479,10 @@ end;
{
$Log$
Revision 1.14 2004-01-31 16:25:48 florian
Revision 1.15 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.14 2004/01/31 16:25:48 florian
* use wait4 instead of waitpid on arm
Revision 1.13 2004/01/23 00:00:06 florian

12
rtl/linux/signal.inc
View File

@ -133,7 +133,6 @@ type
{$ifdef cpupowerpc}
{ from include/ppc/ptrace.h }
pptregs = ^tptregs;
tptregs = record
@ -242,6 +241,12 @@ type
end;
{$endif cpusparc}
{$ifdef cpux86_64}
{ get it from glibc/sysdeps/unix/sysv/linux/x86_64/sys/uncontext.h }
PSigContextRec = ^SigContextRec;
SigContextRec = record
end;
{$endif cpux86_64}
{$ifdef cpuarm}
PSigContextRec = ^SigContextRec;
@ -342,7 +347,10 @@ type
{
$Log$
Revision 1.15 2004-01-01 16:28:16 jonas
Revision 1.16 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.15 2004/01/01 16:28:16 jonas
* fixed signal handling
Revision 1.14 2003/11/21 00:40:06 florian

93
rtl/linux/x86_64/sighnd.inc Normal file
View File

@ -0,0 +1,93 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt,
member of the Free Pascal development team.
Signal handler is arch dependant due to processor to language
exception conversion.
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
FPU_All = $7f;
function GetFPUState(const SigContext : SigContextRec) : longint;
begin
{!!!!!!!
if assigned(SigContext.fpstate) then
GetfpuState:=SigContext.fpstate^.sw;
{$ifdef SYSTEM_DEBUG}
writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
{$endif SYSTEM_DEBUG}
{$ifdef SYSTEM_DEBUG}
Writeln(stderr,'FpuState = ',GetFpuState);
{$endif SYSTEM_DEBUG}
}
end;
procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
var
res,fpustate : word;
begin
res:=0;
case sig of
SIGFPE :
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
res:=200;
fpustate:=GetFPUState(SigContext);
if (FpuState and FPU_All) <> 0 then
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 Then
res:=207
else if (FpuState and FPU_Invalid)<>0 then
res:=216
else
res:=207; {'Coprocessor Error'}
end;
sysResetFPU;
end;
SIGILL,
SIGBUS,
SIGSEGV :
res:=216;
end;
{ give runtime error at the position where the signal was raised }
{!!!!
if res<>0 then
HandleErrorAddrFrame(res,pointer(SigContext.eip),pointer(SigContext.ebp));
}
end;
{
$Log$
Revision 1.1 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.2 2003/11/01 01:58:11 marco
* more small fixes.
Revision 1.1 2003/11/01 01:27:20 marco
* initial version from 1.0.x branch
}

51
rtl/linux/x86_64/stat.inc Normal file
View File

@ -0,0 +1,51 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2004 by Jonas Maebe,
member of the Free Pascal development team.
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.
**********************************************************************}
{$ifndef FPC_USE_LIBC} // kernel record
stat = packed record
st_dev : qword;
st_ino : qword;
st_nlink : qword;
st_mode : dword;
st_uid : dword;
st_gid : dword;
__pad0 : dword;
st_rdev : qword;
st_size : int64;
st_blksize : int64;
st_blocks : int64; { Number 512-byte blocks allocated. }
st_atime : qword;
__reserved0 : qword; { reserved for atime.nanoseconds }
st_mtime : qword;
__reserved1 : qword; { reserved for atime.nanoseconds }
st_ctime : qword;
__reserved2 : qword; { reserved for atime.nanoseconds }
__unused : array[0..2] of int64;
end;
{$else}
(* get it from glibc/sysdeps/unix/sysv/linux/x86_64/bits/stat.h and check defines with gcc *)
{$endif}
{
$Log$
Revision 1.1 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
}

8
rtl/linux/x86_64/syscall.inc
View File

@ -17,7 +17,7 @@
**********************************************************************}
{$ASMMODE ATT}
{$ASMMODE GAS}
function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
@ -266,7 +266,6 @@ Procedure FpSysCall( callnr:TSysParam;var regs : SysCallregs );assembler;
This function puts the registers in place, does the call, and then
copies back the registers as they are after the SysCall.
}
{$ASMMODE ATT}
{$define fpc_syscall_ok}
asm
{ load the registers... }
@ -341,7 +340,10 @@ end;
{
$Log$
Revision 1.1 2003-04-30 22:11:06 florian
Revision 1.2 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.1 2003/04/30 22:11:06 florian
+ for a lot of x86-64 dependend files mostly dummies added
}

7
rtl/x86_64/math.inc
View File

@ -117,7 +117,7 @@
fwait
movw -4(%rbp),%cx
orw $0x0c3f,%cx
movw %cx,-8(rbp)
movw %cx,-8(%rbp)
fldcw -8(%rbp)
fwait
fldt d
@ -198,6 +198,9 @@
{
$Log$
Revision 1.1 2003-04-30 22:11:06 florian
Revision 1.2 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.1 2003/04/30 22:11:06 florian
+ for a lot of x86-64 dependend files mostly dummies added
}

66
rtl/x86_64/x86_64.inc
View File

@ -25,7 +25,52 @@
Primitives
****************************************************************************}
procedure fpc_cpuinit;
begin
end;
{$define FPC_SYSTEM_HAS_SPTR}
Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
movl %rsp,%rax
end ['RAX'];
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
movq %rbp,%rax
end ['RAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
{$ifndef REGCALL}
movq framebp,%rax
{$endif}
orq %rax,%rax
jz .Lg_a_null
movq 4(%rax),%rax
.Lg_a_null:
end ['RAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
{$ifndef REGCALL}
movl framebp,%rax
{$endif}
orl %rax,%rax
jz .Lgnf_null
movl (%rax),%rax
.Lgnf_null:
end ['RAX'];
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:longint);assembler;
asm
{ rdi destination
@ -237,9 +282,28 @@ procedure inclocked(var l : longint);assembler;
.Linclockedend:
end;
{****************************************************************************
FPU
****************************************************************************}
const
fpucw : word = $1332;
{ Internal constants for use in system unit }
FPU_Invalid = 1;
FPU_Denormal = 2;
FPU_DivisionByZero = 4;
FPU_Overflow = 8;
FPU_Underflow = $10;
FPU_StackUnderflow = $20;
FPU_StackOverflow = $40;
FPU_ExceptionMask = $ff;
{
$Log$
Revision 1.4 2004-01-20 12:52:18 florian
Revision 1.5 2004-02-05 01:16:12 florian
+ completed x86-64/linux system unit
Revision 1.4 2004/01/20 12:52:18 florian
* some problems with x86-64 inline assembler fixed
Revision 1.3 2003/05/01 08:05:23 florian