mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 15:19:25 +02:00
- removed legacy code
This commit is contained in:
Jonas Maebe
parent
fad9a3ed01
commit
45863d051d
@ -15,285 +15,6 @@
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
{$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
|
||||
@ -375,9 +96,6 @@ end;
|
||||
|
||||
var
|
||||
ThreadsInited: boolean = false;
|
||||
{$IFDEF LINUX}
|
||||
GMainPID: LongInt = 0;
|
||||
{$ENDIF}
|
||||
const
|
||||
// stupid, considering its not even implemented...
|
||||
Priorities: array [TThreadPriority] of Integer =
|
||||
@ -387,9 +105,6 @@ procedure InitThreads;
|
||||
begin
|
||||
if not ThreadsInited then begin
|
||||
ThreadsInited := true;
|
||||
{$IFDEF LINUX}
|
||||
GMainPid := fpgetpid();
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -414,12 +129,6 @@ var
|
||||
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
|
||||
@ -512,22 +221,7 @@ begin
|
||||
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;
|
||||
@ -542,15 +236,7 @@ begin
|
||||
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;
|
||||
@ -602,11 +288,13 @@ procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
begin
|
||||
ThreadSetPriority(FHandle, Priorities[Value]);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2004-03-04 12:34:36 jonas
|
||||
Revision 1.3 2004-03-04 12:42:44 jonas
|
||||
- removed legacy code
|
||||
|
||||
Revision 1.2 2004/03/04 12:34:36 jonas
|
||||
* fixed compilation
|
||||
|
||||
Revision 1.1 2004/01/04 20:05:38 jonas
|
||||
|
||||
Loading…
Reference in New Issue
Block a user