paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-08 05:07:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

* merged haiku fixes till r40831

Browse Source 
git-svn-id: branches/fixes_3_2@42116 -
This commit is contained in:
marco 2019-05-24 11:38:02 +00:00
parent 8fa5c6e445
commit d5027fceeb
29 changed files with 795 additions and 3460 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
.gitattributes vendored
View File

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

33
rtl/haiku/Makefile.fpc
View File

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

95
rtl/haiku/baseunix.pp
View File

@ -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);
fpsettimeofday:=stime(@tp^.tv_sec);
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}
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.

519
rtl/haiku/bethreads.pp
View File

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

159
rtl/haiku/i386/cprt0.as
View File

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

166
rtl/haiku/i386/dllcprt0.as
View File

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

170
rtl/haiku/i386/dllprt.as
View File

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

39
rtl/haiku/i386/dllprt.cpp
View File

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

161
rtl/haiku/i386/func.as
View File

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

186
rtl/haiku/i386/prt0.as
View File

@ -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
rtl/haiku/i386/sig_cpu.inc Normal file
View File

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

12
rtl/haiku/i386/sighnd.inc
View File

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

1061
rtl/haiku/ossysc.inc
View File

File diff suppressed because it is too large Load Diff

183
rtl/haiku/ostypes.inc
View File

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

96
rtl/haiku/ptypes.inc
View File

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

49
rtl/haiku/settimeo.inc
View File

@ -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
rtl/haiku/si_c.pp Normal file
View File

@ -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
rtl/haiku/si_dllc.pp Normal file
View File

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

306
rtl/haiku/signal.inc
View File

@ -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).
}
{ Include BeOS/Haiku specific vregs struct, which is architecture dependent
and maps directly as mcontext_t }
{$include sig_cpu.inc}
{$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.
}
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;
type
mcontext_t = vregs;
Pvregs = ^vregs;
sigset_t = array[0..1] of Cardinal;
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;
PSigContext = ^vregs;
sigset_t = array[0..wordsinsigset-1] of dword;
PSigContextRec = ^SigContextRec;
SigContextRec = record
sc_mask : sigset_t; { signal mask to restore }
sc_onstack : longint; { sigstack state to restore }
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;
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
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 *}
SigActionRec = record
sa_handler : SigActionHandler;
sa_Mask : SigSet;
sa_Flags : Longint;
sa_userdata: pointer;
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.
}

24
rtl/haiku/suuid.inc
View File

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

79
rtl/haiku/syscall.inc
View File

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

56
rtl/haiku/syscallh.inc
View File

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

47
rtl/haiku/sysnr.inc
View File

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

42
rtl/haiku/sysos.inc
View File

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

252
rtl/haiku/system.pp
View File

@ -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';
procedure system_exit;
begin
haltproc(ExitCode);
end;
{$endif i386}
{ 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;
begin
getheapsize:=myheapsize;
end;
*)
(*function getheapstart:pointer;
assembler;
asm
leal HEAP,%eax
end ['EAX'];
function getheapsize:longint;
assembler;
asm
movl intern_HEAPSIZE,%eax
end ['EAX'];*)
{ 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;
InitHeap;
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');
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
rtl/haiku/x86_64/sig_cpu.inc Normal file
View File

@ -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
rtl/haiku/x86_64/sighnd.inc Normal file
View File

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

7
rtl/unix/oscdeclh.inc
View File

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

2
rtl/unix/unxdeclh.inc
View File

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