Browse Source

* merged haiku fixes till r40831

git-svn-id: branches/fixes_3_2@42116 -
marco 6 năm trước cách đây
mục cha
commit
d5027fceeb

+ 5 - 10
.gitattributes

@@ -9371,31 +9371,24 @@ rtl/go32v2/v2prt0.as svneol=native#text/plain
 rtl/haiku/Makefile svneol=native#text/plain
 rtl/haiku/Makefile.fpc svneol=native#text/plain
 rtl/haiku/baseunix.pp svneol=native#text/plain
-rtl/haiku/bethreads.pp svneol=native#text/plain
 rtl/haiku/classes.pp svneol=native#text/plain
 rtl/haiku/errno.inc svneol=native#text/plain
 rtl/haiku/errnostr.inc svneol=native#text/plain
 rtl/haiku/i386/cprt0.as svneol=native#text/plain
 rtl/haiku/i386/dllcprt0.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.cpp svneol=native#text/plain
-rtl/haiku/i386/func.as svneol=native#text/plain
-rtl/haiku/i386/prt0.as svneol=native#text/plain
+rtl/haiku/i386/sig_cpu.inc svneol=native#text/plain
 rtl/haiku/i386/sighnd.inc svneol=native#text/plain
 rtl/haiku/osdefs.inc svneol=native#text/plain
 rtl/haiku/osmacro.inc svneol=native#text/plain
-rtl/haiku/ossysc.inc svneol=native#text/plain
 rtl/haiku/ostypes.inc svneol=native#text/plain
 rtl/haiku/pthread.inc svneol=native#text/plain
 rtl/haiku/ptypes.inc svneol=native#text/plain
 rtl/haiku/rtldefs.inc svneol=native#text/plain
-rtl/haiku/settimeo.inc svneol=native#text/plain
+rtl/haiku/si_c.pp svneol=native#text/plain
+rtl/haiku/si_dllc.pp svneol=native#text/plain
 rtl/haiku/signal.inc svneol=native#text/plain
 rtl/haiku/suuid.inc svneol=native#text/plain
-rtl/haiku/syscall.inc svneol=native#text/plain
-rtl/haiku/syscallh.inc svneol=native#text/plain
 rtl/haiku/sysconst.inc svneol=native#text/plain
-rtl/haiku/sysnr.inc svneol=native#text/plain
 rtl/haiku/sysos.inc svneol=native#text/plain
 rtl/haiku/sysosh.inc svneol=native#text/plain
 rtl/haiku/system.pp svneol=native#text/plain
@@ -9404,6 +9397,8 @@ rtl/haiku/termios.inc svneol=native#text/plain
 rtl/haiku/termiosproc.inc svneol=native#text/plain
 rtl/haiku/unxconst.inc svneol=native#text/plain
 rtl/haiku/unxfunc.inc svneol=native#text/plain
+rtl/haiku/x86_64/sig_cpu.inc svneol=native#text/plain
+rtl/haiku/x86_64/sighnd.inc svneol=native#text/plain
 rtl/i386/cpu.pp svneol=native#text/plain
 rtl/i386/cpuh.inc svneol=native#text/plain
 rtl/i386/cpuinnr.inc svneol=native#text/plain

+ 17 - 16
rtl/haiku/Makefile.fpc

@@ -6,17 +6,19 @@
 main=rtl
 
 [target]
-loaders=prt0 cprt0 dllcprt0 func dllprt
-units=system uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \
-#      beos \
+loaders=$(LOADERS)
+units=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \
       errors dos dl \
       sysconst sysutils \
       types charset cpall character typinfo classes fgl math \
-      cpu mmx getopts heaptrc lineinfo lnfodwrf \
-      rtlconsts syscall unix unixutil termio initc \
+      cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf \
+      rtlconsts unix unixutil termio initc \
       cmem \
       dynlibs cwstring cthreads \
       fpintres unixcp fpwidestring
+
+# beos syscall
+
 rsts=math typinfo sysconst rtlconsts
 implicitunits=exeinfo \
       cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
@@ -59,17 +61,24 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 HAIKUINC=$(RTL)/haiku
-
+LOADERS=cprt0 dllcprt0
+CPUUNITS=mmx
+SYSINITUNITS=si_c si_dllc
 UNITPREFIX=rtl
 
+ifeq ($(ARCH),x86_64)
+override LOADERS=
+override CPUUNITS=
+endif
+
+
 # Use new feature from 1.0.5 version
 # that generates release PPU files
 # which will not be recompiled
 ifdef RELEASE
 override FPCOPT+=-Ur
 endif
-
-override FPCOPT+= -dHASUNIX -n -dFPC_USE_LIBC -Si
+override FPCOPT+=-dFPC_USE_LIBC
 
 # Paths
 OBJPASDIR=$(RTL)/objpas
@@ -96,8 +105,6 @@ SYSTEMUNIT=system
 # Loaders
 #
 
-prt0$(OEXT) : $(CPU_TARGET)/prt0.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
 
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
@@ -105,12 +112,6 @@ cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 dllcprt0$(OEXT) : $(CPU_TARGET)/dllcprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)dllcprt0$(OEXT) $(CPU_TARGET)/dllcprt0.as
 
-func$(OEXT) : $(CPU_TARGET)/func.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
-
-dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
-
 #
 # system Units (system, Objpas, Strings)
 #

+ 13 - 82
rtl/haiku/baseunix.pp

@@ -25,39 +25,22 @@ Uses UnixType;
 
 {$packrecords C}
 
-{$ifndef FPC_USE_LIBC}
-  {$define FPC_USE_SYSCALL}
-{$endif}
-
 {$i errno.inc}          { Error numbers }
 {$i ostypes.inc}
 
-{$ifdef FPC_USE_LIBC}
-  const clib = 'root';
-  const netlib = 'network';
-  {$i oscdeclh.inc}
-{$ELSE}
-  {$i bunxh.inc}		{ Functions}
-{$ENDIF}
+const
+  clib = 'root';
+  netlib = 'network';
 
-function fpgeterrno:longint; 
-procedure fpseterrno(err:longint); 
+{$i oscdeclh.inc}
 
-{$ifndef ver1_0}
-property errno : cint read fpgeterrno write fpseterrno;
-{$endif}
+  function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+  procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+  property errno : cint read fpgeterrno write fpseterrno;
 
 {$i bunxovlh.inc}
 
-{$ifdef FPC_USE_LIBC}
-{$ifdef beos}
-function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
-Function fpFlock (var fd : text; mode : longint) : cint; 
-Function fpFlock (var fd : File; mode : longint) : cint; 
-Function fpFlock (fd, mode : longint) : cint; 
-Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
-{$endif}
-{$endif}
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
 
 {$i genfunch.inc}
 
@@ -73,7 +56,7 @@ Const
 
 // MAP_ANON(YMOUS) is OS dependant but used in the RTL and in ostypes.inc
 // Under BSD without -YMOUS, so alias it:
-  MAP_ANON	= MAP_ANONYMOUS;
+  MAP_ANON      = MAP_ANONYMOUS;
 
   PROT_READ     =  $1;          { page can be read }
   PROT_WRITE    =  $2;          { page can be written }
@@ -90,70 +73,18 @@ Uses Sysctl;
 {$I gensigset.inc}     // general sigset funcs implementation.
 {$I genfdset.inc}      // general fdset funcs.
 
-{$ifdef FPC_USE_LIBC}
-  {$i oscdecl.inc}        // implementation of wrappers in oscdeclh.inc
-{$else}
-  {$i syscallh.inc}       // do_syscall declarations themselves
-  {$i sysnr.inc}          // syscall numbers.
-  {$i bsyscall.inc}       // cpu specific syscalls
-  {$i bunxsysc.inc}       // syscalls in system unit.
-//  {$i settimeo.inc}
-{$endif}
-{$i settimeo.inc}
+{$i oscdecl.inc}        // implementation of wrappers in oscdeclh.inc
+
 {$i osmacro.inc}        { macro implenenations }
 {$i bunxovl.inc}        { redefs and overloads implementation }
 
-{$ifndef ver1_0}
-function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
-procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
-{$else}
-// workaround for 1.0.10 bugs.
-
-function intgeterrno:longint; external name 'FPC_SYS_GETERRNO';
-procedure intseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
-
-function fpgeterrno:longint; 
-begin
-  fpgeterrno:=intgeterrno;
-end;
-
-procedure fpseterrno(err:longint); 
-begin
-  intseterrno(err);
-end;
 
-{$endif}
+function stime(t: ptime_t): cint; cdecl; external clib name 'stime';
 
 function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
 begin
-  fpsettimeofday := settimeofday(tp, tzp);
-end;
-
-Function fpFlock (var fd : File; mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
-end;
-
-Function fpFlock (var fd : Text; mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
-end;
-
-Function fpFlock (fd, mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
+  fpsettimeofday:=stime(@tp^.tv_sec);
 end;
 
-function snooze(microseconds : bigtime_t) : status_t; cdecl; external 'root' name 'snooze';
-
-Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
-begin
-  case snooze((req^.tv_nsec div 1000) + (req^.tv_sec * 1000 * 1000)) of
-    B_OK : FpNanoSleep := 0;
-    B_INTERRUPTED : FpNanoSleep := - 1;
-    else
-      FpNanoSleep := - 1;
-  end;
-end;
 
 end.

+ 0 - 519
rtl/haiku/bethreads.pp

@@ -1,519 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by Peter Vreman,
-    member of the Free Pascal development team.
-
-    BeOS (bethreads) threading support implementation
-
-    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.
-
- **********************************************************************}
-{$mode objfpc}
-
-unit bethreads;
-interface
-{$S-}
-
-Procedure SetBeThreadManager;
-
-implementation
-
-Uses
-  systhrds,
-  BaseUnix,
-  unix,
-  unixtype,
-  sysutils;
-
-{*****************************************************************************
-                             Generic overloaded
-*****************************************************************************}
-
-{ Include OS specific parts. }
-
-{*****************************************************************************
-                             Threadvar support
-*****************************************************************************}
-
-{$ifdef HASTHREADVAR}
-    const
-      threadvarblocksize : dword = 0;
-
-    var
-      TLSKey : pthread_key_t;
-
-    procedure BeInitThreadvar(var offset : dword;size : dword);
-      begin
-        offset:=threadvarblocksize;
-        inc(threadvarblocksize,size);
-      end;
-
-    function BeRelocateThreadvar(offset : dword) : pointer;
-      begin
-        BeRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
-      end;
-
-
-    procedure BeAllocateThreadVars;
-      var
-        dataindex : pointer;
-      begin
-        { we've to allocate the memory from system  }
-        { because the FPC heap management uses      }
-        { exceptions which use threadvars but       }
-        { these aren't allocated yet ...            }
-        { allocate room on the heap for the thread vars }
-        DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
-        FillChar(DataIndex^,threadvarblocksize,0);
-        pthread_setspecific(tlskey,dataindex);
-      end;
-
-
-    procedure BeReleaseThreadVars;
-      begin
-        {$ifdef ver1_0}
-        Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize);
-        {$else}
-        Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
-        {$endif}
-      end;
-
-{ Include OS independent Threadvar initialization }
-
-{$endif HASTHREADVAR}
-
-
-{*****************************************************************************
-                            Thread starting
-*****************************************************************************}
-
-    type
-      pthreadinfo = ^tthreadinfo;
-      tthreadinfo = record
-        f : tthreadfunc;
-        p : pointer;
-        stklen : cardinal;
-      end;
-
-    procedure DoneThread;
-      begin
-        { Release Threadvars }
-{$ifdef HASTHREADVAR}
-        CReleaseThreadVars;
-{$endif HASTHREADVAR}
-      end;
-
-
-    function ThreadMain(param : pointer) : pointer;cdecl;
-      var
-        ti : tthreadinfo;
-{$ifdef DEBUG_MT}
-        // in here, don't use write/writeln before having called
-        // InitThread! I wonder if anyone ever debugged these routines,
-        // because they will have crashed if DEBUG_MT was enabled!
-        // this took me the good part of an hour to figure out
-        // why it was crashing all the time!
-        // this is kind of a workaround, we simply write(2) to fd 0
-        s: string[100]; // not an ansistring
-{$endif DEBUG_MT}
-      begin
-{$ifdef DEBUG_MT}
-        s := 'New thread started, initing threadvars'#10;
-        fpwrite(0,s[1],length(s));
-{$endif DEBUG_MT}
-{$ifdef HASTHREADVAR}
-        { Allocate local thread vars, this must be the first thing,
-          because the exception management and io depends on threadvars }
-        CAllocateThreadVars;
-{$endif HASTHREADVAR}
-        { Copy parameter to local data }
-{$ifdef DEBUG_MT}
-        s := 'New thread started, initialising ...'#10;
-        fpwrite(0,s[1],length(s));
-{$endif DEBUG_MT}
-        ti:=pthreadinfo(param)^;
-        dispose(pthreadinfo(param));
-        { Initialize thread }
-        InitThread(ti.stklen);
-        { Start thread function }
-{$ifdef DEBUG_MT}
-        writeln('Jumping to thread function');
-{$endif DEBUG_MT}
-        ThreadMain:=pointer(ti.f(ti.p));
-        DoneThread;
-        pthread_detach(pthread_t(pthread_self()));
-      end;
-
-
-    function BeBeginThread(sa : Pointer;stacksize : dword;
-                         ThreadFunction : tthreadfunc;p : pointer;
-                         creationFlags : dword; var ThreadId : THandle) : DWord;
-      var
-        ti : pthreadinfo;
-        thread_attr : pthread_attr_t;
-      begin
-{$ifdef DEBUG_MT}
-        writeln('Creating new thread');
-{$endif DEBUG_MT}
-        { Initialize multithreading if not done }
-        if not IsMultiThread then
-         begin
-{$ifdef HASTHREADVAR}
-          { We're still running in single thread mode, setup the TLS }
-           pthread_key_create(@TLSKey,nil);
-           InitThreadVars(@CRelocateThreadvar);
-{$endif HASTHREADVAR}
-           IsMultiThread:=true;
-         end;
-        { the only way to pass data to the newly created thread
-          in a MT safe way, is to use the heap }
-        new(ti);
-        ti^.f:=ThreadFunction;
-        ti^.p:=p;
-        ti^.stklen:=stacksize;
-        { call pthread_create }
-{$ifdef DEBUG_MT}
-        writeln('Starting new thread');
-{$endif DEBUG_MT}
-        pthread_attr_init(@thread_attr);
-        pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
-
-        // will fail under linux -- apparently unimplemented
-        pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
-
-        // don't create detached, we need to be able to join (waitfor) on
-        // the newly created thread!
-        //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
-        if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
-          threadid := 0;
-        end;
-        BeBeginThread:=threadid;
-{$ifdef DEBUG_MT}
-        writeln('BeginThread returning ',BeBeginThread);
-{$endif DEBUG_MT}
-      end;
-
-
-    procedure BeEndThread(ExitCode : DWord);
-      begin
-        DoneThread;
-        pthread_detach(pthread_t(pthread_self()));
-        pthread_exit(pointer(ExitCode));
-      end;
-
-
-{$warning threadhandle can be larger than a dword}
-    function  BeSuspendThread (threadHandle : dword) : dword;
-    begin
-      {$Warning SuspendThread needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeResumeThread  (threadHandle : dword) : dword;
-    begin
-      {$Warning ResumeThread needs to be implemented}
-    end;
-
-    procedure CThreadSwitch;  {give time to other threads}
-    begin
-      {extern int pthread_yield (void) __THROW;}
-      {$Warning ThreadSwitch needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeKillThread (threadHandle : dword) : dword;
-    begin
-      pthread_detach(pthread_t(threadHandle));
-      CKillThread := pthread_cancel(pthread_t(threadHandle));
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout}
-    var
-      LResultP: Pointer;
-      LResult: DWord;
-    begin
-      LResult := 0;
-      LResultP := @LResult;
-      pthread_join(pthread_t(threadHandle), @LResultP);
-      CWaitForThreadTerminate := LResult;
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
-    begin
-      {$Warning ThreadSetPriority needs to be implemented}
-    end;
-
-
-{$warning threadhandle can be larger than a dword}
-    function  BeThreadGetPriority (threadHandle : dword): Integer;
-    begin
-      {$Warning ThreadGetPriority needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeGetCurrentThreadId : dword;
-    begin
-      CGetCurrentThreadId:=dword(pthread_self());
-    end;
-
-
-{*****************************************************************************
-                          Delphi/Win32 compatibility
-*****************************************************************************}
-
-    procedure BeInitCriticalSection(var CS);
-
-    var
-      MAttr : pthread_mutexattr_t;
-      res: longint;
-    begin
-      res:=pthread_mutexattr_init(@MAttr);
-      if res=0 then
-        begin
-          res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
-          if res=0 then
-            res := pthread_mutex_init(@CS,@MAttr)
-          else
-            { No recursive mutex support :/ }
-            res := pthread_mutex_init(@CS,NIL);
-        end
-      else 
-        res:= pthread_mutex_init(@CS,NIL);
-      pthread_mutexattr_destroy(@MAttr);
-      if res <> 0 then
-        runerror(6);
-    end;                           
-
-    procedure BeEnterCriticalSection(var CS);
-      begin
-         if pthread_mutex_lock(@CS) <> 0 then
-           runerror(6);
-      end;
-
-    procedure BeLeaveCriticalSection(var CS);
-      begin
-         if pthread_mutex_unlock(@CS) <> 0 then
-           runerror(6)
-      end;
-
-    procedure BeDoneCriticalSection(var CS);
-      begin
-         if pthread_mutex_destroy(@CS) <> 0 then
-           runerror(6);
-      end;
-
-
-{*****************************************************************************
-                           Heap Mutex Protection
-*****************************************************************************}
-
-    var
-      HeapMutex : pthread_mutex_t;
-
-    procedure BeThreadHeapMutexInit;
-      begin
-         pthread_mutex_init(@heapmutex,nil);
-      end;
-
-    procedure BeThreadHeapMutexDone;
-      begin
-         pthread_mutex_destroy(@heapmutex);
-      end;
-
-    procedure BeThreadHeapMutexLock;
-      begin
-         pthread_mutex_lock(@heapmutex);
-      end;
-
-    procedure BeThreadHeapMutexUnlock;
-      begin
-         pthread_mutex_unlock(@heapmutex);
-      end;
-
-    const
-      BeThreadMemoryMutexManager : TMemoryMutexManager = (
-        MutexInit : @BeThreadHeapMutexInit;
-        MutexDone : @BeThreadHeapMutexDone;
-        MutexLock : @BeThreadHeapMutexLock;
-        MutexUnlock : @BeThreadHeapMutexUnlock;
-      );
-
-    procedure InitHeapMutexes;
-      begin
-        SetMemoryMutexManager(BeThreadMemoryMutexManager);
-      end;
-
-Function BeInitThreads : Boolean;
-
-begin
-{$ifdef DEBUG_MT}
-  Writeln('Entering InitThreads.');
-{$endif}  
-{$ifndef dynpthreads}
-  Result:=True;
-{$else}
-  Result:=LoadPthreads;
-{$endif}
-  ThreadID := SizeUInt (pthread_self);
-{$ifdef DEBUG_MT}
-  Writeln('InitThreads : ',Result);
-{$endif DEBUG_MT}
-end;
-
-Function BeDoneThreads : Boolean;
-
-begin
-{$ifndef dynpthreads}
-  Result:=True;
-{$else}
-  Result:=UnloadPthreads;
-{$endif}
-end;
-
-type
-     TPthreadMutex = pthread_mutex_t;
-     Tbasiceventstate=record
-         FSem: Pointer;
-         FManualReset: Boolean;
-         FEventSection: TPthreadMutex;
-	end;
-     plocaleventstate = ^tbasiceventstate;  
-//     peventstate=pointer;
-
-Const 
-	wrSignaled = 0;
-	wrTimeout  = 1;
-	wrAbandoned= 2;
-	wrError	   = 3;
-
-function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
-
-var
-  MAttr : pthread_mutexattr_t;
-  res   : cint;
-
-
-begin
-  new(plocaleventstate(result));
-  plocaleventstate(result)^.FManualReset:=AManualReset;
-  plocaleventstate(result)^.FSem:=New(PSemaphore);  //sem_t.
-//  plocaleventstate(result)^.feventsection:=nil;
-  res:=pthread_mutexattr_init(@MAttr);
-  if res=0 then
-    begin
-      res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
-      if Res=0 then
-        Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
-      else
-        res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
-    end
-  else
-    res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
-  pthread_mutexattr_destroy(@MAttr);
-  if res <> 0 then
-    runerror(6);
-  if sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState)) <> 0 then
-    runerror(6);
-end;
-
-procedure Intbasiceventdestroy(state:peventstate);
-
-begin
-  sem_destroy(psem_t(  plocaleventstate(state)^.FSem));
-end;
-
-procedure IntbasiceventResetEvent(state:peventstate);
-
-begin
-  While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
-    ;
-end;
-
-procedure IntbasiceventSetEvent(state:peventstate);
-
-Var
-  Value : Longint;
-
-begin
-  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
-  Try
-    sem_getvalue(plocaleventstate(state)^.FSem,@value);
-    if Value=0 then
-      sem_post(psem_t( plocaleventstate(state)^.FSem));
-  finally
-    pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
-  end;
-end;
-
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
-
-begin
-  If TimeOut<>Cardinal($FFFFFFFF) then
-    result:=wrError
-  else
-    begin
-      sem_wait(psem_t(plocaleventstate(state)^.FSem));
-      result:=wrSignaled;
-      if plocaleventstate(state)^.FManualReset then
-        begin
-          pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
-          Try
-              intbasiceventresetevent(State);
-              sem_post(psem_t( plocaleventstate(state)^.FSem));
-            Finally
-          pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
-        end;
-      end;
-    end;
-end;
-
-Var
-  BeThreadManager : TThreadManager;
-
-Procedure SetBeThreadManager;
-
-begin
-  With BeThreadManager do
-    begin
-    InitManager            :=@BeInitThreads;
-    DoneManager            :=@BeDoneThreads;
-    BeginThread            :=@BeBeginThread;
-    EndThread              :=@BeEndThread;
-    SuspendThread          :=@BeSuspendThread;
-    ResumeThread           :=@BeResumeThread;
-    KillThread             :=@BeKillThread;
-    ThreadSwitch           :=@BeThreadSwitch;
-    WaitForThreadTerminate :=@BeWaitForThreadTerminate;
-    ThreadSetPriority      :=@BeThreadSetPriority;
-    ThreadGetPriority      :=@BeThreadGetPriority;
-    GetCurrentThreadId     :=@BeGetCurrentThreadId;
-    InitCriticalSection    :=@BeInitCriticalSection;
-    DoneCriticalSection    :=@BeDoneCriticalSection;
-    EnterCriticalSection   :=@BeEnterCriticalSection;
-    LeaveCriticalSection   :=@BeLeaveCriticalSection;
-{$ifdef hasthreadvar}
-    InitThreadVar          :=@BeInitThreadVar;
-    RelocateThreadVar      :=@BeRelocateThreadVar;
-    AllocateThreadVars     :=@BeAllocateThreadVars;
-    ReleaseThreadVars      :=@BeReleaseThreadVars;
-{$endif}
-    BasicEventCreate       :=@intBasicEventCreate;       
-    BasicEventDestroy      :=@intBasicEventDestroy;
-    BasicEventResetEvent   :=@intBasicEventResetEvent;
-    BasicEventSetEvent     :=@intBasicEventSetEvent;
-    BasiceventWaitFor      :=@intBasiceventWaitFor;
-    end;
-  SetThreadManager(BeThreadManager);
-  InitHeapMutexes;
-end;
-
-initialization
-  SetBeThreadManager;
-end.

+ 0 - 159
rtl/haiku/i386/cprt0.as

@@ -57,165 +57,6 @@ _haltproc:
         call exit
 
 
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret
-
-/* actual syscall */
-.globl sys_call
-.type sys_call,@function
-sys_call:
-int $0x25
-ret
-
 .bss
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_argc,4

+ 3 - 163
rtl/haiku/i386/dllcprt0.as

@@ -7,8 +7,8 @@ default_environ:
 .globl initialize_after
         .type    initialize_after,@function
 initialize_after:
-	.globl FPC_SHARED_LIB_START
-	.type FPC_SHARED_LIB_START,@function
+        .globl FPC_SHARED_LIB_START
+        .type FPC_SHARED_LIB_START,@function
 FPC_SHARED_LIB_START:
         /* We are in a library if we link something against this code */
         movb $1,operatingsystem_islibrary
@@ -40,168 +40,8 @@ _haltproc:
         pushl %ebx
         call exit
 
-
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret
-
-/* actual syscall */
-.globl sys_call
-.type sys_call,@function
-sys_call:
-int $0x25
-ret
-
 .bss
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_argc,4
         .comm operatingsystem_parameter_argv,4
-	
+

+ 0 - 170
rtl/haiku/i386/dllprt.as

@@ -1,170 +0,0 @@
-       .file   "dllprt.cpp"
-.text
-        .p2align 2
-.globl _._7FPC_DLL
-        .type    _._7FPC_DLL,@function
-_._7FPC_DLL:
-.LFB1:
-        pushl %ebp
-.LCFI0:
-        movl %esp,%ebp
-.LCFI1:
-        pushl %esi
-.LCFI2:
-        pushl %ebx
-.LCFI3:
-        call .L7
-.L7:
-        popl %ebx
-        addl $_GLOBAL_OFFSET_TABLE_+[.-.L7],%ebx
-        movl 8(%ebp),%esi
-.L3:
-        movl 12(%ebp),%eax
-        andl $1,%eax
-        testl %eax,%eax
-        je .L5
-        pushl %esi
-.LCFI4:
-        call __builtin_delete@PLT
-        addl $4,%esp
-        jmp .L5
-        .p2align 4,,7
-.L4:
-.L5:
-.L2:
-        leal -8(%ebp),%esp
-        popl %ebx
-        popl %esi
-        movl %ebp,%esp
-        popl %ebp
-        ret
-.LFE1:
-.Lfe1:
-        .size    _._7FPC_DLL,.Lfe1-_._7FPC_DLL
-.section        .rodata
-.LC0:
-        .string "dll"
-.data
-        .align 4
-        .type    _argv,@object
-        .size    _argv,8
-_argv:
-        .long .LC0
-        .long 0
-        .align 4
-        .type    _envp,@object
-        .size    _envp,4
-_envp:
-        .long 0
-.text
-        .p2align 2
-.globl __7FPC_DLL
-        .type    __7FPC_DLL,@function
-__7FPC_DLL:
-.LFB2:
-        pushl %ebp
-.LCFI5:
-        movl %esp,%ebp
-.LCFI6:
-        pushl %ebx
-.LCFI7:
-        call .L11
-.L11:
-        popl %ebx
-        addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
-        movl operatingsystem_parameter_argc@GOT(%ebx),%eax
-        movl $0,(%eax)
-        movl operatingsystem_parameter_argv@GOT(%ebx),%eax
-        movl %ebx,%ecx
-        addl $_argv@GOTOFF,%ecx
-        movl %ecx,%edx
-        movl %edx,(%eax)
-        movl operatingsystem_parameter_envp@GOT(%ebx),%eax
-        movl %ebx,%ecx
-        addl $_envp@GOTOFF,%ecx
-        movl %ecx,%edx
-        movl %edx,(%eax)
-        call PASCALMAIN__Fv@PLT
-.L9:
-        movl 8(%ebp),%eax
-        jmp .L8
-.L8:
-        movl -4(%ebp),%ebx
-        movl %ebp,%esp
-        popl %ebp
-        ret
-.LFE2:
-.Lfe2:
-        .size    __7FPC_DLL,.Lfe2-__7FPC_DLL
-
-.section        .eh_frame,"aw",@progbits
-__FRAME_BEGIN__:
-        .4byte  .LLCIE1
-.LSCIE1:
-        .4byte  0x0
-        .byte   0x1
-        .byte   0x0
-        .byte   0x1
-        .byte   0x7c
-        .byte   0x8
-        .byte   0xc
-        .byte   0x4
-        .byte   0x4
-        .byte   0x88
-        .byte   0x1
-        .align 4
-.LECIE1:
-        .set    .LLCIE1,.LECIE1-.LSCIE1
-        .4byte  .LLFDE1
-.LSFDE1:
-        .4byte  .LSFDE1-__FRAME_BEGIN__
-        .4byte  .LFB1
-        .4byte  .LFE1-.LFB1
-        .byte   0x4
-        .4byte  .LCFI0-.LFB1
-        .byte   0xe
-        .byte   0x8
-        .byte   0x85
-        .byte   0x2
-        .byte   0x4
-        .4byte  .LCFI1-.LCFI0
-        .byte   0xd
-        .byte   0x5
-        .byte   0x4
-        .4byte  .LCFI2-.LCFI1
-        .byte   0x86
-        .byte   0x3
-        .byte   0x4
-        .4byte  .LCFI3-.LCFI2
-        .byte   0x83
-        .byte   0x4
-        .byte   0x4
-        .4byte  .LCFI4-.LCFI3
-        .byte   0x2e
-        .byte   0x4
-        .align 4
-.LEFDE1:
-        .set    .LLFDE1,.LEFDE1-.LSFDE1
-        .4byte  .LLFDE3
-.LSFDE3:
-        .4byte  .LSFDE3-__FRAME_BEGIN__
-        .4byte  .LFB2
-        .4byte  .LFE2-.LFB2
-        .byte   0x4
-        .4byte  .LCFI5-.LFB2
-        .byte   0xe
-        .byte   0x8
-        .byte   0x85
-        .byte   0x2
-        .byte   0x4
-        .4byte  .LCFI6-.LCFI5
-        .byte   0xd
-        .byte   0x5
-        .byte   0x4
-        .4byte  .LCFI7-.LCFI6
-        .byte   0x83
-        .byte   0x3
-        .align 4
-.LEFDE3:
-        .set    .LLFDE3,.LEFDE3-.LSFDE3
-        .ident  "GCC: (GNU) 2.9-beos-991026"

+ 0 - 39
rtl/haiku/i386/dllprt.cpp

@@ -1,39 +0,0 @@
-#include <stdio.h>
-
-class FPC_DLL
-{
-  public:
-    FPC_DLL();
-//    ~FPC_DLL();
-};
-
-static FPC_DLL fpc_dll();
-
-//FPC_DLL::~FPC_DLL()
-//{
-//      printf ("main thread ended.");
-//}
-
-
-extern "C" void PASCALMAIN(void);
-extern int operatingsystem_parameter_argc;
-extern void * operatingsystem_parameter_argv;
-extern void * operatingsystem_parameter_envp;
-
-static char * _argv[] = {"dll",0};
-static char * _envp[] = {0};
-
-extern "C" void BEGIN()
-{
-        printf ("init\n");
-        operatingsystem_parameter_argc=0;
-        operatingsystem_parameter_argv = (void *)_argv;
-        operatingsystem_parameter_envp = (void *)_envp;
-        PASCALMAIN();
-}
-
-FPC_DLL::FPC_DLL()
-{
-  BEGIN();
-}
-

+ 0 - 161
rtl/haiku/i386/func.as

@@ -1,161 +0,0 @@
-       .file   "func.s"
-.text
-
-.globl  _haltproc
-.type   _haltproc,@function
-_haltproc:
-        xorl %ebx,%ebx
-    movw operatingsystem_result,%bx
-        pushl %ebx
-        call sys_exit
-
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret

+ 0 - 186
rtl/haiku/i386/prt0.as

@@ -1,186 +0,0 @@
-       .file   "prt0.c"
-.text
-.globl start
-        .type    start,@function
-start:
-        pushl %ebp
-        movl %esp,%ebp
-        movl 16(%ebp),%ecx
-        movl 12(%ebp),%ebx
-        movl 8(%ebp),%eax
-        movl %eax,operatingsystem_parameter_argc
-        movl %ebx,operatingsystem_parameter_argv
-        movl %ecx,operatingsystem_parameter_envp
-        xorl %ebp,%ebp
-        call PASCALMAIN
-
-.globl  _haltproc
-.type   _haltproc,@function
-_haltproc:
-        xorl %ebx,%ebx
-        movw operatingsystem_result,%bx
-        pushl %ebx
-        call sys_exit
-
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret
-
-/* actual syscall */
-.globl sys_call
-.type sys_call,@function
-sys_call:
-int $0x25
-ret
-
-.bss
-        .comm operatingsystem_parameter_envp,4
-        .comm operatingsystem_parameter_argc,4
-        .comm operatingsystem_parameter_argv,4

+ 157 - 0
rtl/haiku/i386/sig_cpu.inc

@@ -0,0 +1,157 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 the Free Pascal development team.
+
+    i386 specific signal handler structure
+
+    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.
+
+ **********************************************************************}
+
+{*
+ * Architecture-specific structure passed to signal handlers
+ *}
+
+{$PACKRECORDS C}
+type
+  packed_fp_stack = record
+    st0 : array[0..9] of byte;
+    st1 : array[0..9] of byte;
+    st2 : array[0..9] of byte;
+    st3 : array[0..9] of byte;
+    st4 : array[0..9] of byte;
+    st5 : array[0..9] of byte;
+    st6 : array[0..9] of byte;
+    st7 : array[0..9] of byte;
+  end;
+
+  packed_mmx_regs = record
+    mm0 : array[0..9] of byte;
+    mm1 : array[0..9] of byte;
+    mm2 : array[0..9] of byte;
+    mm3 : array[0..9] of byte;
+    mm4 : array[0..9] of byte;
+    mm5 : array[0..9] of byte;
+    mm6 : array[0..9] of byte;
+    mm7 : array[0..9] of byte;
+  end;
+
+  old_extended_regs = record
+    fp_control: word;
+    _reserved1: word;
+    fp_status: word;
+    _reserved2: word;
+    fp_tag: word;
+    _reserved3: word;
+    fp_eip: cardinal;
+    fp_cs: word;
+    fp_opcode: word;
+    fp_datap: dword;
+    fp_ds: word;
+    _reserved4: word;
+    fp_mmx : record
+      case fp_mmx : byte of
+        0 : (fp: packed_fp_stack);
+        1 : (mmx: packed_mmx_regs);
+    end;
+  end;
+
+  fp_stack = record
+    st0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    st1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    st2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    st3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    st4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    st5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    st6 : array[0..9] of byte;    
+    _reserved_138_143 : array[0..5] of byte;
+    st7 : array[0..9] of byte;        
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+
+  mmx_regs = record
+    mm0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    mm1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    mm2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    mm3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    mm4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    mm5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    mm6 : array[0..9] of byte;
+    _reserved_138_143 : array[0..5] of byte;
+    mm7 : array[0..9] of byte;
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+
+  xmmx_regs = record
+    xmm0 : array [0..15] of byte;
+    xmm1 : array [0..15] of byte;
+    xmm2 : array [0..15] of byte;
+    xmm3 : array [0..15] of byte;
+    xmm4 : array [0..15] of byte;
+    xmm5 : array [0..15] of byte;
+    xmm6 : array [0..15] of byte;
+    xmm7 : array [0..15] of byte;
+  end;
+
+  new_extended_regs = record
+    fp_control: word;
+    fp_status: word;
+    fp_tag: word;
+    fp_opcode: word;
+    fp_eip: dword;
+    fp_cs: word;
+    res_14_15: word;
+    fp_datap: dword;
+    fp_ds: word;
+    _reserved_22_23: word;
+    mxcsr: dword;
+    _reserved_28_31: dword;
+    fp_mmx : record
+      case byte of
+        0 : (fp : fp_stack);
+        1 : (mmx : mmx_regs);
+    end;
+    xmmx: xmmx_regs;
+    _reserved_288_511 : array[0..223] of byte;
+  end;
+
+  extended_regs = record
+    state : record
+      case byte of
+        0 : (old_format : old_extended_regs);
+        1 : (new_format : new_extended_regs);
+      end;
+    format: dword;
+  end;
+
+  vregs = record
+    eip: dword;
+    eflags: dword;
+    eax: dword;
+    ecx: dword;
+    edx: dword;
+    esp: dword;
+    ebp: dword;
+    _reserved_1: dword;
+    xregs: extended_regs;
+    edi: dword;
+    esi: dword;
+    ebx: dword;
+  end;

+ 6 - 6
rtl/haiku/i386/sighnd.inc

@@ -29,8 +29,8 @@ begin
         res:=200;
         // fp_status always here under BeOS and x86 CPU
         // (fp_status is not behind a pointer in the BeOS context record)
-        FpuState:=ucontext^.xregs.state.old_format.fp_status;
-            
+        FpuState:=ucontext^.uc_mcontext.xregs.state.old_format.fp_status;
+
         if (FpuState and FPU_ExceptionMask) <> 0 then
           begin
             { first check the more precise options }
@@ -47,7 +47,7 @@ begin
             else
               res:=207;  {'Coprocessor Error'}
           end;
-        with ucontext^.xregs.state.old_format do
+        with ucontext^.uc_mcontext.xregs.state.old_format do
         begin
           fp_status := fp_status and not FPU_ExceptionMask;
         end;
@@ -63,7 +63,7 @@ begin
         begin
           os_supports_sse := false;
           res := 0;
-          inc(ucontext^.eip, 3);
+          inc(ucontext^.uc_mcontext.eip, 3);
         end
       else
         res:=216;
@@ -85,8 +85,8 @@ begin
 { give runtime error at the position where the signal was raised }
   if res<>0 then
   begin
-    HandleErrorAddrFrame(res, pointer(ucontext^.eip),
-                              pointer(ucontext^.ebp));    
+    HandleErrorAddrFrame(res, pointer(ucontext^.uc_mcontext.eip),
+                              pointer(ucontext^.uc_mcontext.ebp));
   end;
 end;
 

+ 0 - 1061
rtl/haiku/ossysc.inc

@@ -1,1061 +0,0 @@
-{
-    Copyright (c) 2002 by Marco van de Voort
-
-    The base *BSD syscalls required to implement the system unit. These
-    are aliased for use in other units (to avoid poluting the system units
-    interface)
-
-    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.
-
- ****************************************************************************
-}
-
-{$i ostypes.inc}
-
-{$ifdef FPC_USE_LIBC}
-  {$Linklib root}
-  // Out of date atm.
-const clib = 'root';
-const netlib = 'network';
-
-
-{$ifdef FPC_IS_SYSTEM}
-{$i oscdeclh.inc}
-{$endif}
-{$I osmacro.inc}
-
-{   var
-     Errno : cint; external name 'errno';
-
-    function Fptime(tloc:ptime_t): time_t; cdecl; external name 'time';
-    function Fpopen(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
-    function Fpclose(fd : cint): cint; cdecl; external name 'close';
-    function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
-    function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
-    function Fpwrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
-    function Fpunlink(const path: pchar): cint; cdecl; external name 'unlink';
-    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
-    function Fpstat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
-    function Fpchdir(const path : pchar): cint; cdecl; external name 'chdir';
-    function Fpmkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
-    function Fprmdir(const path : pchar): cint; cdecl; external name 'rmdir';
-    function Fpopendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
-    function Fpreaddir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
-    function Fpclosedir(var dirp : dir): cint; cdecl; external name 'closedir';
-    procedure Fpexit(status : cint); cdecl; external name '_exit';
-    function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
-    function Fpftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
-    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
-    function Fpfstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
-    function Fpfork : pid_t; cdecl; external name 'fork';
-    function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
-    function Fpwaitpid(pid : pid_t; tat_loc : pcint; options: cint): pid_t; cdecl; external name 'waitpid';
-    function Fpaccess(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
-
-    function Fpuname(var name: utsname): cint; cdecl; external name 'uname';
-
-    function FpDup(oldd:cint):cint; cdecl; external name 'dup';
-    function FpDup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
-}
-{$else}
-
-{*****************************************************************************
-                     --- Main:The System Call Self ---
-*****************************************************************************}
-
-{ The system designed for Linux can't be used for *BSD so easily, since
-  *BSD pushes arguments, instead of loading them to registers.}
-
-// Var ErrNo : Longint;
-
-{$I syscallh.inc}
-{$I syscall.inc}
-{$I sysnr.inc}
-{$I osmacro.inc}
-
-// Should be moved to a FreeBSD specific unit in the future.
-
-function Fptime( tloc:ptime): time_t; [public, alias : 'FPC_SYSC_TIME'];
-
-{VAR tv     : timeval;
-    tz     : timezone;
-    retval : longint;
-}
-var
-  args : SysCallArgs;
-begin
-    { don't treat errno, since there is never any }
-    tloc^ := Do_Syscall(syscall_nr_time,args);
-    fptime := tloc^;
-{begin
-//  Retval:=do_syscall(syscall_nr_gettimeofday,TSysParam(@tv),TSysParam(@tz));
-  If retval=-1 then
-   Fptime:=-1
-  else
-   Begin
-   If Assigned(tloc) Then
-     TLoc^:=tv.tv_sec;
-    Fptime:=tv.tv_sec;
-   End;
-}
-End;
-
-{*****************************************************************************
-               --- File:File handling related calls ---
-*****************************************************************************}
-
-function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
-var
-  args: SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  args.param[3] := flags;
-  args.param[4] := cint(mode);
-  args.param[5] := 0;               { close on execute flag }
-  fpopen:= SysCall(syscall_nr_open, args);   
-{Begin
- Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
-}
-End;
-
-function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE'];
-var
-  args : SysCallArgs;
-begin
-  args.param[1] := fd;
-  fpclose:=SysCall(syscall_nr_close,args);
-{begin
- Fpclose:=do_syscall(syscall_nr_close,fd);
-}
-end;
-
-{$ifdef netbsd}
-  {$ifdef cpupowerpc}
-    {$define netbsdmacppc}
-  {$endif}
-{$endif}
-
-{$ifdef netbsdmacppc}
-{$i sysofft.inc}                        // odd ball calling convention.
-{$else}
-  // generic versions.
-function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK'];
-
-{
-this one is special for the return value being 64-bit..
-hi/lo offset not yet tested.
-
-NetBSD: ok, but implicit return value in edx:eax
-FreeBSD: same implementation as NetBSD.
-}
-var
-  args: SysCallArgs;
-
-begin
-  args.param[1] := fd;
-  args.param[2] := cint(offset and $FFFFFFFF);      
-  args.param[3] := cint((offset shr 32) and $FFFFFFFF);
-  args.param[4] := whence;
-  { we currently only support seeks upto 32-bit in length }
-  fplseek := off_t(SysCall(syscall_nr_lseek,args));
-(*begin
-  Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence);
-*)
-end;
-
-type
-  { _kwstat_ kernel call structure }
-  pwstat = ^twstat;
-  twstat = packed record
-{00}   filler : array[1..3] of longint;
-{12}   newmode : mode_t;     { chmod mode_t parameter }
-{16}   unknown1 : longint;  
-{20}   newuser : uid_t;      { chown uid_t parameter  } 
-{24}   newgroup : gid_t;     { chown gid_t parameter  }
-{28}   trunc_offset : off_t; { ftrucnate parameter    }
-{36}   unknown2 : array[1..2] of longint;
-{44}   utime_param: int64;  
-{52}   unknown3 : array[1..2] of longint;
-  end;
-  
-function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
-var
-  args: SysCallArgs;
-  wstat : pwstat;
-begin
-  New(wstat);
-  FillChar(wstat^,sizeof(wstat),0);
-  wstat^.trunc_offset := flength;
-  args.param[1] := fd;
-  args.param[2] := $00000000;
-  args.param[3] := cint(wstat);
-  args.param[4] := $00000008;
-  args.param[5] := $00000001;
-  fpftruncate:=SysCall(syscall_nr_ftruncate, args);
-  Dispose(wstat);
-{begin
- Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
-}
-end;
-
-const
-  B_OS_NAME_LENGTH = 32;
-  B_PAGE_SIZE = 4096;  
-
-const
-  B_NO_LOCK       = 0;
-  B_LAZY_LOCK     = 1;
-  B_FULL_LOCK     = 2;
-  B_CONTIGUOUS    = 3;
-  B_LOMEM         = 4;
-
-  B_ANY_ADDRESS        = 0;
-  B_EXACT_ADDRESS      = 1;
-  B_BASE_ADDRESS       = 2;
-  B_CLONE_ADDRESS      = 3;
-  B_ANY_KERNEL_ADDRESS = 4;
-
-  B_READ_AREA  = 1;
-  B_WRITE_AREA = 2;
-
-type
-  area_id   = Longint;
-  
-function create_area(name : pchar; var addr : longint;
-  addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
-var
- args : SysCallArgs;
-begin
- args.param[1] := cint(name);
- args.param[2] := cint(@addr);
- args.param[3] := cint(addr_typ);
- args.param[4] := cint(size);
- args.param[5] := cint(lock_type);
- args.param[6] := cint(protection);
- create_area := SysCall(syscall_nr_create_area, args);
-end;
-
-Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias:  'FPC_SYSC_MMAP'];
-var
-  heap_handle : area_id;
-const
-  zero=0;
-  myheapsize=$20000;
-  myheaprealsize=$20000;
-var
-  myheapstart:pointer;
-  s : string;
-begin
-  WriteLn('fpmmap');
-  Str(len, s);
-  WriteLn(s);
-  myheapstart:=start;
-{$IFDEF FPC_USE_LIBC}  
-  heap_handle := create_area('fpcheap',myheapstart,0,len,0,3);//!!
-{$ELSE}
-  heap_handle := create_area('fpcheap',longint(myheapstart),0,len,0,3);//!!
-{$ENDIF}
-  case heap_handle of
-    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
-    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
-    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
-    B_ERROR : WriteLn('B_ERROR');
-  end;
-
-  fpmmap := myheapstart;
-// not available under BeOS
-//  Fpmmap:=pointer(longint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,{$ifdef cpupowerpc}0,{$endif}offst{$ifdef cpui386},0{$endif})));
-end;
-
-{$endif}
-
-
-function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
-var
-  args : SysCallArgs;
-  funcresult: ssize_t;
-  errorcode : cint;
-begin
-  args.param[1] := fd;
-  args.param[2] := cint(buf);
-  args.param[3] := cint(nbytes);
-  args.param[4] := cint(@errorcode);
-  funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
-  if funcresult >= 0 then
-   begin
-     fpread := funcresult;
-     errno := 0;
-   end
-  else
-   begin
-     fpread := -1;
-     errno := errorcode;
-   end;
-{begin
-  Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
-}
-end;
-
-//function Fpmywrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
-
-function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
-var
-  args : SysCallArgs;
-  funcresult : ssize_t;
-  errorcode : cint;
-begin
-  errorcode := 0;
-  // There is a bug in syscall in 1.9 under BeOS !!!
-  // Fixed ! 26/05/2004 ! See in syscall.inc
-  args.param[1] := fd;
-  args.param[2] := cint(buf);
-  args.param[3] := cint(nbytes);
-  args.param[4] := cint(@errorcode);
-  funcresult := Do_SysCall(syscall_nr_write,args);
-
-//  funcresult := Fpmywrite(fd, buf, nbytes);
-
-  if funcresult >= 0 then
-   begin
-     fpwrite := funcresult;
-     errno := 0;
-   end
-  else
-   begin
-     fpwrite := -1; 
-     errno := errorcode;
-   end;
-{begin
- Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
-}
-end;
-
-function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
-var
-  args :SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  fpunlink := SysCall(syscall_nr_unlink,args);
-{begin
-  Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
-}
-end;
-
-function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
-var
-  args: SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(old);
-  args.param[3] := $FFFFFFFF;
-  args.param[4] := cint(newpath);
-  fprename := SysCall(syscall_nr_rename,args);
-{begin
-  Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath));
-}
-end;
-
-function Fpstat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
-var
-  args : SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  args.param[3] := cint(@buf);
-  args.param[4] := $01000000;
-  fpstat := SysCall(syscall_nr_stat, args);
-{begin
- Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf));
-}
-end;
-
-
-{*****************************************************************************
-               --- Directory:Directory related calls ---
-*****************************************************************************}
-
-function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
-var
-  args: SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  fpchdir := SysCall(syscall_nr_chdir, args);
-{begin
- Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
-}
-end;
-
-function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
-var
-  args :SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  args.param[3] := cint(mode);
-  fpmkdir := SysCall(syscall_nr_mkdir,args);
-(*begin {Mode is 16-bit on F-BSD 4!}
-  Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),mode);
-*)
-end;
-
-function Fprmdir(path : pchar): cint;  [public, alias : 'FPC_SYSC_RMDIR'];
-var
-  args: SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(path);
-  fprmdir := SysCall(syscall_nr_rmdir,args);
-{begin
- Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path));
-}
-end;
-
-{$ifndef NewReaddir}
-
-const DIRBLKSIZ=1024;
-
-
-function Fpopendir(dirname : pchar): pdir;  [public, alias : 'FPC_SYSC_OPENDIR'];
-var
-  args : SysCallArgs;
-  dirp: pdir;
-  fd : cint;
-begin
-  New(dirp);
-  { just in case }
-  FillChar(dirp^,sizeof(dir),#0);
-  if assigned(dirp) then
-	 begin
-	   args.param[1] := $FFFFFFFF;
-     args.param[2] := cint(dirname);
- 	   args.param[3] := 0;
-     fd:=SysCall(syscall_nr_opendir,args);
-	   if fd = -1 then
-	    begin
-	      Dispose(dirp);
-	      fpopendir := nil;
-	      exit;
-	    end;
-	   dirp^.fd := fd;
-	   fpopendir := dirp;
-	   exit;
-	 end;
-  Errno := ESysEMFILE;
-  fpopendir := nil;
-(*var
-  fd:longint;
-  st:stat;
-  ptr:pdir;
-begin
-  Fpopendir:=nil;
-  if Fpstat(dirname,st)<0 then
-   exit;
-{ Is it a dir ? }
-  if not((st.st_mode and $f000)=$4000)then
-   begin
-     errno:=ESysENOTDIR;
-     exit
-   end;
-{ Open it}
-  fd:=Fpopen(dirname,O_RDONLY,438);
-  if fd<0 then
-   Begin
-    Errno:=-1;
-    exit;
-   End;
-  new(ptr);
-  if ptr=nil then
-   Begin
-    Errno:=1;
-    exit;
-   End;
-  Getmem(ptr^.dd_buf,2*DIRBLKSIZ);
-  if ptr^.dd_buf=nil then
-   exit;
-  ptr^.dd_fd:=fd;
-  ptr^.dd_loc:=-1;
-  ptr^.dd_rewind:=longint(ptr^.dd_buf);
-  ptr^.dd_size:=0;
-//  ptr^.dd_max:=sizeof(ptr^.dd_buf^);
-  Fpopendir:=ptr;
-*)
-end;
-
-function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
-var
-  args : SysCallArgs;
-begin
-  if assigned(dirp) then
-   begin
-	   args.param[1] := dirp^.fd;
-	   fpclosedir := SysCall(syscall_nr_closedir,args);
-	   Dispose(dirp);
-	   dirp := nil;
-	   exit;
-    end;
-   Errno := ESysEBADF;
-   fpclosedir := -1;
-{begin
-  Fpclosedir:=Fpclose(dirp^.dd_fd);
-  Freemem(dirp^.dd_buf);
-  dispose(dirp);
-}
-end;
-
-function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR'];
-
-{Different from Linux, Readdir on BSD is based on Getdents, due to the
-missing of the readdir syscall.
-Getdents requires the buffer to be larger than the blocksize.
-This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks
-with blockmode have this higher?}
-
-(*function readbuffer:longint;
-
-var retval :longint;
-
-begin
- Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
-   dirp^.dd_rewind:=TSysParam(dirp^.dd_buf);
-   if retval=0 then
-    begin
-     dirp^.dd_rewind:=0;
-     dirp^.dd_loc:=0;
-    end
-   else
-    dirP^.dd_loc:=retval;
- readbuffer:=retval;
-end;*)
-var
-  args : SysCallArgs;
-  funcresult : cint;
-begin
-  args.param[1] := dirp^.fd;
-  args.param[2] := cint(@(dirp^.ent));
-  args.param[3] := $0000011C;
-  args.param[4] := $00000001;
-  { the error will be processed here }
-  funcresult := Do_SysCall(syscall_nr_readdir, args);
-  if funcresult <> 1 then
-   begin
-     if funcresult <> 0 then
-       errno := funcresult;
-     fpreaddir := nil;
-     exit;
-   end;
-  errno := 0;
-  fpreaddir := @dirp^.ent
-(*
-var
-    FinalEntry     : pdirent;
-    novalid        : boolean;
-    Reclen         : Longint;
-    CurEntry       : PDirent;
-
-begin
- if (dirp^.dd_buf=nil) or (dirp^.dd_loc=0) THEN
-  exit(nil);
- if (dirp^.dd_loc=-1)   OR     {First readdir on this pdir. Initial fill of buffer}
-   (dirp^.dd_rewind>=(longint(dirp^.dd_buf)+dirblksiz)) then  {no more entries left?}
-  Begin
-    if readbuffer=0 then        {succesful read?}
-     Exit(NIL);                 {No more data}
-  End;
- FinalEntry:=NIL;
- CurEntry:=nil;
- repeat
-  novalid:=false;
-  CurEntry:=pdirent(dirp^.dd_rewind);
-  RecLen:=CurEntry^.d_reclen;
-  if RecLen<>0 Then
-   begin {valid direntry?}
-    if CurEntry^.d_fileno<>0 then
-     FinalEntry:=CurEntry;
-    inc(dirp^.dd_rewind,Reclen);
-   end
-  else
-   begin {block entirely searched or reclen=0}
-    Novalid:=True;
-    if dirp^.dd_loc<>0 THEN             {blocks left?}
-     if readbuffer()<>0 then        {succesful read?}
-      novalid:=false;
-   end;
- until (FinalEntry<>nil) or novalid;
- If novalid then
-  FinalEntry:=nil;
- FpReadDir:=FinalEntry;*)
-end;
-{$endif}
-
-{*****************************************************************************
-        --- Process:Process & program handling - related calls ---
-*****************************************************************************}
-
-procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT'];
-var
-  args : SysCallArgs;
-begin
-//  sys_exit(status);
-  args.param[1] := status;
-  do_syscall(syscall_nr_exit, args);
-end;
-
-{
-  Change action of process upon receipt of a signal.
-  Signum specifies the signal (all except SigKill and SigStop).
-  If Act is non-nil, it is used to specify the new action.
-  If OldAct is non-nil the previous action is saved there.
-}
-
-function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
-
-{
-  Change action of process upon receipt of a signal.
-  Signum specifies the signal (all except SigKill and SigStop).
-  If Act is non-nil, it is used to specify the new action.
-  If OldAct is non-nil the previous action is saved there.
-}
-var
-  args : SysCallArgs;
-begin
-  args.param[1] := sig;
-  args.param[2] := cint(@act);
-  args.param[3] := cint(@oact);
-  fpsigaction := SysCall(syscall_nr_sigaction, args);
-//begin
-//  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
-end;
-
-(*=================== MOVED from sysunix.inc ========================*)
-
-
-function Fpfstat(fd : cint; var sb : stat): cint;  [public, alias : 'FPC_SYSC_FSTAT'];
-
-var
-  args : SysCallArgs;
-begin
-  args.param[1] := fd;
-  args.param[2] := $00;
-  args.param[3] := cint(@sb);
-  args.param[4] := $00000001;
-  fpfstat := SysCall(syscall_nr_fstat, args);
-
-{begin
-  fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb));
-}
-end;
-
-{$ifdef NewReaddir}
-{$I readdir.inc}
-{$endif}
-
-
-function fork : pid_t; external 'root' name 'fork';
-{ These routines are currently not required for BeOS }
-function Fpfork : pid_t;  [public, alias : 'FPC_SYSC_FORK'];
-{
-  This function issues the 'fork' System call. the program is duplicated in memory
-  and Execution continues in parent and child process.
-  In the parent process, fork returns the PID of the child. In the child process,
-  zero is returned.
-  A negative value indicates that an error has occurred, the error is returned in
-  LinuxError.
-}
-
-Begin
-  WriteLn('fpfork');
-  fpfork := fork;
-// Not required for BeOS
-// Fpfork:=Do_syscall(SysCall_nr_fork);
-End;
-
-{
-function Fpexecve(const path : pathstr; const argv : ppchar; const envp: ppchar): cint;
-}
-{
-  Replaces the current program by the program specified in path,
-  arguments in args are passed to Execve.
-  environment specified in ep is passed on.
-}
-
-{
-Begin
-  path:=path+#0;
-  do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp));
-End;
-}
-{
-function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;  [public, alias : 'FPC_SYSC_EXECVE'];
-}
-{
-  Replaces the current program by the program specified in path,
-  arguments in args are passed to Execve.
-  environment specified in ep is passed on.
-}
-{
-Begin
-  do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp));
-End;
-}
-function waitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; external 'root' name 'waitpid';
-function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID'];
-{
-  Waits until a child with PID Pid exits, or returns if it is exited already.
-  Any resources used by the child are freed.
-  The exit status is reported in the adress referred to by Status. It should
-  be a longint.
-}
-
-begin // actually a wait4() call with 4th arg 0.
-  FpWaitPID := waitpid(pid, stat_loc, options);
-// FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options,0);
-end;
-
-function Fpaccess(const pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
-{
-  Test users access rights on the specified file.
-  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
-  R,W,X stand for read,write and Execute access, simultaneously.
-  F_OK checks whether the test would be allowed on the file.
-  i.e. It checks the search permissions in all directory components
-  of the path.
-  The test is done with the real user-ID, instead of the effective.
-  If access is denied, or an error occurred, false is returned.
-  If access is granted, true is returned.
-  Errors other than no access,are reported in unixerror.
-}
-var
-  args : SysCallArgs;
-begin
-  args.param[1] := $FFFFFFFF;
-  args.param[2] := cint(pathname);
-  args.param[3] := amode;
-  fpaccess := SysCall(syscall_nr_access,args);
-
-{begin
- FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
-}
-end;
-(*
-function Fpaccess(const pathname : pathstr; amode : cint): cint;
-
-{
-  Test users access rights on the specified file.
-  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
-  R,W,X stand for read,write and Execute access, simultaneously.
-  F_OK checks whether the test would be allowed on the file.
-  i.e. It checks the search permissions in all directory components
-  of the path.
-  The test is done with the real user-ID, instead of the effective.
-  If access is denied, or an error occurred, false is returned.
-  If access is granted, true is returned.
-  Errors other than no access,are reported in unixerror.
-}
-
-begin
- pathname:=pathname+#0;
- Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0;
-end;
-*)
-
-Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
-
-begin
-  {$warning TODO BeOS FpDup implementation}
-//  Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
-end;
-
-Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
-
-begin
-  {$warning TODO BeOS FpDup2 implementation}
-// Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
-end;
-
-
-
-Function Fpmunmap(start:pointer;len:size_t):cint;    [public, alias :'FPC_SYSC_MUNMAP'];
-begin
-  {$warning TODO BeOS Fpmunmap implementation}
-//  Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len);
-end;
-
-
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-
-Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL'];
-// This was missing here, instead hardcoded in Do_IsDevice
-begin
-  {$warning TODO BeOS FpIOCtl implementation}
-//  FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
-end;
-
-
-Function FpGetPid:LongInt;   [public, alias : 'FPC_SYSC_GETPID'];
-{
-  Get Process ID.
-}
-
-begin
-  {$warning TODO BeOS FpGetPid implementation}
-// FpGetPID:=do_syscall(syscall_nr_getpid);
-end;
-
-function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY'];
-
-begin
-  {$warning TODO BeOS fpgettimeofday implementation}
-// fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
-end;
-
-function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK'];
-
-{
-  Change the list of currently blocked signals.
-  How determines which signals will be blocked :
-   SigBlock   : Add SSet to the current list of blocked signals
-   SigUnBlock : Remove the signals in SSet from the list of blocked signals.
-   SigSetMask : Set the list of blocked signals to SSet
-  if OldSSet is non-null, the old set will be saved there.
-}
-
-begin
-  {$warning TODO BeOS FPSigProcMask implementation}
-//  FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
-end;
-{$user BLA!}
-Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
-begin
-  {$warning TODO BeOS FpNanoSleep implementation}
-{$ifndef darwin}
-//  FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
-{$else not darwin}
-{$warning: TODO: nanosleep!!!}
-{$endif not darwin}
-end;
-
-function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
-{$ifndef darwin}
-const intpathmax = 1024-4;      // didn't use POSIX data in libc
-                                // implementation.
-var ept,bpt : pchar;
-    c       : char;
-    ret     : cint;
-
-begin
-  {$warning TODO BeOS Fpgetcwd implementation}
-(*   if pt=NIL Then
-    begin
-      // POSIX: undefined. (exit(nil) ?)
-      // BSD  : allocate mem for path.
-      getmem(pt,intpathmax);
-      if pt=nil Then
-        exit(nil);
-      ept:=pt+intpathmax;
-    end
-   else
-    Begin
-      if (_size=0) Then
-        Begin
-          seterrno(ESysEINVAL);
-          exit(nil);
-        End;
-      if (_size=1) Then
-        Begin
-          seterrno(ESysERANGE);
-          exit(nil);
-        End;
-      ept:=pt+_size;
-    end;
-
-    ret := do_syscall(syscall_nr___getcwd,TSysParam(pt),TSysParam( ept - pt));
-    If (ret = 0) Then
-        If (pt[0] <> '/') Then
-           Begin
-             bpt := pt;
-             ept := pt + strlen(pt) - 1;
-             While (bpt < ept) Do
-               Begin
-                 c := bpt^;
-                 bpt^:=ept^;
-                 inc(bpt);
-                 ept^:=c;
-                 dec(ept);
-               End;
-           End;
- Fpgetcwd:=pt;*)
-end;
-{$else not darwin}
-{$i getcwd.inc}
-{$endif darwin}
-
-{$endif}
-
-Function Do_IsDevice(Handle:Longint):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-begin
-  do_isdevice:= (handle=StdInputHandle) or
-                (handle=StdOutputHandle) or
-                (handle=StdErrorHandle);
-end;
-
-{
-extern _IMPEXP_ROOT status_t  get_image_symbol(image_id imid,
-                  const char *name, int32 sclass,  void **ptr);
-extern _IMPEXP_ROOT status_t  get_nth_image_symbol(image_id imid, int32 index,
-                  char *buf, int32 *bufsize, int32 *sclass,
-                  void **ptr);
-}
-
-// 
-{$ifdef FPC_USE_LIBC}
-
-// private; use the macros, below
-function _get_image_info(image : image_id; var info : image_info; size : size_t)
-         : status_t; cdecl; external 'root' name '_get_image_info';
-
-function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t)
-         : status_t; cdecl; external 'root' name '_get_next_image_info';
-
-function get_image_info(image : image_id; var info : image_info) : status_t;
-begin
-  Result := _get_image_info(image, info, SizeOf(info));
-end;
-
-function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
-begin
-  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
-end;
-
-{$else}
-
-    function wait_for_thread(thread: thread_id; var status : status_t): status_t;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(thread);
-       args.param[2] := cint(@status);
-       wait_for_thread := SysCall(syscall_nr_wait_thread, args);
-     end;
-
-    function get_team_info(team: team_id; var info : team_info): status_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(team);
-       args.param[2] := cint(@info);
-       get_team_info := SysCall(syscall_nr_get_team_info, args);
-     end;
-
-
-    function kill_team(team: team_id): status_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(team);
-       kill_team := SysCall(syscall_nr_kill_team, args);
-     end;
-
-  function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
-     var
-      args: SysCallArgs;
-   begin
-       args.param[1] := cint(team);
-       args.param[2] := cint(@cookie);
-       args.param[3] := cint(@info);
-       args.param[4] := cint(sizeof(image_info));
-       get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
-   end;       
-
-    function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(argc);
-       args.param[2] := cint(argv);
-       args.param[3] := cint(envp);
-       load_image := SysCall(syscall_nr_load_image, args);
-     end;
-    
-    function get_system_info(var info: system_info): status_t;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(@info);
-       i := SysCall(syscall_nr_get_system_info, args);
-       get_system_info := i;
-     end;
-
-    function dev_for_path(const pathname : pchar): dev_t;
-     var
-      args: SysCallArgs;
-      buffer: array[1..15] of longint;
-      i: cint;
-     begin
-       args.param[1] := $FFFFFFFF;
-       args.param[2] := cint(pathname);
-       args.param[3] := cint(@buffer);
-       args.param[4] := $01000000;
-       if SysCall(syscall_nr_rstat, args)=0 then
-          i:=buffer[1]
-       else
-          i:=-1;
-       dev_for_path := i;
-     end;
-
-
-    function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(device);
-       args.param[2] := 0;
-       args.param[3] := $FFFFFFFF;
-       args.param[4] := 0;
-       args.param[5] := cint(@info);
-       fs_stat_dev := SysCall(syscall_nr_statfs, args);
-     end;
-     
-{$endif}
-
-
-(* Implemented in sytem under BeOS
-CONST
- { Constansts for MMAP }
-  MAP_PRIVATE   =2;
-  MAP_ANONYMOUS =$1000;
-
-Function sbrk(size : cint) : pointer;
-begin
-  sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
-  if sbrk=pointer(-1) then
-    sbrk:=nil
-  else
-    seterrno(0);
-end;
-*)
-
-

+ 71 - 112
rtl/haiku/ostypes.inc

@@ -29,32 +29,16 @@
 {$ENDIF}
 
 Type
-  timezone = packed record
+  timezone = record
     tz_minuteswest,tz_dsttime:cint;
   end;
   ptimezone =^timezone;
   TTimeZone = timezone;
-  
-  rusage = packed record
-        ru_utime    : timeval;          { user time used }
-        ru_stime    : timeval;          { system time used }
-        ru_maxrss   : clong;            { max resident set size }
-        ru_ixrss    : clong;            { integral shared memory size }
-        ru_idrss    : clong;            { integral unshared data " }
-        ru_isrss    : clong;            { integral unshared stack " }
-        ru_minflt   : clong;            { page reclaims }
-        ru_majflt   : clong;            { page faults }
-        ru_nswap    : clong;            { swaps }
-        ru_inblock  : clong;            { block input operations }
-        ru_oublock  : clong;            { block output operations }
-        ru_msgsnd   : clong;            { messages sent }
-        ru_msgrcv   : clong;            { messages received }
-        ru_nsignals : clong;            { signals received }
-        ru_nvcsw    : clong;            { voluntary context switches }
-        ru_nivcsw   : clong;            { involuntary " }
-        end;
-// #define      ru_last         ru_nivcsw
-// #define      ru_first        ru_ixrss
+
+  rusage =  record
+    ru_utime    : timeval;          { user time used }
+    ru_stime    : timeval;          { system time used }
+  end;
 
 { auto generated by a c prog, statmacr.c}
 
@@ -78,15 +62,13 @@ Const
 //    _UTSNAME_LENGTH = ;
 //    _UTSNAME_NODENAME_LENGTH = ;
 
-CONST                		// OS specific parameters for general<fd,sig>set behaviour
+CONST               // OS specific parameters for general<fd,sig>set behaviour
    BITSINWORD      = 8*sizeof(longint);
-//   SIG_MAXSIG      = 32;    //128;	// highest signal version
-   FD_MAXFDSET	   = 1024;
-//   wordsinsigset   = 4;		// words in sigset_t
+   FD_MAXFDSET     = 1024;
    ln2bitsinword   = 5;         { 32bit : ln(32)/ln(2)=5 } 
    ln2bitmask	   = 2 shl ln2bitsinword - 1;
-   wordsinfdset    = FD_MAXFDSET DIV BITSINWORD;        // words in fdset_t   
-   wordsinsigset   = SIG_MAXSIG  DIV BITSINWORD;      
+   wordsinfdset    = FD_MAXFDSET DIV BITSINWORD;        // words in fdset_t
+   wordsinsigset   = SIG_MAXSIG  DIV BITSINWORD;
 
 TYPE
    { system information services }
@@ -100,8 +82,10 @@ TYPE
   TUtsName= utsname;
   pUtsName= ^utsname;
 
+{$packrecords c}
+
   { file characteristics services }
-   stat    = packed record { the types are real}
+   stat    = record { the types are real}
         st_dev        : dev_t;             // inode's device
         st_ino        : ino_t;             // inode's number
         st_mode       : mode_t;            // inode protection mode
@@ -119,86 +103,66 @@ TYPE
         st_ctimensec  : clong;             // nsec of last file status change
         st_crtime     : time_t;            // time of creation file
         st_crtimensec : clong;             // nsec of creation file
-		st_type       : cint;              // attribute/index type
+        st_type       : cint;              // attribute/index type
         st_blocks     : fsblkcnt_t;        // blocks allocated for file
    end;
-   
+
    TStat = stat;
    pStat = ^stat;
 
-  { directory services }
-   dirent = packed record
-        d_dev:longint;
-        d_pdev:longint;
-        d_ino:int64;
-        d_pino:int64;
-        d_reclen:word;
-        d_name:array[0..255] of char;
+   { directory services }
+   dirent = record
+        d_dev : dev_t;
+        d_pdev : dev_t;
+        d_ino : ino_t;
+        d_pino : ino_t;
+        d_reclen : cushort;
+        d_name : array[0..255] of char;
    end;
-(*   dirent  = record
-     d_dev : dev_t;
-     d_pdev : dev_t;
-     d_ino : ino_t;
-     d_pino : ino_t;
-     d_reclen : word;
-     d_name : Char;
-//        d_fileno      : cuint32;                        // file number of entry
-//        d_reclen      : cuint16;                        // length of this record
-//        d_type        : cuint8;                         // file type, see below
-//        d_namlen      : cuint8;                         // length of string in d_name
-//        d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
-   end;*)
    TDirent = dirent;
    pDirent = ^dirent;
 
-   dir     = packed record
-        fd     : cint;         // file descriptor associated with directory
-        ent : dirent;
-//        dd_loc    : clong;        // offset in current buffer
-//        dd_size   : clong;        // amount of data returned by getdirentries
-//        dd_buf    : pchar;        // data buffer
-//        dd_len    : cint;         // size of data buffer
-{$ifdef netbsdpowerpc}
-//	dd_pad1   : cint;
-//        dd_seek   : cint64;        // magic cookie returned by getdirentries
-{$else}
-//        dd_seek   : clong;        // magic cookie returned by getdirentries
-{$endif}
-//        dd_rewind : clong;        // magic cookie for rewinding
-//        dd_flags  : cint;         // flags for readdir
+   dir = record
+        fd : cint;         // file descriptor associated with directory
+        next_entry : cshort;
+        entries_left : cushort;
+        seek_position : clong;
+        current_position : clong;
+        first_entry : dirent;
    end;
    TDir    = dir;
    pDir    = ^dir;
 
-   utimbuf  = record
-	        actime  : time_t;
-	        modtime : time_t;
-	        end;
+   utimbuf = record
+        actime  : time_t;
+        modtime : time_t;
+   end;
    TUtimBuf = utimbuf;
    putimbuf = ^utimbuf;
 
-   flock    = record
-		l_start : off_t;	{ starting offset }
-		l_len	: off_t;	{ len = 0 means until end of file }
-		l_pid 	: pid_t;	{ lock owner }
-		l_type	: cshort;	{ lock type: read/write, etc. }
-		l_whence: cshort;	{ type of l_start }
-                end;
+   flock = record
+        l_type : cshort;    { lock type: read/write, etc. }
+        l_whence : cshort;  { type of l_start }
+        l_start : off_t;    { starting offset }
+        l_len : off_t;      { len = 0 means until end of file }
+        l_pid : pid_t;      { lock owner }
+   end;
    TFlock   = flock;
    pFlock   = ^flock;
 
- tms = packed record
-	 tms_utime  : clock_t;	{ User CPU time }
-	 tms_stime  : clock_t;	{ System CPU time }
-	 tms_cutime : clock_t;	{ User CPU time of terminated child procs }
-	 tms_cstime : clock_t;	{ System CPU time of terminated child procs }
-	 end;
- TTms= tms;
- pTms= ^tms;
+   tms = record
+        tms_utime  : clock_t;   { User CPU time }
+        tms_stime  : clock_t;   { System CPU time }
+        tms_cutime : clock_t;   { User CPU time of terminated child procs }
+        tms_cstime : clock_t;   { System CPU time of terminated child procs }
+   end;
+   TTms= tms;
+   pTms= ^tms;
 
- TFDSetEl  = Cardinal;
- TFDSet    = ARRAY[0..(FD_MAXFDSET div 32)-1] of TFDSetEl;
- pFDSet    = ^TFDSet;
+type
+   TFDSetEl  = Cardinal;
+   TFDSet    = ARRAY[0..(FD_MAXFDSET div 32)-1] of TFDSetEl;
+   pFDSet    = ^TFDSet;
 
 {***********************************************************************}
 {                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
@@ -242,19 +206,19 @@ CONST
     WNOHANG   =          1;     { don't block waiting               }
     WUNTRACED =          2;     { report status of stopped children }
 
-Type 
-        TRLimit  = record
-                     rlim_cur,               { current (soft) limit }
-          	     rlim_max : TRLim;     { maximum value for rlim_cur }
-		    end;	
-        PRLimit  = ^TRLimit;
+type
+    TRLimit  = record
+        rlim_cur,               { current (soft) limit }
+        rlim_max : TRLim;     { maximum value for rlim_cur }
+    end;
+    PRLimit  = ^TRLimit;
 
- iovec = record
-            iov_base : pointer;
-	    iov_len  : size_t;
-	   end;
-  tiovec=iovec;
-  piovec=^tiovec;		
+    iovec = record
+        iov_base : pointer;
+        iov_len  : size_t;
+    end;
+    tiovec=iovec;
+    piovec=^tiovec;
 
 
     {*************************************************************************}
@@ -310,10 +274,11 @@ const
    B_LIBRARY_IMAGE = 2;
    B_ADD_ON_IMAGE  = 3;
    B_SYSTEM_IMAGE  = 4;
+
 type
-    image_info = packed record
-     id      : image_id;   
-     _type   : longint;
+   image_info = record
+     id: image_id;
+     _type: longint;
      sequence: longint;
      init_order: longint;
      init_routine: pointer;
@@ -321,18 +286,12 @@ type
      device: dev_t;
      node: ino_t;
      name: array[0..1024{MAXPATHLEN}-1] of char;
-{     name: string[255];
-     name2: string[255];
-     name3: string[255];
-     name4: string[255];
-     name5: string[5];
-}
      text: pointer;
      data: pointer;
      text_size: longint;
      data_size: longint;
-    end;
-    
+   end;
+
 (*----- symbol types and functions ------------------------*)
 
 const B_SYMBOL_TYPE_DATA = $1;

+ 55 - 41
rtl/haiku/ptypes.inc

@@ -21,20 +21,22 @@
 
 {$i ctypes.inc}
 
+{$packrecords c}
+
 type
   fsblkcnt_t = clonglong;
-  TStatfs = packed record
-    bsize 			: Cardinal;
-    frsize			: Cardinal;
-    blocks			: fsblkcnt_t;
-    bfree			: fsblkcnt_t;
-    bavail			: fsblkcnt_t;
-    files			: fsblkcnt_t;
-    ffree			: fsblkcnt_t;
-    favail			: fsblkcnt_t;
-    fsid			: Cardinal;
-    flag			: Cardinal;
-    namemax			: Cardinal;
+  TStatfs = record
+    bsize   : culong;
+    frsize  : culong;
+    blocks  : fsblkcnt_t;
+    bfree   : fsblkcnt_t;
+    bavail  : fsblkcnt_t;
+    files   : fsblkcnt_t;
+    ffree   : fsblkcnt_t;
+    favail  : fsblkcnt_t;
+    fsid    : culong;
+    flag    : culong;
+    namemax : culong;
   end;
   PStatFS=^TStatFS;
 
@@ -42,20 +44,20 @@ type
     converter : pointer;
     charset : array[0..63] of char;
     count : cuint;
-    data : array[0..1023+8] of char;	{ 1024 bytes for data, 8 for alignment space }
+    data : array[0..1023+8] of char;  { 1024 bytes for data, 8 for alignment space }
   end;
   pmbstate_t = ^mbstate_t;
 
-    dev_t    = cuint32;         { used for device numbers      }
+    dev_t    = cint32;         { used for device numbers      }
     TDev     = dev_t;
     pDev     = ^dev_t;
 
-    gid_t    = cuint32;         { used for group IDs           }
+    gid_t    = cint32;         { used for group IDs           }
     TGid     = gid_t;
     pGid     = ^gid_t;
     TIOCtlRequest = cuLong;
 
-    ino_t    = clonglong;           { used for file serial numbers }
+    ino_t    = cint64;           { used for file serial numbers }
     TIno     = ino_t;
     pIno     = ^ino_t;
 
@@ -75,29 +77,39 @@ type
     TPid     = pid_t;
     pPid     = ^pid_t;
 
-    wint_t	 = cint32;
+{$ifdef cpu64}
+    size_t   = cuint64;         { as definied in the C standard}
+    ssize_t  = cint64;          { used by function for returning number of bytes }
+    time_t   = cint64;           { used for returning the time  }
+{$else}
     size_t   = cuint32;         { as definied in the C standard}
+    ssize_t  = cint32;          { used by function for returning number of bytes }
+    time_t   = clong;           { used for returning the time  }
+{$endif}
+
+    wint_t   = cint32;
     TSize    = size_t;
     pSize    = ^size_t;
-    psize_t   = pSize;		
+    psize_t  = pSize;
 
-    ssize_t  = cint32;          { used by function for returning number of bytes }
     TsSize   = ssize_t;
-    psSize   = ^ssize_t;		
+    psSize   = ^ssize_t;
 
     uid_t    = cuint32;         { used for user ID type        }
     TUid     = Uid_t;
     pUid     = ^Uid_t;
 
-    clock_t  = culong;
+    clock_t  = cint32;
+    suseconds_t = cint32;
+    useconds_t = cuint32;
+
     TClock   = clock_t;
     pClock   = ^clock_t;
 
-    time_t   = clong;           { used for returning the time  }
     // TTime    = time_t;    // Not allowed in system unit, -> unixtype
     pTime    = ^time_t;
     ptime_t =  ^time_t;
-    
+
     wchar_t   = cint32;
     pwchar_t  = ^wchar_t;
 
@@ -105,21 +117,23 @@ type
     TSocklen = socklen_t;
     pSocklen = ^socklen_t;
 
-  timeval  = packed record
-    tv_sec,tv_usec:clong;
-  end;
-  ptimeval = ^timeval;
-  TTimeVal = timeval;
+    timeval  = record
+      tv_sec: time_t;
+      tv_usec: suseconds_t;
+    end;
+    ptimeval = ^timeval;
+    TTimeVal = timeval;
+
+    timespec = record
+      tv_sec   : time_t;
+      tv_nsec  : clong;
+    end;
+
+    ptimespec= ^timespec;
+    Ttimespec= timespec;
 
-  timespec = packed record
-    tv_sec   : time_t;
-    tv_nsec  : clong;
-  end;
-  ptimespec= ^timespec;
-  Ttimespec= timespec;
-  
   pthread_t = culong;
-  
+
   sched_param = record
     __sched_priority: cint;
   end;
@@ -159,7 +173,7 @@ type
     __padding: array[0..48-1-sizeof(_pthread_fastlock)-sizeof(pointer)-sizeof(clonglong)] of byte;
     __align: clonglong;
   end;
-    
+
   pthread_condattr_t = record
     __dummy: cint;
   end;
@@ -186,8 +200,8 @@ type
      __sem_waiting: pointer;
   end;
 
-   rlim_t		= int64;
-   TRlim		= rlim_t;
+   rlim_t = int64;
+   TRlim  = rlim_t;
 
 
 CONST
@@ -212,8 +226,8 @@ CONST
     PATH_MAX = 1024;    {255}   { Maximum number of bytes in pathname }
 
     SYS_NMLN = 32;              {BSD utsname struct limit}
-    
-    SIG_MAXSIG = 32; //128;	// highest signal version  // BeOS  
+
+    SIG_MAXSIG = 64;    { __MAX_SIGNO in signal.h }
 
 const
   { For getting/setting priority }

+ 0 - 49
rtl/haiku/settimeo.inc

@@ -1,49 +0,0 @@
-{
-   This file is part of the Free Pascal run time library.
-   Copyright (c) 2004 by Michael Van Canneyt,
-   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.
-
-**********************************************************************}
-{$ifdef beos}
-{$ifdef i386}
-  {$define usestime}
-{$endif}
-{$endif}
-
-{$ifdef usestime}
-
-{$ifdef FPC_USE_LIBC}
-function stime (t:ptime_t):cint; cdecl; external name 'stime';
-{$else}
-function stime (t:ptime_t):cint; 
-begin
- stime:=do_SysCall(Syscall_nr_stime,TSysParam(t));
-end;
-{$endif}
-
-function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
-
-begin
-  settimeofday:=stime(@tp^.tv_sec);
-end;
-
-{$else}
-
-{$ifdef FPC_USE_LIBC}
-function settimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
-{$else}
-function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
-
-begin
-  settimeofday:=do_SysCall(Syscall_nr_settimeofday,TSysParam(@tp),TSysParam(tzp));
-end;
-{$endif}
-{$endif}
-

+ 68 - 0
rtl/haiku/si_c.pp

@@ -0,0 +1,68 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    System Entry point for Haiku, linked-against-libc version
+
+    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.
+
+ **********************************************************************}
+
+unit si_c;
+
+interface
+
+implementation
+
+{ Bindings to RTL }
+var
+  argc: longint; public name 'operatingsystem_parameter_argc';
+  argv: pointer; public name 'operatingsystem_parameter_argv';
+  envp: pointer; public name 'operatingsystem_parameter_envp';
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+{ Bindings to libroot/libc }
+const
+  libc = 'root';
+
+var
+  argv_save: pointer; external name 'argv_save';
+  main_thread_id: ptruint; external name '__main_thread_id';
+
+function find_thread(name: pchar): ptruint; cdecl; external libc name 'find_thread';
+procedure _init_c_library_(argc: longint; argv: ppchar; env: ppchar); cdecl; external libc name '_init_c_library_';
+procedure _call_init_routines_; cdecl; external libc name '_call_init_routines_';
+procedure __exit(status: longint); cdecl; external libc name 'exit';
+
+
+function _FPC_proc_start(_argc: longint; _argv: pointer; _envp: pointer): longint; cdecl; public name '_start';
+begin
+  argc:=_argc;
+  argv:=_argv;
+  envp:=_envp;
+
+  argv_save:=_argv;
+  main_thread_id:=find_thread(nil);
+
+  { This is actually only needed for BeOS R5 compatibility,
+    they're empty stubs in Haiku, according to the C code (KB) }
+  _init_c_library_(_argc,_argv,_envp);
+  _call_init_routines_;
+
+  PascalMain;
+end;
+
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  { call C exit code }
+  __exit(_ExitCode);
+end;
+
+
+end.

+ 59 - 0
rtl/haiku/si_dllc.pp

@@ -0,0 +1,59 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    System Entry point for Haiku shared libraries,
+    linked-against-libc version
+
+    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.
+
+ **********************************************************************}
+
+unit si_dllc;
+
+interface
+
+implementation
+
+{ Bindings to RTL }
+var
+  argc: longint; public name 'operatingsystem_parameter_argc';
+  argv: pointer; public name 'operatingsystem_parameter_argv';
+  envp: pointer; public name 'operatingsystem_parameter_envp';
+
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+{ Bindings to libroot/libc }
+const
+  libc = 'root';
+
+var
+  __libc_argc: longint; external libc name '__libc_argc';
+  __libc_argv: pointer; external libc name '__libc_argv';
+  environ: pointer; external libc name 'environ';
+
+procedure __exit(status: longint); cdecl; external libc name 'exit';
+
+procedure _FPC_shared_lib_start; cdecl; public name 'initialize_after';
+begin
+  argc:=__libc_argc;
+  argv:=__libc_argv;
+  envp:=environ;
+
+  PascalMain;
+end;
+
+procedure _FPC_shared_lib_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  { call C exit code }
+  __exit(_ExitCode);
+end;
+
+
+end.

+ 57 - 245
rtl/haiku/signal.inc

@@ -29,20 +29,20 @@ Const   { For sending a signal }
   SIG_BLOCK   = 1;
   SIG_UNBLOCK = 2;
   SIG_SETMASK = 3;
-  
+
 { values for ss_flags }
-  SS_ONSTACK	= $1;
-  SS_DISABLE	= $2;
-  
-  MINSIGSTKSZ	= 4096;
-  SIGSTKSZ		= 16384;
-	
+  SS_ONSTACK = $1;
+  SS_DISABLE = $2;
+
+  MINSIGSTKSZ = 4096;
+  SIGSTKSZ = 16384;
+
 {Haiku Checked}
 {
    The numbering of signals for BeOS attempts to maintain 
    some consistency with UN*X conventions so that things 
    like "kill -9" do what you expect.
-}   
+}
 
   SIG_DFL  =  0;
   SIG_IGN  =  1;
@@ -81,271 +81,83 @@ Const   { For sending a signal }
   SIGBUS     = 30;
   SIGRESERVED1 = 31;
   SIGRESERVED2 = 32;
-  
-{
-   Signal numbers 23-32 are currently free but may be used in future
-   releases.  Use them at your own peril (if you do use them, at least
-   be smart and use them backwards from signal 32).
-}
 
-{$packrecords C}
-const
-  SI_PAD_SIZE   = ((128/sizeof(longint)) - 3);
 
-{
- * The sequence of the fields/registers in struct sigcontext should match
- * those in mcontext_t.
- }
+{ Include BeOS/Haiku specific vregs struct, which is architecture dependent
+  and maps directly as mcontext_t }
+{$include sig_cpu.inc}
 
-type 
-  packed_fp_stack = packed record
-    st0 : array[0..9] of byte;
-    st1 : array[0..9] of byte;
-    st2 : array[0..9] of byte;
-    st3 : array[0..9] of byte;
-    st4 : array[0..9] of byte;
-    st5 : array[0..9] of byte;
-    st6 : array[0..9] of byte;    
-    st7 : array[0..9] of byte;    
-  end;
-  
-  packed_mmx_regs = packed record
-    mm0 : array[0..9] of byte;
-    mm1 : array[0..9] of byte;
-    mm2 : array[0..9] of byte;
-    mm3 : array[0..9] of byte;
-    mm4 : array[0..9] of byte;
-    mm5 : array[0..9] of byte;
-    mm6 : array[0..9] of byte;    
-    mm7 : array[0..9] of byte;    
-  end;
-  
-  old_extended_regs = packed record
-    fp_control 	: word;
-    _reserved1 	: word;
-    fp_status 	: word;
-    _reserved2 	: word;
-    fp_tag 		: word;
-    _reserved3 	: word;
-    fp_eip 		: cardinal;
-    fp_cs 		: word;
-    fp_opcode	: word;
-    fp_datap	: word;
-    fp_ds		: word;
-    _reserved4	: word;
-    fp_mmx : record
-      case fp_mmx : byte of
-        0 : (fp	: packed_fp_stack);
-        1 : (mmx	: packed_mmx_regs);
-    end;
-  end;
-  
-  fp_stack = record
-    st0 : array[0..9] of byte;
-    _reserved_42_47 : array[0..5] of byte;
-    st1 : array[0..9] of byte;
-    _reserved_58_63 : array[0..5] of byte;
-    st2 : array[0..9] of byte;
-    _reserved_74_79 : array[0..5] of byte;
-    st3 : array[0..9] of byte;
-    _reserved_90_95 : array[0..5] of byte;
-    st4 : array[0..9] of byte;
-    _reserved_106_111 : array[0..5] of byte;
-    st5 : array[0..9] of byte;
-    _reserved_122_127 : array[0..5] of byte;
-    st6 : array[0..9] of byte;    
-    _reserved_138_143 : array[0..5] of byte;
-    st7 : array[0..9] of byte;        
-    _reserved_154_159 : array[0..5] of byte;
-  end;
-  
-  mmx_regs = record
-    mm0 : array[0..9] of byte;
-    _reserved_42_47 : array[0..5] of byte;
-    mm1 : array[0..9] of byte;
-    _reserved_58_63 : array[0..5] of byte;
-    mm2 : array[0..9] of byte;
-    _reserved_74_79 : array[0..5] of byte;
-    mm3 : array[0..9] of byte;
-    _reserved_90_95 : array[0..5] of byte;
-    mm4 : array[0..9] of byte;
-    _reserved_106_111 : array[0..5] of byte;
-    mm5 : array[0..9] of byte;
-    _reserved_122_127 : array[0..5] of byte;
-    mm6 : array[0..9] of byte;    
-    _reserved_138_143 : array[0..5] of byte;
-    mm7 : array[0..9] of byte;    
-    _reserved_154_159 : array[0..5] of byte;
-  end;
-  
-  xmmx_regs = record
-    xmm0 : array [0..15] of byte;
-    xmm1 : array [0..15] of byte;
-    xmm2 : array [0..15] of byte;
-    xmm3 : array [0..15] of byte;
-    xmm4 : array [0..15] of byte;
-    xmm5 : array [0..15] of byte;
-    xmm6 : array [0..15] of byte;
-    xmm7 : array [0..15] of byte;
-  end;
-  
-  new_extended_regs = record
-    fp_control 	: word;
-    fp_status 	: word;
-    fp_tag		: word;
-    fp_opcode	: word;
-    fp_eip		: Cardinal;
-    fp_cs		: word;
-    res_14_15	: word;
-    fp_datap	: Cardinal;
-    fp_ds		: word;
-    _reserved_22_23 : word;
-    mxcsr		: Cardinal;
-    _reserved_28_31 : Cardinal;
-    fp_mmx : record
-      case byte of
-        0 : (fp : fp_stack);
-        1 : (mmx : mmx_regs);
-    end;
-    xmmx : xmmx_regs;
-    _reserved_288_511 : array[0..223] of byte;
-  end;
-  
-  extended_regs = record
-    state : record
-      case byte of
-  	    0 : (old_format : old_extended_regs);
-  	    1 : (new_format : new_extended_regs);  	  
-  	end;
-  	format	: Cardinal;
-  end;
-  
-  vregs = record
-    eip 	: Cardinal;
-    eflags 	: cardinal;
-    eax		: Cardinal;
-    ecx		: Cardinal;
-    edx		: Cardinal;
-    esp		: Cardinal;
-    ebp		: Cardinal;
-    _reserved_1 : Cardinal;
-    xregs	: extended_regs;
-    _reserved_2 : array[0..2] of Cardinal;
-  end;
-  
+{$packrecords C}
+type
+  mcontext_t = vregs;
   Pvregs = ^vregs;
 
-  sigset_t = array[0..1] of Cardinal;
-
-    PSigContext = ^vregs;
-
-    PSigContextRec = ^SigContextRec;
-    SigContextRec = record
-       sc_mask      : sigset_t;          { signal mask to restore }
-       sc_onstack   : longint;              { sigstack state to restore }
+  pstack_t = ^stack_t;
+  stack_t = record
+    ss_sp: pointer;                       {* signal stack base *}
+    ss_size: size_t;                    {* signal stack length *}
+    ss_flags: cint;                     {* SS_DISABLE and/or SS_ONSTACK *}
+  end;
+  TStack = stack_t;
+  PStack = pstack_t;
 
-       sc_gs        : longint;              { machine state (struct trapframe): }
-       sc_fs        : longint;
-       sc_es        : longint;
-       sc_ds        : longint;
-       sc_edi       : longint;
-       sc_esi       : longint;
-       sc_ebp       : longint;
-       sc_isp       : longint;
-       sc_ebx       : longint;
-       sc_edx       : longint;
-       sc_ecx       : longint;
-       sc_eax       : longint;
-       sc_trapno    : longint;
-       sc_err       : longint;
-       sc_eip       : longint;
-       sc_cs        : longint;
-       sc_efl       : longint;
-       sc_esp       : longint;
-       sc_ss        : longint;
-        {
-         * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
-         * needed here), or that + 16 * 4 bytes for emulators (probably all
-         * needed here).  The "spare" bytes are mostly not spare.
-         }
-       en_cw        : cardinal;     { control word (16bits used) }
-       en_sw        : cardinal;     { status word (16bits) }
-       en_tw        : cardinal;     { tag word (16bits) }
-       en_fip       : cardinal;     { floating point instruction pointer }
-       en_fcs       : word;         { floating code segment selector }
-       en_opcode    : word;         { opcode last executed (11 bits ) }
-       en_foo       : cardinal;     { floating operand offset }
-       en_fos       : cardinal;     { floating operand segment selector }
-       fpr_acc      : array[0..79] of char;
-       fpr_ex_sw    : cardinal;
-       fpr_pad      : array[0..63] of char;
-       end;
+  sigset_t = array[0..wordsinsigset-1] of dword;
 
-  Sigval = Record
-            Case Boolean OF
-        { Members as suggested by Annex C of POSIX 1003.1b. }
-                false : (sigval_int : Longint);
-                True  : (sigval_ptr : Pointer);
-            End;
+  PSigContext = ^SigContextRec;
+  PSigContextRec = ^SigContextRec;
+  SigContextRec = record
+    uc_link: PSigContextRec;
+    uc_sigmask: sigset_t;
+    uc_stack: stack_t;
+    uc_mcontext: mcontext_t;
+  end;
 
+  Sigval = record
+    case boolean of
+      { Members as suggested by Annex C of POSIX 1003.1b. }
+      false : (sigval_int : Longint);
+      true  : (sigval_ptr : Pointer);
+  end;
 
   PSigInfo   = ^SigInfo_t;
   PSigInfo_t = ^SigInfo_t;
-  SigInfo_t = packed record
-                si_signo,                       { signal number }
-                si_code,                        { signal code }
-                si_errno,                       { errno association }
-                si_pid          : pid_t;      { sending process }
-                si_uid          : uid_t;     { sender's ruid }
-                si_addr         : Pointer;      { faulting instruction }                
-                si_status       : Longint;      { exit value }
-                si_band         : Cardinal;     { band event for SIGPOLL }                
-                si_value        : SigVal;       { signal value }
-                end;
+  SigInfo_t = record
+    si_signo: cint;     { signal number }
+    si_code: cint;      { signal code }
+    si_errno: cint;     { if non zero, an error number associated with this signal }
+    si_pid: pid_t;      { sending process }
+    si_uid: uid_t;      { sender's ruid }
+    si_addr: Pointer;   { faulting instruction }
+    si_status: cint;    { exit value }
+    si_band: clong;     { band event for SIGPOLL }
+    si_value: SigVal;   { signal value }
+  end;
   TSigInfo = SigInfo_t;
-  TSigInfo_t = TSigInfo;       
-       
+  TSigInfo_t = TSigInfo;
+
   SignalHandler   = Procedure(Sig : Longint);cdecl;
   PSignalHandler  = ^SignalHandler;
   SignalRestorer  = Procedure;cdecl;
   PSignalRestorer = ^SignalRestorer;
-  sigActionHandler = procedure(Sig: Longint; SigInfo: PSigInfo; uContext : PSigContext);cdecl;
-
+  SigActionHandler = procedure(Sig: Longint; SigInfo: PSigInfo; uContext : PSigContext);cdecl;
 
   Sigset=sigset_t;
   TSigset=sigset_t;
   PSigSet = ^SigSet;
   psigset_t=psigset;
 
-  SigActionRec = packed record
-//    Handler  : record
-    sa_handler : sigActionHandler;
-//      case byte of
-//        0: (Sh: SignalHandler);
-//        1: (Sa: TSigAction);
-//      end;
-    sa_Mask     : SigSet;
-    sa_Flags    : Longint;
-    sa_userdata : pointer
+  PSigActionRec = ^SigActionRec;
+  SigActionRec = record
+    sa_handler : SigActionHandler;
+    sa_Mask    : SigSet;
+    sa_Flags   : Longint;
+    sa_userdata: pointer;
   end;
 
-  PSigActionRec = ^SigActionRec;
 
-  {$PACKRECORDS C}
-  pstack_t = ^stack_t;
-  stack_t = packed record
-    ss_sp: pChar;                       {* signal stack base *}
-    ss_size: size_t;                    {* signal stack length *}
-    ss_flags: cInt;                     {* SS_DISABLE and/or SS_ONSTACK *}
-  end;
-  TStack = stack_t;
-  PStack = pstack_t;
-  
 {
   Change action of process upon receipt of a signal.
   Signum specifies the signal (all except SigKill and SigStop).
   If Act is non-nil, it is used to specify the new action.
   If OldAct is non-nil the previous action is saved there.
 }
-
-

+ 20 - 4
rtl/haiku/suuid.inc

@@ -1,4 +1,20 @@
-Const 
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 the Free Pascal development team.
+
+    GUID generation for Haiku, part of Sysutils unit
+
+    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
   RandomDevice  = '/dev/urandom';
 
 
@@ -7,7 +23,7 @@ Function GetURandomBytes(Var Buf; NBytes : Integer) : Boolean;
 Var
   fd,I : Integer;
   P : PByte;
-  
+
 begin
   P:=@Buf;
   fd:=FileOpen(RandomDevice,fmOpenRead);
@@ -22,7 +38,7 @@ begin
           Inc(P,I);
           Dec(NBytes,I);
           end;
-        end;  
+        end;
     Finally
       FileClose(Fd);
     end;
@@ -34,5 +50,5 @@ Function SysCreateGUID(out GUID : TGUID) : Integer;
 begin
   if not GetUrandomBytes(Guid,SizeOf(GUID)) then
     GetRandomBytes(GUID,SizeOf(Guid));  
-  Result:=0;    
+  Result:=0;
 end;

+ 0 - 79
rtl/haiku/syscall.inc

@@ -1,79 +0,0 @@
-{
-    $Id: syscall.inc,v 1.1 2003/01/08 22:32:28 marco Exp $
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This include implements the actual system call for the
-    intel BeOS 80x86 platform.
-
-    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., 51 Franklin Street, Fifth Floor, Boston,
-    MA 02110-1301, USA.
-
- ****************************************************************************
-}
-// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
-// is register instead of stdcall. But assembler is already written, so i used the stdcall
-// calling convention !
-function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; stdcall; assembler; [public, alias : 'FPC_SYSCALL'];
-{
-  This routine sets up the parameters on the stack, all the parameters 
-  are in reverse order on the stack (like C parameter passing).
-}
-asm
-  { load the parameters... }
-  movl  regs,%eax
-  movl  24(%eax),%ebx
-  pushl %ebx
-  movl  20(%eax),%ebx
-  pushl %ebx 
-  movl  16(%eax),%ebx
-  pushl %ebx
-  movl  12(%eax),%ebx
-  pushl %ebx
-  movl  8(%eax),%ebx
-  pushl %ebx
-  movl  4(%eax),%ebx
-  pushl %ebx
-  movl  0(%eax),%ebx
-  pushl %ebx
-  { set the call number }
-  movl  callnr,%eax
-  call  sys_call
-  addl  $28,%esp
-end;
-
-// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
-// is register instead of stdcall. But assembler is already written, so i used the stdcall
-// calling convention ! Maybe don't needed here. But to be sure...
-Function SysCall( callnr:longint;var args : SysCallArgs ):longint; stdcall;
-{
-  This function serves as an interface to do_SysCall.
-  If the SysCall returned a negative number, it returns -1, and puts the
-  SysCall result in errno. Otherwise, it returns the SysCall return value
-}
-var
- funcresult : longint;
-begin
-  funcresult := do_SysCall(callnr, args);
-  if funcresult < 0 then
-   begin
-     errno := funcresult;
-     SysCall := - 1;
-   end
-  else
-   begin
-     SysCall := funcresult;
-     errno := 0;
-   end;
-end;

+ 0 - 56
rtl/haiku/syscallh.inc

@@ -1,56 +0,0 @@
-{
-    Copyright (c) 2002 by Marco van de Voort
-
-    Header for syscall in system unit for i386 *BSD.
-
-    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., 51 Franklin Street, Fifth Floor, Boston,
-    MA 02110-1301, USA.
-
- ****************************************************************************
-
-}
-
-Type
-  TSysResult = longint; // all platforms, cint=32-bit.
-                        // On platforms with off_t =64-bit, people should
-                        // use int64, and typecast all calls that don't
-                        // return off_t to cint.
-
-// I don't think this is going to work on several platforms
-// 64-bit machines don't have only 64-bit params.
-
-  TSysParam  = longint;
-  
-type
-     SysCallArgs = packed record
-       param: array[1..8] of longint; // cint but not defined in unix.pp
-     End;
-
-{$IFDEF FPC_USE_LIBC}
-//var
-//  Errno : cint;
-  
-{$else}
-//var
-//  Errno : cint;
-
-{$ENDIF}
-procedure sys_call; external name 'sys_call'; // BeOS
-//begin
-//end;
-
-  
-//function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; external name 'FPC_SYSCALL';//forward;
-//Function SysCall( callnr:longint;var args : SysCallArgs ):longint; external name 'sys_call';//forward;

+ 0 - 47
rtl/haiku/sysnr.inc

@@ -1,47 +0,0 @@
-const
-      { BeOS specific calls }
-      syscall_nr_create_area = $14;
-      syscall_nr_resize_area = $08;
-      syscall_nr_delete_area = $15;
-      syscall_nr_load_image  = $34;
-      syscall_nr_wait_thread = $22;
-      syscall_nr_rstat       = $30;
-      syscall_nr_statfs      = $5F;
-      syscall_nr_get_team_info = $3b;
-      syscall_nr_kill_team   = $3a;
-      syscall_nr_get_system_info = $56;
-      syscall_nr_kget_tzfilename = $AF;
-      syscall_nr_get_next_image_info = $3C;
-
-const           
-      syscall_nr_exit   		= $3F;
-      syscall_nr_chdir  		= $57; 
-      syscall_nr_mkdir  		= $1E; 
-      syscall_nr_unlink 		= $27;
-      syscall_nr_rmdir  		= $60;
-      syscall_nr_close  		= $01;
-      syscall_nr_read   		= $02;
-      syscall_nr_write  		= $03;
-      syscall_nr_stat   		= $30;
-      syscall_nr_fstat  		= $30;
-      syscall_nr_rename 		= $26;
-      syscall_nr_access 		= $58;
-      syscall_nr_opendir		= $0C;
-      syscall_nr_closedir		= $0F;
-      syscall_nr_sigaction		= $70;
-      syscall_nr_time     		= $07;
-      syscall_nr_open     		= $00;
-      syscall_nr_readdir  		= $1C;
-      syscall_nr_lseek    		= $05;
-      syscall_nr_ftruncate 		= $4B;
-      syscall_nr_ioctl    		= $04;
-      syscall_nr_gettimeofday 	= $A6;
-      syscall_nr_fork           = $A1;
-      syscall_nr_waitpid        = $A3;
-      syscall_nr_fcntl          = $0B;
-      syscall_nr_dup            = syscall_nr_fcntl;
-      syscall_nr_dup2           = $4A;
-      syscall_nr_sbrk           = syscall_nr_resize_area;
-      syscall_nr_getpid         = $00; // not a syscall under BeOS
-      syscall_nr_sigprocmask    = $73;
-      syscall_nr_getcwd         = $00; // not a syscall under BeOS

+ 8 - 34
rtl/haiku/sysos.inc

@@ -15,14 +15,17 @@
 
  **********************************************************************}
 
-{$ifdef FPC_USE_LIBC}
+{$ifndef FPC_USE_LIBC}
+{$error There's no support on Haiku for building without libc/libroot}
+{$endif}
 
-const clib = 'c';
+const
+  clib = 'root';
 
 type libcint=longint;
      plibcint=^libcint;
 
-function geterrnolocation: Plibcint; cdecl;external 'root' name '_errnop';
+function geterrnolocation: Plibcint; cdecl;external clib name '_errnop';
 
 function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
 
@@ -35,26 +38,6 @@ begin
   geterrnolocation^:=err;
 end;
 
-{$else}
-{$ifdef ver1_0}
-Var
-{$else}
-threadvar
-{$endif}
-      Errno : longint;
-
-function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
-
-begin
- GetErrno:=Errno;
-end;
-
-procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
-
-begin
- Errno:=err;
-end;
-{$endif}
 
 { OS dependant parts  }
 
@@ -62,17 +45,8 @@ end;
 {$I ostypes.inc}                        // c-types, unix base types, unix base structures
 {$I osmacro.inc}
 
-{$ifdef FPC_USE_LIBC}
-  {$Linklib c}
-  {$i oscdeclh.inc}
-  {$i oscdecl.inc}
-{$else}
-  {$I syscallh.inc}
-  {$I syscall.inc}
-  {$I sysnr.inc}
-  {$I ossysc.inc}
-{$endif}
-
+{$i oscdeclh.inc}
+{$i oscdecl.inc}
 
 {*****************************************************************************
                             Error conversion

+ 37 - 213
rtl/haiku/system.pp

@@ -1,31 +1,32 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 the Free Pascal development team.
+
+    System unit for Haiku
+
+    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.
+
+ **********************************************************************}
+
+
 Unit System;
 
 interface
 
-// Was needed to bootstrap with our old 2.1 fpc for BeOS
-// to define real
-{ $define VER2_0}
-
 {$define FPC_IS_SYSTEM}
 
 {$I sysunixh.inc}
 
-  
-type
-  THeapPointer = ^pointer;
-var
-  heapstartpointer : THeapPointer;
-  heapstart : pointer;//external;//external name 'HEAP';
-  myheapsize : longint; //external;//external name 'HEAPSIZE';
-  myheaprealsize : longint;
-  heap_handle : longint;
 implementation
 
 procedure debugger(s : PChar); cdecl; external 'root' name 'debugger';
-
 function disable_debugger(state : integer): integer; cdecl; external 'root' name 'disable_debugger';
-//begin
-//end;
+
 
 { OS independant parts}
 
@@ -34,6 +35,7 @@ function disable_debugger(state : integer): integer; cdecl; external 'root' name
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
+{$ifdef i386}
 procedure prthaltproc;external name '_haltproc';
 
 procedure system_exit;
@@ -42,144 +44,18 @@ begin
     jmp prthaltproc
   end;
 End;
+{$else i386}
+procedure haltproc(exitcode: longint); cdecl; external name '_haltproc';
 
-
-{ OS dependant parts  }
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-
-(*var myheapstart:pointer;
-    myheapsize:longint;
-    myheaprealsize:longint;
-    heap_handle:longint;
-    zero:longint;
-
-
-{ first address of heap }
-function getheapstart:pointer;
-begin
-   getheapstart:=myheapstart;
-end;
-
-{ current length of heap }
-function getheapsize:longint;
+procedure system_exit;
 begin
-   getheapsize:=myheapsize;
+  haltproc(ExitCode);
 end;
-*)
+{$endif i386}
 
 
-(*function getheapstart:pointer;
-assembler;
-asm
-        leal    HEAP,%eax
-end ['EAX'];
-
-
-function getheapsize:longint;
-assembler;
-asm
-        movl    intern_HEAPSIZE,%eax
-end ['EAX'];*)
+{ OS dependant parts  }
 
-{ function to allocate size bytes more for the program }
-{ must return the first address of new data space or nil if fail }
-(*function Sbrk(size : longint):pointer;
-var newsize,newrealsize:longint;
-  s : string;
-begin
-  WriteLn('SBRK');
-  Str(size, s);
-  WriteLn('size : ' + s);
-  if (myheapsize+size)<=myheaprealsize then 
-  begin
-    Sbrk:=pointer(heapstart+myheapsize);
-    myheapsize:=myheapsize+size;
-    exit;
-  end;
-  newsize:=myheapsize+size;
-  newrealsize:=(newsize and $FFFFF000)+$1000;
-  case resize_area(heap_handle,newrealsize) of
-    B_OK : 
-      begin
-        WriteLn('B_OK');
-        Sbrk:=pointer(heapstart+myheapsize);
-        myheapsize:=newsize;
-        myheaprealsize:=newrealsize;
-        exit;
-      end;
-    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
-    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
-    B_ERROR : WriteLn('B_ERROR');
-    else
-      begin
-        Sbrk:=pointer(heapstart+myheapsize);
-        myheapsize:=newsize;
-        myheaprealsize:=newrealsize;
-        exit;
-      end;
-  end;
-
-//  Sbrk:=nil;
-end;*)
-
-function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
-
-//function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
-
-{ function to allocate size bytes more for the program }
-{ must return the first address of new data space or nil if fail }
-//function Sbrk(size : longint):pointer;
-//var newsize,newrealsize:longint;
-//  s : string;
-//begin
-//  sbrk := sbrk2(size);
-(*  sbrk := nil;
-  WriteLn('sbrk');
-  Str(size, s);
-  WriteLn('size : ' + s);
-  if (myheapsize+size)<=myheaprealsize then 
-  begin
-    Sbrk:=heapstart+myheapsize;
-    myheapsize:=myheapsize+size;
-    exit;
-  end;
-  newsize:=myheapsize+size;
-  newrealsize:=(newsize and $FFFFF000)+$1000;
-  if sys_resize_area(heap_handle,newrealsize+$1000)=0 then 
-  begin
-    WriteLn('sys_resize_area OK');
-    Str(longint(newrealsize), s);
-    WriteLn('newrealsize : $' + Hexstr(longint(newrealsize), 8));
-    Str(longint(heapstartpointer), s);
-    WriteLn('heapstart : $' + Hexstr(longint(heapstart), 8));
-    Str(myheapsize, s);
-    WriteLn('myheapsize : ' + s);
-    Str(myheapsize, s);
-    WriteLn('Total : ' + s);
-    WriteLn('Before fillchar');
-    WriteLn('sbrk : $' + Hexstr(longint(heapstart+myheapsize), 8));        
-    Sbrk:=heapstart+myheapsize;
-    FillChar(sbrk^, size, #0);    
-    WriteLn('EndFillChar');
-    WriteLn('sbrk : $' + Hexstr(longint(sbrk), 8));
-//    ReadLn(s);
-    myheapsize:=newsize;
-    Str({longint(heapstartpointer) +} myheapsize, s);
-    WriteLn('Total : ' + s);    
-    myheaprealsize:=newrealsize;
-    exit;
-  end
-  else
-  begin
-    debugger('Bad resize_area');
-    WriteLn('Bad resize_area');
-  end;
-  Sbrk:=nil;
-*)
-//end;
 
 { $I text.inc}
 
@@ -187,7 +63,6 @@ function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; externa
                            UnTyped File Handling
 *****************************************************************************}
 
-
 { $i file.inc}
 
 {*****************************************************************************
@@ -201,11 +76,8 @@ function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; externa
 *****************************************************************************}
 
 Function ParamCount: Longint;
-var
-  s : string;
 Begin
-  ParamCount := 0;
-  Paramcount:=argc - 1;
+  Paramcount := argc - 1;
 End;
 
  { variable where full path and filename and executable is stored }
@@ -265,7 +137,6 @@ var
   s: string;
   s1: string;
 begin
-   
   { stricly conforming POSIX applications  }
   { have the executing filename as argv[0] }
   if l = 0 then
@@ -318,20 +189,17 @@ end;
 
 {$i sighnd.inc}
 
-//void	set_signal_stack(void *ptr, size_t size);
-//int		sigaltstack(const stack_t *ss, stack_t *oss);
-
 procedure set_signal_stack(ptr : pointer; size : size_t); cdecl; external 'root' name 'set_signal_stack';
 function sigaltstack(const stack : pstack_t; oldStack : pstack_t) : integer; cdecl; external 'root' name 'sigaltstack'; 
 
 type
   {$PACKRECORDS C}
-  TAlternateSignalStack = packed record
-  	case Integer of
-  	  0 : (buffer : array[0..SIGSTKSZ * 4] of Char);
-  	  1 : (ld : clonglong);
-  	  2 : (l : integer);
-  	  3 : (p : pointer);
+  TAlternateSignalStack = record
+    case Integer of
+      0 : (buffer : array[0..(SIGSTKSZ * 4)-1] of Char);
+      1 : (ld : clonglong);
+      2 : (l : integer);
+      3 : (p : pointer);
   end;
 
 var
@@ -401,14 +269,12 @@ begin
   result := stklen;
 end;
 
-var
-  s : string;
 begin
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
   ReturnNilIfGrowHeapFails := False;
-  
+
   { Set up signals handlers }
   InstallSignals;
 
@@ -417,60 +283,18 @@ begin
 {$endif}
 
   { Setup heap }
-  myheapsize:=4096*100;// $ 20000;
-  myheaprealsize:=4096*100;// $ 20000;
-  heapstart:=nil;
-  heapstartpointer := nil;
-//  heapstartpointer := Sbrk2(4096*1);
-  heapstartpointer := SysOSAlloc(4096*100);
-{$IFDEF FPC_USE_LIBC}  
-//  heap_handle := create_area('fpcheap',heapstart,0,myheaprealsize,0,3);//!!
-{$ELSE}
-//  debugger('tata'#0);
-//  heap_handle := create_area('fpcheap',longint(heapstartpointer),0,myheaprealsize,0,3);//!!
-//  case heap_handle of
-//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
-//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
-//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
-//    B_ERROR : WriteLn('B_ERROR');
-//  end;
-
-  FillChar(heapstartpointer^, myheaprealsize, #0);
-//  WriteLn('EndFillChar');
-//    WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
-//    WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));        
-  heapstart := heapstartpointer;
-{$ENDIF}
-//  WriteLn('before InitHeap');
-//  case heap_handle of
-//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
-//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
-//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
-//    B_ERROR : WriteLn('B_ERROR');
-//  else
-//    begin
-//      WriteLn('ok');  
-//      WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
-//      WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));       
-//      if heap_handle>0 then 
-//      begin
-        InitHeap;
-//      end;
-//    end;
-//  end;
-//  WriteLn('after InitHeap');
-//  end else system_exit;
-  SysInitExceptions;
-//  WriteLn('after SysInitException');
+  InitHeap;
 
+  SysInitExceptions;
   initunicodestringmanager;
-{ Setup IO }
+  { Setup IO }
   SysInitStdIO;
-{ Reset IO Error }
+  { Reset IO Error }
   InOutRes:=0;
   InitSystemThreads;
   InitSystemDynLibs;
   setupexecname;
+
   { restore original signal handlers in case this is a library }
   if IsLibrary then
     RestoreOldSignalHandlers;

+ 119 - 0
rtl/haiku/x86_64/sig_cpu.inc

@@ -0,0 +1,119 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 the Free Pascal development team.
+
+    x86_64 specific signal handler structure
+
+    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.
+
+ **********************************************************************}
+
+{*
+ * Architecture-specific structure passed to signal handlers
+ *}
+
+{$PACKRECORDS C}
+type
+  fp_stack = record
+    st0: array[0..9] of byte;
+    _reserved_42_47: array[0..5] of byte;
+    st1: array[0..9] of byte;
+    _reserved_58_63: array[0..5] of byte;
+    st2: array[0..9] of byte;
+    _reserved_74_79: array[0..5] of byte;
+    st3: array[0..9] of byte;
+    _reserved_90_95: array[0..5] of byte;
+    st4: array[0..9] of byte;
+    _reserved_106_111: array[0..5] of byte;
+    st5: array[0..9] of byte;
+    _reserved_122_127: array[0..5] of byte;
+    st6: array[0..9] of byte;
+    _reserved_138_143: array[0..5] of byte;
+    st7: array[0..9] of byte;
+    _reserved_154_159: array[0..5] of byte;
+  end;
+
+  mmx_regs = record
+    mm0: array[0..9] of byte;
+    _reserved_42_47: array[0..5] of byte;
+    mm1: array[0..9] of byte;
+    _reserved_58_63: array[0..5] of byte;
+    mm2: array[0..9] of byte;
+    _reserved_74_79: array[0..5] of byte;
+    mm3: array[0..9] of byte;
+    _reserved_90_95: array[0..5] of byte;
+    mm4: array[0..9] of byte;
+    _reserved_106_111: array[0..5] of byte;
+    mm5: array[0..9] of byte;
+    _reserved_122_127: array[0..5] of byte;
+    mm6: array[0..9] of byte;
+    _reserved_138_143: array[0..5] of byte;
+    mm7: array[0..9] of byte;
+    _reserved_154_159: array[0..5] of byte;
+  end;
+
+  xmm_regs = record
+    xmm0: array[0..15] of byte;
+    xmm1: array[0..15] of byte;
+    xmm2: array[0..15] of byte;
+    xmm3: array[0..15] of byte;
+    xmm4: array[0..15] of byte;
+    xmm5: array[0..15] of byte;
+    xmm6: array[0..15] of byte;
+    xmm7: array[0..15] of byte;
+    xmm8: array[0..15] of byte;
+    xmm9: array[0..15] of byte;
+    xmm10: array[0..15] of byte;
+    xmm11: array[0..15] of byte;
+    xmm12: array[0..15] of byte;
+    xmm13: array[0..15] of byte;
+    xmm14: array[0..15] of byte;
+    xmm15: array[0..15] of byte;
+  end;
+
+  fpu_state = record
+    control: word;
+    status: word;
+    tag: word;
+    opcode: word;
+    rip: qword;
+    rdp: qword;
+    mxcsr: dword;
+    mscsr_mask: dword;
+    fp_mmx : record
+      case byte of
+        0: (fp: fp_stack);
+        1: (mmx: mmx_regs);
+    end;
+    xmm: xmm_regs;
+    _reserved_416_511: array[0..95] of byte;
+  end;
+
+  vregs = record
+    rax: qword;
+    rbx: qword;
+    rcx: qword;
+    rdx: qword;
+    rdi: qword;
+    rsi: qword;
+    rbp: qword;
+    r8: qword;
+    r9: qword;
+    r10: qword;
+    r11: qword;
+    r12: qword;
+    r13: qword;
+    r14: qword;
+    r15: qword;
+
+    rsp: qword;
+    rip: qword;
+    rflags: qword;
+
+    fpu: fpu_state;
+  end;

+ 93 - 0
rtl/haiku/x86_64/sighnd.inc

@@ -0,0 +1,93 @@
+{
+    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.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigContext: PSigInfo; uContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';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;
+        // fp_status always here under BeOS and x86 CPU
+        // (fp_status is not behind a pointer in the BeOS context record)
+        FpuState:=ucontext^.uc_mcontext.fpu.status;
+
+        if (FpuState and FPU_ExceptionMask) <> 0 then
+          begin
+            { first check the more precise options }
+            if (FpuState and FPU_DivisionByZero)<>0 then
+              res:=200
+            else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
+              res:=207
+            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
+              res:=207;  {'Coprocessor Error'}
+          end;
+        with ucontext^.uc_mcontext.fpu do
+        begin
+          status := status and not FPU_ExceptionMask;
+        end;
+        SysResetFPU;
+      end;
+    SIGBUS:
+      begin
+        res:=214;
+      end;
+    SIGILL:
+      begin
+       // FIXME
+{      if sse_check then
+        begin
+          os_supports_sse := false;
+          res := 0;
+          inc(ucontext^.eip, 3);
+        end
+      else}
+        res:=216;
+      end;
+    SIGSEGV :
+      begin
+        res:=216;
+      end;
+    SIGINT:
+      begin
+        res:=217;
+      end;
+    SIGQUIT:
+      begin
+        res:=233;
+      end;
+  end;
+  reenable_signal(sig);
+{ give runtime error at the position where the signal was raised }
+  if res<>0 then
+  begin
+    HandleErrorAddrFrame(res, pointer(ucontext^.uc_mcontext.rip),
+                              pointer(ucontext^.uc_mcontext.rbp));
+  end;
+end;
+

+ 3 - 4
rtl/unix/oscdeclh.inc

@@ -126,7 +126,7 @@ const
     Function  FPSigaction (sig: cInt; act :pSigActionRec;oact:pSigActionRec):cint;cdecl; external clib name 'sigaction';
 {$ifdef beos}
   {$ifdef haiku}
-    Function  FPSelect  (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external 'network' name 'select';  
+    Function  FPSelect  (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external 'network' name 'select';
     Function  FpPoll    (fds: ppollfd; nfds: cuint; timeout: clong): cint; cdecl; external clib name 'poll';
   {$else}
     Function  FPSelect  (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external 'net' name 'select';
@@ -144,9 +144,8 @@ const
 {$linklib aio}
     Function  FPnanosleep  (const rqtp: ptimespec; rmtp: ptimespec): cint; cdecl; external 'rt' name 'nanosleep';
 {$else solaris}
-{$ifndef beos}
+{$if not defined(beos) or defined(haiku)}
     Function  FPnanosleep  (const rqtp: ptimespec; rmtp: ptimespec): cint; cdecl; external clib name 'nanosleep';
-{$else}
 {$endif}
 {$endif solaris}
     Function  fpSymlink    (oldname,newname:pchar):cint;   cdecl; external clib name 'symlink';
@@ -159,7 +158,7 @@ const
     function  fpmunmap  (addr:pointer;len:size_t):cint; cdecl; external clib name 'munmap';
 
     function  fpgetenv  (name : pchar):pchar; cdecl; external clib name 'getenv';
-{$ifndef beos}    
+{$ifndef beos}
     function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
 {$else}
 //    function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;

+ 1 - 1
rtl/unix/unxdeclh.inc

@@ -18,7 +18,7 @@ type filedesarray=array[0..1] of cint;
 {$if defined(solaris) or defined(aix)}
 Function fpFlock (fd,mode : longint) : cint;{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
 {$else solaris or aix}
-{$ifndef beos}
+{$if not defined(beos) or defined(haiku)}
 Function fpFlock (fd,mode : longint) : cint; cdecl; external clib name 'flock';
 {$endif beos}
 {$endif solaris or aix}