mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 13:49:21 +02:00
* NetBSD fcl makefile fixes. Plain copy from FreeBSD
This commit is contained in:
marco
parent
c304a73c77
commit
b564e018d1
@ -1,5 +1,5 @@
|
|||||||
#
|
#
|
||||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/30]
|
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/09/05]
|
||||||
#
|
#
|
||||||
default: all
|
default: all
|
||||||
override PATH:=$(subst \,/,$(PATH))
|
override PATH:=$(subst \,/,$(PATH))
|
||||||
@ -146,6 +146,9 @@ endif
|
|||||||
ifeq ($(OS_TARGET),freebsd)
|
ifeq ($(OS_TARGET),freebsd)
|
||||||
override TARGET_UNITS+=process asyncio ssockets http
|
override TARGET_UNITS+=process asyncio ssockets http
|
||||||
endif
|
endif
|
||||||
|
ifeq ($(OS_TARGET),netbsd)
|
||||||
|
override TARGET_UNITS+=process asyncio ssockets http
|
||||||
|
endif
|
||||||
override TARGET_RSTS+=classes ssockets cachecls
|
override TARGET_RSTS+=classes ssockets cachecls
|
||||||
override TARGET_EXAMPLEDIRS+=tests
|
override TARGET_EXAMPLEDIRS+=tests
|
||||||
override INSTALL_FPCPACKAGE=y
|
override INSTALL_FPCPACKAGE=y
|
||||||
@ -605,6 +608,7 @@ endif
|
|||||||
ifeq ($(OS_TARGET),netbsd)
|
ifeq ($(OS_TARGET),netbsd)
|
||||||
REQUIRE_PACKAGES_RTL=1
|
REQUIRE_PACKAGES_RTL=1
|
||||||
REQUIRE_PACKAGES_PASZLIB=1
|
REQUIRE_PACKAGES_PASZLIB=1
|
||||||
|
REQUIRE_PACKAGES_INET=1
|
||||||
endif
|
endif
|
||||||
ifeq ($(OS_TARGET),amiga)
|
ifeq ($(OS_TARGET),amiga)
|
||||||
REQUIRE_PACKAGES_RTL=1
|
REQUIRE_PACKAGES_RTL=1
|
||||||
|
|||||||
@ -10,11 +10,13 @@ version=1.0.5
|
|||||||
packages=paszlib
|
packages=paszlib
|
||||||
packages_linux=inet
|
packages_linux=inet
|
||||||
packages_freebsd=inet
|
packages_freebsd=inet
|
||||||
|
packages_netbsd=inet
|
||||||
|
|
||||||
[target]
|
[target]
|
||||||
dirs=xml db shedit
|
dirs=xml db shedit
|
||||||
units=classes inifiles registry ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls
|
units=classes inifiles registry ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls
|
||||||
units_freebsd=process asyncio ssockets http
|
units_freebsd=process asyncio ssockets http
|
||||||
|
units_netbsd=process asyncio ssockets http
|
||||||
units_linux=process asyncio ssockets http
|
units_linux=process asyncio ssockets http
|
||||||
units_win32=process fileinfo
|
units_win32=process fileinfo
|
||||||
rsts=classes ssockets cachecls
|
rsts=classes ssockets cachecls
|
||||||
|
|||||||
109
fcl/netbsd/classes.pp
Normal file
109
fcl/netbsd/classes.pp
Normal file
@ -0,0 +1,109 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Component Library (FCL)
|
||||||
|
Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
|
||||||
|
|
||||||
|
Classes unit for linux
|
||||||
|
|
||||||
|
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}
|
||||||
|
|
||||||
|
{ determine the type of the resource/form file }
|
||||||
|
{$define Win16Res}
|
||||||
|
|
||||||
|
unit Classes;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
sysutils,
|
||||||
|
typinfo;
|
||||||
|
|
||||||
|
{$i classesh.inc}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef ver1_0}
|
||||||
|
linux
|
||||||
|
{$else}
|
||||||
|
unix
|
||||||
|
{$endif}
|
||||||
|
;
|
||||||
|
|
||||||
|
{ OS - independent class implementations are in /inc directory. }
|
||||||
|
{$i classes.inc}
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
CommonInit;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
CommonCleanup;
|
||||||
|
|
||||||
|
if ThreadsInited then
|
||||||
|
DoneThreads;
|
||||||
|
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2001-09-05 14:30:04 marco
|
||||||
|
* NetBSD fcl makefile fixes. Plain copy from FreeBSD
|
||||||
|
|
||||||
|
Revision 1.4 2001/04/08 11:26:03 peter
|
||||||
|
* update so it can be compiled by both 1.0.x and 1.1
|
||||||
|
|
||||||
|
Revision 1.3 2001/01/21 20:45:09 marco
|
||||||
|
* Rename fest II FCL version.
|
||||||
|
|
||||||
|
Revision 1.2 2000/10/26 22:30:21 peter
|
||||||
|
* freebsd update
|
||||||
|
* classes.rst
|
||||||
|
|
||||||
|
Revision 1.1.2.1 2000/10/17 13:47:43 marco
|
||||||
|
* Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
|
||||||
|
packaging
|
||||||
|
|
||||||
|
Revision 1.1 2000/07/13 06:31:32 michael
|
||||||
|
+ Initial import
|
||||||
|
|
||||||
|
Revision 1.19 2000/07/01 09:49:02 peter
|
||||||
|
* fixed go32v2,win32 build
|
||||||
|
|
||||||
|
Revision 1.18 2000/06/29 16:32:06 sg
|
||||||
|
* Changes in initialisation/finalisation for streaming support
|
||||||
|
|
||||||
|
Revision 1.17 2000/06/27 17:17:34 lazarus
|
||||||
|
Added code for registerclass, GetClass and RegisterClasses
|
||||||
|
Shane
|
||||||
|
|
||||||
|
Revision 1.16 2000/06/27 15:55:19 lazarus
|
||||||
|
Added TThreadlist code. Shane
|
||||||
|
|
||||||
|
Revision 1.15 2000/01/07 01:24:34 peter
|
||||||
|
* updated copyright to 2000
|
||||||
|
|
||||||
|
Revision 1.14 2000/01/07 00:01:33 peter
|
||||||
|
* uses typinfo moved to interface
|
||||||
|
|
||||||
|
Revision 1.13 2000/01/06 01:20:33 peter
|
||||||
|
* moved out of packages/ back to topdir
|
||||||
|
|
||||||
|
Revision 1.2 2000/01/04 18:07:58 michael
|
||||||
|
+ Added typinfo unit
|
||||||
|
|
||||||
|
Revision 1.1 2000/01/03 19:33:09 peter
|
||||||
|
* moved to packages dir
|
||||||
|
|
||||||
|
Revision 1.11 1999/05/30 10:46:41 peter
|
||||||
|
* start of tthread for linux,win32
|
||||||
|
|
||||||
|
}
|
||||||
141
fcl/netbsd/process.inc
Normal file
141
fcl/netbsd/process.inc
Normal file
@ -0,0 +1,141 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2000 by Michael Van Canneyt
|
||||||
|
|
||||||
|
Linux specific part of TProcess.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef ver1_0}
|
||||||
|
Linux
|
||||||
|
{$else}
|
||||||
|
Unix
|
||||||
|
{$endif}
|
||||||
|
;
|
||||||
|
|
||||||
|
Function TProcess.GetRunning : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
IF FRunning then
|
||||||
|
FRunning:=GetExitStatus=-1;
|
||||||
|
Result:=FRunning;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TProcess.Execute;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FreeStreams;
|
||||||
|
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
||||||
|
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
||||||
|
If poUsePipes in FCreateOptions then
|
||||||
|
begin
|
||||||
|
if poStdErrToOutPut in FCreateOptions then
|
||||||
|
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FChildErrorStream:=FChildOutPutStream;
|
||||||
|
FParentErrorStream:=FParentInputStream;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
CreatePipeStreams (FParentErrorStream,FChildErrorStream);
|
||||||
|
If FCurrentDirectory<>'' then
|
||||||
|
Chdir(FCurrentDirectory);
|
||||||
|
FHandle:=fork();
|
||||||
|
if FHandle=0 then
|
||||||
|
begin
|
||||||
|
// Child
|
||||||
|
fdClose(0);
|
||||||
|
fdClose(1);
|
||||||
|
fdclose(2);
|
||||||
|
dup2(FChildInputStream.Handle,0);
|
||||||
|
dup2(FCHildOutputStream.Handle,1);
|
||||||
|
dup2(FChildErrorStream.Handle,2);
|
||||||
|
execl(FCommandline);
|
||||||
|
halt(127);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Parent
|
||||||
|
FPID:=FHandle;
|
||||||
|
FThreadHandle:=FHandle;
|
||||||
|
fdclose(FChildOutputStream.Handle);
|
||||||
|
fdclose(FChildInputStream.Handle);
|
||||||
|
fdclose(FChildErrorStream.Handle);
|
||||||
|
FRunning:=True;
|
||||||
|
if (poWaitOnExit in FCreateOptions) and
|
||||||
|
not (poRunSuspended in FCreateOptions) then
|
||||||
|
WaitOnExit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.WaitOnExit : Dword;
|
||||||
|
|
||||||
|
begin
|
||||||
|
waitpid(FPID, nil, 0);
|
||||||
|
{
|
||||||
|
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
||||||
|
If Result<>Wait_Failed then
|
||||||
|
GetExitStatus;
|
||||||
|
} FRunning:=False;
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Suspend : Longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=Kill(Handle,SIGSTOP);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Resume : LongInt;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=Kill(FHandle,SIGCONT);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=False;
|
||||||
|
If ExitStatus=-1 then
|
||||||
|
Result:=Kill(FHandle,SIGTERM)=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2001-09-05 14:30:04 marco
|
||||||
|
* NetBSD fcl makefile fixes. Plain copy from FreeBSD
|
||||||
|
|
||||||
|
Revision 1.4 2001/04/08 11:26:03 peter
|
||||||
|
* update so it can be compiled by both 1.0.x and 1.1
|
||||||
|
|
||||||
|
Revision 1.3 2001/01/21 20:45:09 marco
|
||||||
|
* Rename fest II FCL version.
|
||||||
|
|
||||||
|
Revision 1.2 2000/10/26 22:30:21 peter
|
||||||
|
* freebsd update
|
||||||
|
* classes.rst
|
||||||
|
|
||||||
|
Revision 1.1.2.1 2000/10/17 13:47:43 marco
|
||||||
|
* Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
|
||||||
|
packaging
|
||||||
|
|
||||||
|
Revision 1.1 2000/07/13 06:33:44 michael
|
||||||
|
+ Initial import
|
||||||
|
|
||||||
|
Revision 1.5 2000/02/15 22:03:38 sg
|
||||||
|
* Inserted wrong copyright notice ;) Fixed.
|
||||||
|
|
||||||
|
Revision 1.4 2000/02/15 21:57:51 sg
|
||||||
|
* Added copyright notice and CVS log tags where necessary
|
||||||
|
|
||||||
|
}
|
||||||
330
fcl/netbsd/thread.inc
Normal file
330
fcl/netbsd/thread.inc
Normal file
@ -0,0 +1,330 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Component Library (FCL)
|
||||||
|
Copyright (c) 1999-2000 by Peter Vreman
|
||||||
|
|
||||||
|
Linux 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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
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 : longint;
|
||||||
|
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
|
||||||
|
waitpid(-1, nil, WNOHANG);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitThreads;
|
||||||
|
var
|
||||||
|
Act, OldAct: 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^.handler.sh := @SIGCHLDHandler;
|
||||||
|
Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
|
||||||
|
Act^.sa_mask := 0; //Do not block all signals ??. Don't need if SA_NOMASK in flags
|
||||||
|
|
||||||
|
SigAction(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
|
||||||
|
Thread.Execute;
|
||||||
|
FreeThread := Thread.FFreeOnTerminate;
|
||||||
|
Result := Thread.FReturnValue;
|
||||||
|
Thread.FFinished := True;
|
||||||
|
Thread.DoTerminate;
|
||||||
|
if FreeThread then
|
||||||
|
Thread.Free;
|
||||||
|
ExitProcess(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(pointer(FStackPointer),FStackSize);
|
||||||
|
inc(FStackPointer,FStackSize);
|
||||||
|
FCallExitProcess:=false;
|
||||||
|
{ Clone }
|
||||||
|
FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
|
||||||
|
if FSuspended then Suspend;
|
||||||
|
FThreadID := FHandle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TThread.Destroy;
|
||||||
|
begin
|
||||||
|
if not FFinished and not Suspended then
|
||||||
|
begin
|
||||||
|
Terminate;
|
||||||
|
WaitFor;
|
||||||
|
end;
|
||||||
|
if FHandle <> -1 then
|
||||||
|
Kill(FHandle, SIGKILL);
|
||||||
|
dec(FStackPointer,FStackSize);
|
||||||
|
Freemem(pointer(FStackPointer),FStackSize);
|
||||||
|
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 := {$ifdef ver1_0}Linux{$else}Unix{$endif}.GetPriority(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
|
||||||
|
{$ifdef ver1_0}Linux{$else}Unix{$endif}.SetPriority(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
|
||||||
|
Kill(FHandle, SIGSTOP);
|
||||||
|
FSuspended := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TThread.Resume;
|
||||||
|
begin
|
||||||
|
Kill(FHandle, SIGCONT);
|
||||||
|
FSuspended := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TThread.Terminate;
|
||||||
|
begin
|
||||||
|
FTerminated := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TThread.WaitFor: Integer;
|
||||||
|
var
|
||||||
|
status : longint;
|
||||||
|
begin
|
||||||
|
if FThreadID = MainThreadID then
|
||||||
|
WaitPid(0,@status,0)
|
||||||
|
else
|
||||||
|
WaitPid(FHandle,@status,0);
|
||||||
|
Result:=status;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2001-09-05 14:30:04 marco
|
||||||
|
* NetBSD fcl makefile fixes. Plain copy from FreeBSD
|
||||||
|
|
||||||
|
Revision 1.4 2001/04/08 11:26:03 peter
|
||||||
|
* update so it can be compiled by both 1.0.x and 1.1
|
||||||
|
|
||||||
|
Revision 1.3 2001/01/21 20:45:09 marco
|
||||||
|
* Rename fest II FCL version.
|
||||||
|
|
||||||
|
Revision 1.2 2000/10/26 22:30:21 peter
|
||||||
|
* freebsd update
|
||||||
|
* classes.rst
|
||||||
|
|
||||||
|
Revision 1.1.2.1 2000/10/17 13:47:43 marco
|
||||||
|
* Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
|
||||||
|
packaging
|
||||||
|
|
||||||
|
Revision 1.1 2000/07/13 06:33:44 michael
|
||||||
|
+ Initial import
|
||||||
|
|
||||||
|
Revision 1.9 2000/05/17 18:31:18 peter
|
||||||
|
* fixed for new sigactionrec
|
||||||
|
|
||||||
|
Revision 1.8 2000/01/07 01:24:34 peter
|
||||||
|
* updated copyright to 2000
|
||||||
|
|
||||||
|
Revision 1.7 2000/01/06 01:20:33 peter
|
||||||
|
* moved out of packages/ back to topdir
|
||||||
|
|
||||||
|
Revision 1.1 2000/01/03 19:33:09 peter
|
||||||
|
* moved to packages dir
|
||||||
|
|
||||||
|
Revision 1.5 1999/10/27 10:40:30 peter
|
||||||
|
* fixed threadproc decl
|
||||||
|
|
||||||
|
Revision 1.4 1999/08/28 09:32:26 peter
|
||||||
|
* readded header/log
|
||||||
|
|
||||||
|
Revision 1.2 1999/05/31 12:47:59 peter
|
||||||
|
* classes unit to unitobjects
|
||||||
|
|
||||||
|
Revision 1.1 1999/05/30 10:46:42 peter
|
||||||
|
* start of tthread for linux,win32
|
||||||
|
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user