mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-22 19:51:37 +02:00
o Haiku patches by Olivier Coursiere
+ add posix thread support * improve signal handling * synchronize haiku's baseunix unit with the unix one (maybe it will be possible to remove Haiku's one in a future patch, but i keep it for now) + add support for standard sockets * fix some functions import to use the right libraries under Haiku * fix packages compilation git-svn-id: trunk@12636 -
This commit is contained in:
florian
parent
f9556bad39
commit
c127154efa
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -5358,6 +5358,7 @@ 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/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
|
||||
@ -5377,7 +5378,6 @@ rtl/haiku/system.pp svneol=native#text/plain
|
||||
rtl/haiku/termio.pp svneol=native#text/plain
|
||||
rtl/haiku/termios.inc svneol=native#text/plain
|
||||
rtl/haiku/termiosproc.inc svneol=native#text/plain
|
||||
rtl/haiku/tthread.inc svneol=native#text/plain
|
||||
rtl/haiku/unixsock.inc svneol=native#text/plain
|
||||
rtl/haiku/unxconst.inc svneol=native#text/plain
|
||||
rtl/haiku/unxfunc.inc svneol=native#text/plain
|
||||
|
||||
@ -15,10 +15,12 @@ dirs_arm_linux=graph
|
||||
dirs_m68k_linux=graph
|
||||
dirs_beos=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
|
||||
gdbint libpng x11 gdbm tcl syslog libcurl opengl bfd aspell svgalib \
|
||||
imlib utmp fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib
|
||||
imlib utmp fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib \
|
||||
iconvenc
|
||||
dirs_haiku=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
|
||||
gdbint libpng x11 gdbm tcl syslog libcurl opengl bfd aspell svgalib \
|
||||
imlib utmp fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib
|
||||
imlib utmp fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib \
|
||||
iconvenc
|
||||
dirs_freebsd=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
|
||||
gdbint libpng x11 gdbm tcl syslog libcurl opengl cairo bfd aspell svgalib \
|
||||
imlib utmp fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib \
|
||||
@ -317,4 +319,4 @@ fcl-xml_shared: iconvenc_shared
|
||||
fcl-xml_smart: iconvenc_smart
|
||||
fcl-xml_debug: iconvenc_debug
|
||||
fcl-xml_release: iconvenc_release
|
||||
endif
|
||||
endif
|
||||
@ -17,6 +17,8 @@ rsts=sax xpath htmlwriter xmlconf
|
||||
|
||||
[require]
|
||||
packages=fcl-base
|
||||
packages_beos=iconvenc
|
||||
packages_haiku=iconvenc
|
||||
packages_linux=iconvenc
|
||||
packages_darwin=iconvenc
|
||||
packages_freebsd=iconvenc
|
||||
@ -32,4 +34,4 @@ fpcpackage=y
|
||||
fpcdir=../..
|
||||
|
||||
[rules]
|
||||
.NOTPARALLEL:
|
||||
.NOTPARALLEL:
|
||||
@ -31,6 +31,10 @@ uses
|
||||
const
|
||||
n = 1;
|
||||
|
||||
{$ifdef beos}
|
||||
ESysEILSEQ = EILSEQ;
|
||||
{$endif}
|
||||
|
||||
type
|
||||
piconv_t = ^iconv_t;
|
||||
iconv_t = pointer;
|
||||
@ -171,4 +175,3 @@ begin
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -35,7 +35,11 @@ uses initc,BaseUnix, unixtype;
|
||||
{$else}
|
||||
{$ifdef beos}
|
||||
uses initc, ctypes, baseunix, unixtype;
|
||||
{$i pthrbeos.inc}
|
||||
{$ifdef haiku}
|
||||
{$i pthrhaiku.inc}
|
||||
{$else}
|
||||
{$i pthrbeos.inc}
|
||||
{$endif}
|
||||
{$else}
|
||||
{$error operating system not detected}
|
||||
{$endif}
|
||||
@ -45,4 +49,4 @@ uses initc,BaseUnix, unixtype;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
end.
|
||||
@ -364,3 +364,27 @@ const B_SYMBOL_TYPE_ANY = $5;
|
||||
{ Constansts for MMAP }
|
||||
const
|
||||
MAP_ANONYMOUS =$1000;
|
||||
|
||||
const
|
||||
POLLIN = $0001;
|
||||
POLLOUT = $0002;
|
||||
POLLERR = $0004;
|
||||
POLLPRI = $0020;
|
||||
POLLHUP = $0080;
|
||||
POLLNVAL = $1000;
|
||||
|
||||
{ XOpen, XPG 4.2 }
|
||||
POLLRDNORM = POLLIN;
|
||||
POLLRDBAND = $0008;
|
||||
POLLWRNORM = POLLOUT;
|
||||
POLLWRBAND = $0010;
|
||||
|
||||
type
|
||||
pollfd = record
|
||||
fd: cint;
|
||||
events: cshort;
|
||||
revents: cshort;
|
||||
end;
|
||||
tpollfd = pollfd;
|
||||
ppollfd = ^pollfd;
|
||||
|
||||
|
||||
@ -415,3 +415,9 @@ struct winsize {
|
||||
Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
|
||||
Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));
|
||||
|
||||
{
|
||||
According to posix/sys/ioctl.h
|
||||
/* these currently work only on sockets */
|
||||
}
|
||||
FIONBIO = $be000000;
|
||||
FIONREAD = $be000001;
|
||||
@ -15,32 +15,28 @@
|
||||
Unit BaseUnix;
|
||||
|
||||
Interface
|
||||
{$inline on}
|
||||
Uses UnixType;
|
||||
|
||||
uses UnixType;
|
||||
{$i osdefs.inc} { Compile time defines }
|
||||
|
||||
{$i aliasptp.inc}
|
||||
|
||||
{$packrecords C}
|
||||
{$define oldreaddir} // Keep using readdir system call instead
|
||||
// of userland getdents stuff.
|
||||
{$define usedomain} // Allow uname with "domain" entry.
|
||||
// (which is a GNU extension)
|
||||
{$define posixworkaround} // Temporary ugly workaround for signal handler.
|
||||
// (mainly until baseunix migration is complete)
|
||||
|
||||
{$ifndef FPC_USE_LIBC}
|
||||
{$define FPC_USE_SYSCALL}
|
||||
{$define FPC_USE_SYSCALL}
|
||||
{$endif}
|
||||
|
||||
{$i errno.inc} { Error numbers }
|
||||
{$i errno.inc} { Error numbers }
|
||||
{$i ostypes.inc}
|
||||
|
||||
{$ifdef FPC_USE_LIBC}
|
||||
const clib = 'root';
|
||||
const netlib = 'network';
|
||||
{$i oscdeclh.inc}
|
||||
const clib = 'root';
|
||||
const netlib = 'network';
|
||||
{$i oscdeclh.inc}
|
||||
{$ELSE}
|
||||
{$i bunxh.inc} { Functions}
|
||||
{$i bunxh.inc} { Functions}
|
||||
{$ENDIF}
|
||||
|
||||
function fpgeterrno:longint;
|
||||
@ -62,6 +58,8 @@ Function FpNanoSleep (req : ptimespec;rem : ptimespec):cint;
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{$i genfunch.inc}
|
||||
|
||||
{ Fairly portable constants. I'm not going to waste time to duplicate and alias
|
||||
them anywhere}
|
||||
|
||||
@ -83,14 +81,20 @@ Const
|
||||
|
||||
implementation
|
||||
|
||||
{$ifdef hassysctl}
|
||||
Uses Sysctl;
|
||||
{$endif}
|
||||
|
||||
{$i genfuncs.inc} // generic calls. (like getenv)
|
||||
{$I gensigset.inc} // general sigset funcs implementation.
|
||||
{$I genfdset.inc} // general fdset funcs.
|
||||
|
||||
{$ifndef FPC_USE_LIBC}
|
||||
{$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 bsyscall.inc} // cpu specific syscalls
|
||||
{$i bunxsysc.inc} // syscalls in system unit.
|
||||
// {$i settimeo.inc}
|
||||
{$endif}
|
||||
@ -151,4 +155,4 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
end.
|
||||
23
rtl/haiku/osdefs.inc
Normal file
23
rtl/haiku/osdefs.inc
Normal file
@ -0,0 +1,23 @@
|
||||
{
|
||||
Copyright (c) 2000-2002 by Marco van de Voort
|
||||
|
||||
Target dependent defines used when compileing the baseunix unit
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************}
|
||||
|
||||
{$define usedomain} // Allow uname with "domain" entry.
|
||||
// (which is a GNU extension)
|
||||
@ -363,7 +363,10 @@ const B_SYMBOL_TYPE_ANY = $5;
|
||||
|
||||
{ Constansts for MMAP }
|
||||
const
|
||||
MAP_ANONYMOUS =$1000;
|
||||
{$ifdef FPC_IS_SYSTEM}
|
||||
MAP_PRIVATE =2;
|
||||
{$endif}
|
||||
MAP_ANONYMOUS =$08;
|
||||
|
||||
const
|
||||
POLLIN = $0001;
|
||||
@ -388,4 +391,3 @@ type
|
||||
tpollfd = pollfd;
|
||||
ppollfd = ^pollfd;
|
||||
|
||||
|
||||
|
||||
@ -45,12 +45,10 @@ function pthread_getspecific (t : pthread_key_t):pointer; cdecl; external;
|
||||
function pthread_setspecific (t : pthread_key_t;p:pointer):cint; cdecl; external;
|
||||
function pthread_key_create (p : ppthread_key_t;f: __destr_func_t):cint; cdecl;external;
|
||||
function pthread_attr_init (p : ppthread_attr_t):cint; cdecl; external;
|
||||
{$ifndef haiku}
|
||||
function pthread_attr_setinheritsched(p : ppthread_attr_t;i:cint):cint; cdecl; external;
|
||||
//function pthread_attr_setinheritsched(p : ppthread_attr_t;i:cint):cint; cdecl; external;
|
||||
function pthread_attr_setscope (p : ppthread_attr_t;i:cint):cint;cdecl;external;
|
||||
function pthread_attr_setdetachstate (p : ppthread_attr_t;i:cint):cint;cdecl;external;
|
||||
function pthread_attr_setstacksize(p: ppthread_attr_t; stacksize: size_t):cint;cdecl;external;
|
||||
{$endif}
|
||||
function pthread_create ( p: ppthread_t;attr : ppthread_attr_t;f:__startroutine_t;arg:pointer):cint;cdecl;external;
|
||||
procedure pthread_exit ( p: pointer); cdecl;external;
|
||||
function pthread_self:pthread_t; cdecl;external;
|
||||
@ -68,7 +66,6 @@ function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;
|
||||
function pthread_kill(__thread:pthread_t; __signo:cint):cint;cdecl;external;
|
||||
function pthread_sigmask(how: cint; nset: psigset; oset: psigset): cint; cdecl; external;
|
||||
|
||||
{$ifndef haiku}
|
||||
function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
|
||||
function sem_destroy(__sem:Psem_t):cint;cdecl;external ;
|
||||
function sem_close(__sem:Psem_t):cint;cdecl;external ;
|
||||
@ -77,7 +74,7 @@ function sem_wait(__sem:Psem_t):cint;cdecl;external ;
|
||||
function sem_trywait(__sem:Psem_t):cint;cdecl;external ;
|
||||
function sem_post(__sem:Psem_t):cint;cdecl;external ;
|
||||
function sem_getvalue(__sem:Psem_t; __sval:Pcint):cint;cdecl;external;
|
||||
{$endif}
|
||||
|
||||
function pthread_mutexattr_init(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
|
||||
function pthread_mutexattr_destroy(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
|
||||
function pthread_mutexattr_gettype(_para1:Ppthread_mutexattr_t; _para2:Pcint):cint;cdecl;external;
|
||||
@ -85,4 +82,3 @@ function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cin
|
||||
function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl;external;
|
||||
|
||||
|
||||
|
||||
|
||||
@ -15,31 +15,39 @@
|
||||
|
||||
Const { For sending a signal }
|
||||
|
||||
SA_NOCLDSTOP = 1;
|
||||
|
||||
// does not exist under BeOS i think !
|
||||
SA_ONSTACK = $001; { take signal on signal stack }
|
||||
SA_RESTART = $002; { restart system call on signal return }
|
||||
SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
|
||||
SA_NODEFER = $010; { don't mask the signal we're delivering }
|
||||
SA_NOCLDWAIT = $020; { don't keep zombies around }
|
||||
SA_SIGINFO = $040; { signal handler with SA_SIGINFO args }
|
||||
SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
|
||||
SA_NOCLDSTOP = $01;
|
||||
SA_NOCLDWAIT = $02;
|
||||
SA_RESETHAND = $03;
|
||||
SA_NODEFER = $08;
|
||||
SA_RESTART = $10;
|
||||
SA_ONSTACK = $20;
|
||||
SA_SIGINFO = $40;
|
||||
SA_NOMASK = SA_NODEFER;
|
||||
SA_STACK = SA_ONSTACK;
|
||||
SA_ONESHOT = SA_RESETHAND;
|
||||
|
||||
SIG_BLOCK = 1;
|
||||
SIG_UNBLOCK = 2;
|
||||
SIG_SETMASK = 3;
|
||||
|
||||
{BeOS Checked}
|
||||
|
||||
{ values for ss_flags }
|
||||
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 ;
|
||||
SIG_ERR = -1 ;
|
||||
SIG_DFL = 0;
|
||||
SIG_IGN = 1;
|
||||
SIG_ERR = -1;
|
||||
SIG_HOLD = 3;
|
||||
|
||||
SIGHUP = 1;
|
||||
SIGINT = 2;
|
||||
@ -63,6 +71,14 @@ Const { For sending a signal }
|
||||
SIGWINCH = 20;
|
||||
SIGKILLTHR = 21;
|
||||
SIGTRAP = 22;
|
||||
SIGPOLL = 23;
|
||||
SIGPROF = 24;
|
||||
SIGSYS = 25;
|
||||
SIGURG = 26;
|
||||
SIGVTALRM = 27;
|
||||
SIGXCPU = 28;
|
||||
SIGXFSZ = 29;
|
||||
|
||||
SIGBUS = SIGSEGV;
|
||||
|
||||
{
|
||||
@ -283,11 +299,20 @@ type
|
||||
// end;
|
||||
sa_Mask : SigSet;
|
||||
sa_Flags : Longint;
|
||||
sa_userdaa : pointer
|
||||
sa_userdata : pointer
|
||||
end;
|
||||
|
||||
PSigActionRec = ^SigActionRec;
|
||||
|
||||
pstack_t = ^stack_t;
|
||||
stack_t = 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).
|
||||
@ -296,4 +321,3 @@ type
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@ -314,21 +314,52 @@ 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); external 'root' name 'set_signal_stack';
|
||||
function sigaltstack(const ss : pstack_t; oss : pstack_t) : integer; external 'root' name 'sigaltstack';
|
||||
|
||||
type
|
||||
TAlternateSignalStack = record
|
||||
case Integer of
|
||||
0 : (buffer : array[0..SIGSTKSZ] of Char);
|
||||
1 : (ld : int64);
|
||||
2 : (l : integer);
|
||||
3 : (p : pointer);
|
||||
end;
|
||||
|
||||
var
|
||||
act: SigActionRec;
|
||||
alternate_signal_stack : TAlternateSignalStack;
|
||||
|
||||
Procedure InstallSignals;
|
||||
var
|
||||
oldact: SigActionRec;
|
||||
r : integer;
|
||||
st : stack_t;
|
||||
begin
|
||||
FillChar(st, sizeof(st), 0);
|
||||
|
||||
st.ss_flags := 0;
|
||||
st.ss_sp := alternate_signal_stack.buffer;
|
||||
st.ss_size := SizeOf(alternate_signal_stack);
|
||||
|
||||
r := sigaltstack(@st, nil);
|
||||
|
||||
if (r <> 0) then
|
||||
WriteLn('error sigalstack');
|
||||
{ Initialize the sigaction structure }
|
||||
{ all flags and information set to zero }
|
||||
FillChar(act, sizeof(SigActionRec),0);
|
||||
{ initialize handler }
|
||||
act.sa_handler := SigActionHandler(@SignalToRunError);
|
||||
act.sa_flags:=SA_SIGINFO;
|
||||
FpSigAction(SIGFPE,@act,nil);
|
||||
FpSigAction(SIGSEGV,@act,nil);
|
||||
FpSigAction(SIGBUS,@act,nil);
|
||||
FpSigAction(SIGILL,@act,nil);
|
||||
act.sa_flags := SA_ONSTACK;
|
||||
|
||||
FpSigAction(SIGFPE,@act,@oldact);
|
||||
FpSigAction(SIGSEGV,@act,@oldact);
|
||||
FpSigAction(SIGBUS,@act,@oldact);
|
||||
FpSigAction(SIGILL,@act,@oldact);
|
||||
end;
|
||||
|
||||
procedure SysInitStdIO;
|
||||
@ -352,7 +383,8 @@ begin
|
||||
IsConsole := TRUE;
|
||||
StackLength := CheckInitialStkLen(InitialStkLen);
|
||||
StackBottom := Sptr - StackLength;
|
||||
|
||||
ReturnNilIfGrowHeapFails := False;
|
||||
|
||||
SysResetFPU;
|
||||
if not(IsLibrary) then
|
||||
SysInitFPU;
|
||||
@ -362,11 +394,12 @@ begin
|
||||
|
||||
SysInitStdIO;
|
||||
{ Setup heap }
|
||||
myheapsize:=4096*1;// $ 20000;
|
||||
myheaprealsize:=4096*1;// $ 20000;
|
||||
myheapsize:=4096*100;// $ 20000;
|
||||
myheaprealsize:=4096*100;// $ 20000;
|
||||
heapstart:=nil;
|
||||
heapstartpointer := nil;
|
||||
heapstartpointer := Sbrk2(4096*1);
|
||||
// heapstartpointer := Sbrk2(4096*1);
|
||||
heapstartpointer := SysOSAlloc(4096*100);
|
||||
{$IFDEF FPC_USE_LIBC}
|
||||
// heap_handle := create_area('fpcheap',heapstart,0,myheaprealsize,0,3);//!!
|
||||
{$ELSE}
|
||||
@ -421,4 +454,4 @@ begin
|
||||
initunicodestringmanager;
|
||||
{$endif VER2_2}
|
||||
setupexecname;
|
||||
end.
|
||||
end.
|
||||
@ -415,3 +415,9 @@ struct winsize {
|
||||
Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
|
||||
Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));
|
||||
|
||||
{
|
||||
According to posix/sys/ioctl.h
|
||||
/* these currently work only on sockets */
|
||||
}
|
||||
FIONBIO = $be000000;
|
||||
FIONREAD = $be000001;
|
||||
@ -1,613 +0,0 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1999-2000 by Peter Vreman
|
||||
|
||||
BeOS TThread 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
{$IFDEF VER1_0} // leaving the old implementation in for now...
|
||||
type
|
||||
PThreadRec=^TThreadRec;
|
||||
TThreadRec=record
|
||||
thread : TThread;
|
||||
next : PThreadRec;
|
||||
end;
|
||||
|
||||
var
|
||||
ThreadRoot : PThreadRec;
|
||||
ThreadsInited : boolean;
|
||||
// MainThreadID: longint;
|
||||
|
||||
Const
|
||||
ThreadCount: longint = 0;
|
||||
|
||||
function ThreadSelf:TThread;
|
||||
var
|
||||
hp : PThreadRec;
|
||||
sp : Pointer;
|
||||
begin
|
||||
sp:=SPtr;
|
||||
hp:=ThreadRoot;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if (sp<=hp^.Thread.FStackPointer) and
|
||||
(sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
|
||||
begin
|
||||
Result:=hp^.Thread;
|
||||
exit;
|
||||
end;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
|
||||
//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
|
||||
procedure SIGCHLDHandler(Sig: longint); cdecl;
|
||||
|
||||
begin
|
||||
fpwaitpid(-1, nil, WNOHANG);
|
||||
end;
|
||||
|
||||
procedure InitThreads;
|
||||
var
|
||||
Act, OldAct: Baseunix.PSigActionRec;
|
||||
begin
|
||||
ThreadRoot:=nil;
|
||||
ThreadsInited:=true;
|
||||
|
||||
|
||||
// This will install SIGCHLD signal handler
|
||||
// signal() installs "one-shot" handler,
|
||||
// so it is better to install and set up handler with sigaction()
|
||||
|
||||
GetMem(Act, SizeOf(SigActionRec));
|
||||
GetMem(OldAct, SizeOf(SigActionRec));
|
||||
|
||||
Act^.sa_handler := TSigAction(@SIGCHLDHandler);
|
||||
Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
|
||||
Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
|
||||
FpSigAction(SIGCHLD, Act, OldAct);
|
||||
|
||||
FreeMem(Act, SizeOf(SigActionRec));
|
||||
FreeMem(OldAct, SizeOf(SigActionRec));
|
||||
end;
|
||||
|
||||
|
||||
procedure DoneThreads;
|
||||
var
|
||||
hp : PThreadRec;
|
||||
begin
|
||||
while assigned(ThreadRoot) do
|
||||
begin
|
||||
ThreadRoot^.Thread.Destroy;
|
||||
hp:=ThreadRoot;
|
||||
ThreadRoot:=ThreadRoot^.Next;
|
||||
dispose(hp);
|
||||
end;
|
||||
ThreadsInited:=false;
|
||||
end;
|
||||
|
||||
|
||||
procedure AddThread(t:TThread);
|
||||
var
|
||||
hp : PThreadRec;
|
||||
begin
|
||||
{ Need to initialize threads ? }
|
||||
if not ThreadsInited then
|
||||
InitThreads;
|
||||
|
||||
{ Put thread in the linked list }
|
||||
new(hp);
|
||||
hp^.Thread:=t;
|
||||
hp^.next:=ThreadRoot;
|
||||
ThreadRoot:=hp;
|
||||
|
||||
inc(ThreadCount, 1);
|
||||
end;
|
||||
|
||||
|
||||
procedure RemoveThread(t:TThread);
|
||||
var
|
||||
lasthp,hp : PThreadRec;
|
||||
begin
|
||||
hp:=ThreadRoot;
|
||||
lasthp:=nil;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if hp^.Thread=t then
|
||||
begin
|
||||
if assigned(lasthp) then
|
||||
lasthp^.next:=hp^.next
|
||||
else
|
||||
ThreadRoot:=hp^.next;
|
||||
dispose(hp);
|
||||
exit;
|
||||
end;
|
||||
lasthp:=hp;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
|
||||
Dec(ThreadCount, 1);
|
||||
if ThreadCount = 0 then DoneThreads;
|
||||
end;
|
||||
|
||||
|
||||
{ TThread }
|
||||
function ThreadProc(args:pointer): Integer;//cdecl;
|
||||
var
|
||||
FreeThread: Boolean;
|
||||
Thread : TThread absolute args;
|
||||
begin
|
||||
while Thread.FHandle = 0 do fpsleep(1);
|
||||
if Thread.FSuspended then Thread.suspend();
|
||||
try
|
||||
Thread.Execute;
|
||||
except
|
||||
Thread.FFatalException := TObject(AcquireExceptionObject);
|
||||
end;
|
||||
FreeThread := Thread.FFreeOnTerminate;
|
||||
Result := Thread.FReturnValue;
|
||||
Thread.FFinished := True;
|
||||
Thread.DoTerminate;
|
||||
if FreeThread then
|
||||
Thread.Free;
|
||||
fpexit(Result);
|
||||
end;
|
||||
|
||||
|
||||
constructor TThread.Create(CreateSuspended: Boolean);
|
||||
var
|
||||
Flags: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
AddThread(self);
|
||||
FSuspended := CreateSuspended;
|
||||
Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
|
||||
{ Setup 16k of stack }
|
||||
FStackSize:=16384;
|
||||
Getmem(FStackPointer,FStackSize);
|
||||
inc(FStackPointer,FStackSize);
|
||||
FCallExitProcess:=false;
|
||||
{ Clone }
|
||||
FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
|
||||
// if FSuspended then Suspend;
|
||||
FThreadID := FHandle;
|
||||
IsMultiThread := TRUE;
|
||||
FFatalException := nil;
|
||||
end;
|
||||
|
||||
|
||||
destructor TThread.Destroy;
|
||||
begin
|
||||
if not FFinished and not Suspended then
|
||||
begin
|
||||
Terminate;
|
||||
WaitFor;
|
||||
end;
|
||||
if FHandle <> -1 then
|
||||
fpkill(FHandle, SIGKILL);
|
||||
dec(FStackPointer,FStackSize);
|
||||
Freemem(FStackPointer);
|
||||
FFatalException.Free;
|
||||
FFatalException := nil;
|
||||
inherited Destroy;
|
||||
RemoveThread(self);
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.CallOnTerminate;
|
||||
begin
|
||||
FOnTerminate(Self);
|
||||
end;
|
||||
|
||||
procedure TThread.DoTerminate;
|
||||
begin
|
||||
if Assigned(FOnTerminate) then
|
||||
Synchronize(@CallOnTerminate);
|
||||
end;
|
||||
|
||||
|
||||
const
|
||||
{ I Don't know idle or timecritical, value is also 20, so the largest other
|
||||
possibility is 19 (PFV) }
|
||||
Priorities: array [TThreadPriority] of Integer =
|
||||
(-20,-19,-10,9,10,19,20);
|
||||
|
||||
function TThread.GetPriority: TThreadPriority;
|
||||
var
|
||||
P: Integer;
|
||||
I: TThreadPriority;
|
||||
begin
|
||||
P := fpGetPriority(Prio_Process,FHandle);
|
||||
Result := tpNormal;
|
||||
for I := Low(TThreadPriority) to High(TThreadPriority) do
|
||||
if Priorities[I] = P then
|
||||
Result := I;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
begin
|
||||
fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Synchronize(Method: TThreadMethod);
|
||||
begin
|
||||
FSynchronizeException := nil;
|
||||
FMethod := Method;
|
||||
{ SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
|
||||
if Assigned(FSynchronizeException) then
|
||||
raise FSynchronizeException;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.SetSuspended(Value: Boolean);
|
||||
begin
|
||||
if Value <> FSuspended then
|
||||
if Value then
|
||||
Suspend
|
||||
else
|
||||
Resume;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Suspend;
|
||||
begin
|
||||
FSuspended := true;
|
||||
fpKill(FHandle, SIGSTOP);
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Resume;
|
||||
begin
|
||||
fpKill(FHandle, SIGCONT);
|
||||
FSuspended := False;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Terminate;
|
||||
begin
|
||||
FTerminated := True;
|
||||
end;
|
||||
|
||||
function TThread.WaitFor: Integer;
|
||||
var
|
||||
status : longint;
|
||||
begin
|
||||
if FThreadID = MainThreadID then
|
||||
fpwaitpid(0,@status,0)
|
||||
else
|
||||
fpwaitpid(FHandle,@status,0);
|
||||
Result:=status;
|
||||
end;
|
||||
{$ELSE}
|
||||
|
||||
{
|
||||
What follows, is a short description on my implementation of TThread.
|
||||
Most information can also be found by reading the source and accompanying
|
||||
comments.
|
||||
|
||||
A thread is created using BeginThread, which in turn calls
|
||||
pthread_create. So the threads here are always posix threads.
|
||||
Posix doesn't define anything for suspending threads as this is
|
||||
inherintly unsafe. Just don't suspend threads at points they cannot
|
||||
control. Therefore, I didn't implement .Suspend() if its called from
|
||||
outside the threads execution flow (except on Linux _without_ NPTL).
|
||||
|
||||
The implementation for .suspend uses a semaphore, which is initialized
|
||||
at thread creation. If the thread tries to suspend itself, we simply
|
||||
let it wait on the semaphore until it is unblocked by someone else
|
||||
who calls .Resume.
|
||||
|
||||
If a thread is supposed to be suspended (from outside its own path of
|
||||
execution) on a system where the symbol LINUX is defined, two things
|
||||
are possible.
|
||||
1) the system has the LinuxThreads pthread implementation
|
||||
2) the system has NPTL as the pthread implementation.
|
||||
|
||||
In the first case, each thread is a process on its own, which as far as
|
||||
know actually violates posix with respect to signal handling.
|
||||
But we can detect this case, because getpid(2) will
|
||||
return a different PID for each thread. In that case, sending SIGSTOP
|
||||
to the PID associated with a thread will actually stop that thread
|
||||
only.
|
||||
In the second case, this is not possible. But getpid(2) returns the same
|
||||
PID across all threads, which is detected, and TThread.Suspend() does
|
||||
nothing in that case. This should probably be changed, but I know of
|
||||
no way to suspend a thread when using NPTL.
|
||||
|
||||
If the symbol LINUX is not defined, then the unimplemented
|
||||
function SuspendThread is called.
|
||||
|
||||
Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
|
||||
}
|
||||
|
||||
// ========== semaphore stuff ==========
|
||||
{
|
||||
I don't like this. It eats up 2 filedescriptors for each thread,
|
||||
and those are a limited resource. If you have a server programm
|
||||
handling client connections (one per thread) it will not be able
|
||||
to handle many if we use 2 fds already for internal structures.
|
||||
However, right now I don't see a better option unless some sem_*
|
||||
functions are added to systhrds.
|
||||
I encapsulated all used functions here to make it easier to
|
||||
change them completely.
|
||||
}
|
||||
|
||||
{BeOS implementation}
|
||||
|
||||
function SemaphoreInit: Pointer;
|
||||
begin
|
||||
SemaphoreInit := GetMem(SizeOf(TFilDes));
|
||||
fppipe(PFilDes(SemaphoreInit)^);
|
||||
end;
|
||||
|
||||
procedure SemaphoreWait(const FSem: Pointer);
|
||||
var
|
||||
b: byte;
|
||||
begin
|
||||
fpread(PFilDes(FSem)^[0], b, 1);
|
||||
end;
|
||||
|
||||
procedure SemaphorePost(const FSem: Pointer);
|
||||
var
|
||||
b : byte;
|
||||
begin
|
||||
b := 0;
|
||||
fpwrite(PFilDes(FSem)^[1], b, 1);
|
||||
end;
|
||||
|
||||
procedure SemaphoreDestroy(const FSem: Pointer);
|
||||
begin
|
||||
fpclose(PFilDes(FSem)^[0]);
|
||||
fpclose(PFilDes(FSem)^[1]);
|
||||
FreeMemory(FSem);
|
||||
end;
|
||||
|
||||
// =========== semaphore end ===========
|
||||
|
||||
var
|
||||
ThreadsInited: boolean = false;
|
||||
{$IFDEF LINUX}
|
||||
GMainPID: LongInt = 0;
|
||||
{$ENDIF}
|
||||
const
|
||||
// stupid, considering its not even implemented...
|
||||
Priorities: array [TThreadPriority] of Integer =
|
||||
(-20,-19,-10,0,9,18,19);
|
||||
|
||||
procedure InitThreads;
|
||||
begin
|
||||
if not ThreadsInited then begin
|
||||
ThreadsInited := true;
|
||||
{$IFDEF LINUX}
|
||||
GMainPid := fpgetpid();
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoneThreads;
|
||||
begin
|
||||
ThreadsInited := false;
|
||||
end;
|
||||
|
||||
{ ok, so this is a hack, but it works nicely. Just never use
|
||||
a multiline argument with WRITE_DEBUG! }
|
||||
{$MACRO ON}
|
||||
{$IFDEF DEBUG_MT}
|
||||
{$define WRITE_DEBUG := writeln} // actually write something
|
||||
{$ELSE}
|
||||
{$define WRITE_DEBUG := //} // just comment out those lines
|
||||
{$ENDIF}
|
||||
|
||||
function ThreadFunc(parameter: Pointer): LongInt; // cdecl;
|
||||
var
|
||||
LThread: TThread;
|
||||
c: char;
|
||||
begin
|
||||
WRITE_DEBUG('ThreadFunc is here...');
|
||||
LThread := TThread(parameter);
|
||||
{$IFDEF LINUX}
|
||||
// save the PID of the "thread"
|
||||
// this is different from the PID of the main thread if
|
||||
// the LinuxThreads implementation is used
|
||||
LThread.FPid := fpgetpid();
|
||||
{$ENDIF}
|
||||
WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
|
||||
try
|
||||
if LThread.FInitialSuspended then begin
|
||||
SemaphoreWait(LThread.FSem);
|
||||
if not LThread.FInitialSuspended then begin
|
||||
WRITE_DEBUG('going into LThread.Execute');
|
||||
LThread.Execute;
|
||||
end;
|
||||
end else begin
|
||||
WRITE_DEBUG('going into LThread.Execute');
|
||||
LThread.Execute;
|
||||
end;
|
||||
except
|
||||
on e: exception do begin
|
||||
WRITE_DEBUG('got exception: ',e.message);
|
||||
LThread.FFatalException := TObject(AcquireExceptionObject);
|
||||
// not sure if we should really do this...
|
||||
// but .Destroy was called, so why not try FreeOnTerminate?
|
||||
if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
|
||||
end;
|
||||
end;
|
||||
WRITE_DEBUG('thread done running');
|
||||
Result := LThread.FReturnValue;
|
||||
WRITE_DEBUG('Result is ',Result);
|
||||
LThread.FFinished := True;
|
||||
LThread.DoTerminate;
|
||||
if LThread.FreeOnTerminate then begin
|
||||
WRITE_DEBUG('Thread should be freed');
|
||||
LThread.Free;
|
||||
WRITE_DEBUG('Thread freed');
|
||||
end;
|
||||
WRITE_DEBUG('thread func exiting');
|
||||
end;
|
||||
|
||||
{ TThread }
|
||||
constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
|
||||
var
|
||||
data : pointer;
|
||||
begin
|
||||
// lets just hope that the user doesn't create a thread
|
||||
// via BeginThread and creates the first TThread Object in there!
|
||||
InitThreads;
|
||||
inherited Create;
|
||||
FSem := SemaphoreInit;
|
||||
FSuspended := CreateSuspended;
|
||||
FSuspendedExternal := false;
|
||||
FInitialSuspended := CreateSuspended;
|
||||
FFatalException := nil;
|
||||
WRITE_DEBUG('creating thread, self = ',longint(self));
|
||||
FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
|
||||
WRITE_DEBUG('TThread.Create done');
|
||||
end;
|
||||
|
||||
|
||||
destructor TThread.Destroy;
|
||||
begin
|
||||
if FThreadID = GetCurrentThreadID then begin
|
||||
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
|
||||
end;
|
||||
// if someone calls .Free on a thread with
|
||||
// FreeOnTerminate, then don't crash!
|
||||
FFreeOnTerminate := false;
|
||||
if not FFinished and not FSuspended then begin
|
||||
Terminate;
|
||||
WaitFor;
|
||||
end;
|
||||
if (FInitialSuspended) then begin
|
||||
// thread was created suspended but never woken up.
|
||||
SemaphorePost(FSem);
|
||||
WaitFor;
|
||||
end;
|
||||
FFatalException.Free;
|
||||
FFatalException := nil;
|
||||
SemaphoreDestroy(FSem);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TThread.SetSuspended(Value: Boolean);
|
||||
begin
|
||||
if Value <> FSuspended then
|
||||
if Value then
|
||||
Suspend
|
||||
else
|
||||
Resume;
|
||||
end;
|
||||
|
||||
procedure TThread.Suspend;
|
||||
begin
|
||||
if not FSuspended then begin
|
||||
if FThreadID = GetCurrentThreadID then begin
|
||||
FSuspended := true;
|
||||
SemaphoreWait(FSem);
|
||||
end else begin
|
||||
FSuspendedExternal := true;
|
||||
{$IFDEF LINUX}
|
||||
// naughty hack if the user doesn't have Linux with NPTL...
|
||||
// in that case, the PID of threads will not be identical
|
||||
// to the other threads, which means that our thread is a normal
|
||||
// process that we can suspend via SIGSTOP...
|
||||
// this violates POSIX, but is the way it works on the
|
||||
// LinuxThreads pthread implementation. Not with NPTL, but in that case
|
||||
// getpid(2) also behaves properly and returns the same PID for
|
||||
// all threads. Thats actually (FINALLY!) native thread support :-)
|
||||
if FPid <> GMainPID then begin
|
||||
FSuspended := true;
|
||||
fpkill(FPid, SIGSTOP);
|
||||
end;
|
||||
{$ELSE}
|
||||
SuspendThread(FHandle);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Resume;
|
||||
begin
|
||||
if (not FSuspendedExternal) then begin
|
||||
if FSuspended then begin
|
||||
SemaphorePost(FSem);
|
||||
FInitialSuspended := false;
|
||||
FSuspended := False;
|
||||
end;
|
||||
end else begin
|
||||
{$IFDEF LINUX}
|
||||
// see .Suspend
|
||||
if FPid <> GMainPID then begin
|
||||
fpkill(FPid, SIGCONT);
|
||||
FSuspended := False;
|
||||
end;
|
||||
{$ELSE}
|
||||
ResumeThread(FHandle);
|
||||
{$ENDIF}
|
||||
FSuspendedExternal := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.Terminate;
|
||||
begin
|
||||
FTerminated := True;
|
||||
end;
|
||||
|
||||
function TThread.WaitFor: Integer;
|
||||
begin
|
||||
WRITE_DEBUG('waiting for thread ',FHandle);
|
||||
WaitFor := WaitForThreadTerminate(FHandle, 0);
|
||||
WRITE_DEBUG('thread terminated');
|
||||
end;
|
||||
|
||||
procedure TThread.CallOnTerminate;
|
||||
begin
|
||||
// no need to check if FOnTerminate <> nil, because
|
||||
// thats already done in DoTerminate
|
||||
FOnTerminate(self);
|
||||
end;
|
||||
|
||||
procedure TThread.DoTerminate;
|
||||
begin
|
||||
if Assigned(FOnTerminate) then
|
||||
Synchronize(@CallOnTerminate);
|
||||
end;
|
||||
|
||||
function TThread.GetPriority: TThreadPriority;
|
||||
var
|
||||
P: Integer;
|
||||
I: TThreadPriority;
|
||||
begin
|
||||
P := ThreadGetPriority(FHandle);
|
||||
Result := tpNormal;
|
||||
for I := Low(TThreadPriority) to High(TThreadPriority) do
|
||||
if Priorities[I] = P then
|
||||
Result := I;
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TThread.Synchronize(Method: TThreadMethod);
|
||||
begin
|
||||
{$TODO someone with more clue of the GUI stuff will have to do this}
|
||||
end;
|
||||
*)
|
||||
procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
begin
|
||||
ThreadSetPriority(FHandle, Priorities[Value]);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
@ -14,7 +14,16 @@
|
||||
|
||||
{$define uselibc:=cdecl; external;}
|
||||
|
||||
const libname='c';
|
||||
const
|
||||
{$ifdef BEOS}
|
||||
{$ifdef HAIKU}
|
||||
libname = 'network';
|
||||
{$else}
|
||||
libname = 'net';
|
||||
{$endif}
|
||||
{$else}
|
||||
libname='c';
|
||||
{$endif}
|
||||
|
||||
function cfpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint; cdecl; external libname name 'accept';
|
||||
function cfpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint; cdecl; external libname name 'bind';
|
||||
@ -32,7 +41,12 @@ function cfpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psock
|
||||
function cfpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint; cdecl; external libname name 'setsockopt';
|
||||
function cfpshutdown (s:cint; how:cint):cint; cdecl; external libname name 'shutdown';
|
||||
function cfpsocket (domain:cint; xtype:cint; protocol: cint):cint; cdecl; external libname name 'socket';
|
||||
|
||||
{$if defined(BEOS) and not defined(HAIKU)}
|
||||
// function unavailable under BeOS
|
||||
{$else}
|
||||
function cfpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint; cdecl; external libname name 'socketpair';
|
||||
{$endif}
|
||||
|
||||
|
||||
function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
|
||||
@ -120,9 +134,16 @@ begin
|
||||
internal_socketerror:=fpgeterrno;
|
||||
end;
|
||||
|
||||
{$if defined(BEOS) and not defined(HAIKU)}
|
||||
// function unavailable under BeOS
|
||||
function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
|
||||
begin
|
||||
internal_socketerror:= -1; // TODO : check if it is an error
|
||||
end;
|
||||
{$else}
|
||||
function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
|
||||
begin
|
||||
fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
|
||||
internal_socketerror:=fpgeterrno;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
@ -47,7 +47,9 @@ interface
|
||||
{$ifndef dynpthreads} // If you have problems compiling this on FreeBSD 5.x
|
||||
{$linklib c} // try adding -Xf
|
||||
{$ifndef Darwin}
|
||||
{$linklib pthread}
|
||||
{$ifndef haiku}
|
||||
{$linklib pthread}
|
||||
{$endif haiku}
|
||||
{$endif darwin}
|
||||
{$endif}
|
||||
|
||||
@ -278,7 +280,9 @@ Type PINTRTLEvent = ^TINTRTLEvent;
|
||||
writeln('Starting new thread');
|
||||
{$endif DEBUG_MT}
|
||||
pthread_attr_init(@thread_attr);
|
||||
{$ifndef HAIKU}
|
||||
pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
|
||||
{$endif}
|
||||
|
||||
// will fail under linux -- apparently unimplemented
|
||||
pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
|
||||
@ -1092,4 +1096,4 @@ initialization
|
||||
end;
|
||||
SetCThreadManager;
|
||||
finalization
|
||||
end.
|
||||
end.
|
||||
@ -26,8 +26,12 @@ implementation
|
||||
|
||||
{$linklib c}
|
||||
|
||||
{$if not defined(linux) and not defined(solaris) and not defined(haiku)} // Linux (and maybe glibc platforms in general), have iconv in glibc.
|
||||
{$linklib iconv}
|
||||
{$if not defined(linux) and not defined(solaris)} // Linux (and maybe glibc platforms in general), have iconv in glibc.
|
||||
{$if defined(haiku)}
|
||||
{$linklib textencoding}
|
||||
{$else}
|
||||
{$linklib iconv}
|
||||
{$endif}
|
||||
{$define useiconv}
|
||||
{$endif linux}
|
||||
|
||||
@ -42,7 +46,11 @@ Const
|
||||
{$ifndef useiconv}
|
||||
libiconvname='c'; // is in libc under Linux.
|
||||
{$else}
|
||||
{$ifdef haiku}
|
||||
libiconvname='textencoding'; // is in libtextencoding under Haiku
|
||||
{$else}
|
||||
libiconvname='iconv';
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{ helper functions from libc }
|
||||
@ -89,7 +97,11 @@ const
|
||||
{$ifdef beos}
|
||||
{$warning check correct value for BeOS}
|
||||
CODESET=49;
|
||||
LC_ALL = 6; // Checked for BeOS, but 0 under Haiku...
|
||||
{$ifdef haiku}
|
||||
LC_ALL = 0; // Checked for Haiku
|
||||
{$else}
|
||||
LC_ALL = 6; // Checked for BeOS
|
||||
{$endif}
|
||||
ESysEILSEQ = EILSEQ;
|
||||
{$else}
|
||||
{$error lookup the value of CODESET in /usr/include/langinfo.h, and the value of LC_ALL in /usr/include/locale.h for your OS }
|
||||
@ -124,7 +136,7 @@ type
|
||||
function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
|
||||
{$endif}
|
||||
|
||||
{$if (not defined(bsd) and not defined(beos)) or defined(darwin) or defined(haiku)}
|
||||
{$if (not defined(bsd) and not defined(beos)) or defined(darwin)}
|
||||
function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
|
||||
function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
|
||||
function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'iconv_close';
|
||||
@ -759,4 +771,3 @@ finalization
|
||||
{ fini conversion tables for main program }
|
||||
FiniThread;
|
||||
end.
|
||||
|
||||
|
||||
@ -81,10 +81,10 @@ const
|
||||
{$ifdef beos}
|
||||
{$ifdef haiku}
|
||||
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 'network' name 'poll';
|
||||
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';
|
||||
Function FpPoll (fds: ppollfd; nfds: cuint; timeout: clong): cint; cdecl; external 'net' name 'poll';
|
||||
Function FpPoll (fds: ppollfd; nfds: cuint; timeout: clong): cint; cdecl; external clib name 'poll';
|
||||
{$endif}
|
||||
{$else}
|
||||
Function FPSelect (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external clib name 'select';
|
||||
@ -158,4 +158,4 @@ const
|
||||
|
||||
{$ifdef linux}
|
||||
function FpPrCtl(options : cInt; const args : ptruint) : cint; cdecl; external clib name 'prctl';
|
||||
{$endif}
|
||||
{$endif}
|
||||
Loading…
Reference in New Issue
Block a user