+ completed x86-64/linux system unit

rtl/i386/i386.inc

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

rtl/inc/except.inc

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

rtl/inc/filerec.inc

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

rtl/inc/textrec.inc

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

rtl/linux/i386/sighnd.inc

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

rtl/linux/ossysc.inc

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

rtl/linux/signal.inc

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

rtl/linux/x86_64/sighnd.inc

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

rtl/linux/x86_64/stat.inc

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

rtl/linux/x86_64/syscall.inc

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

rtl/x86_64/math.inc

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

rtl/x86_64/x86_64.inc

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