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

* tthread disabled for 1.0.x

Browse Source
This commit is contained in:
peter 2003-11-19 15:51:54 +00:00
parent a427276302
commit 97d677c8c8
2 changed files with 15 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/linux/classes.pp
View File

@ -50,13 +50,18 @@ initialization
finalization finalization
CommonCleanup; CommonCleanup;
{$ifndef VER1_0}
if ThreadsInited then if ThreadsInited then
DoneThreads; DoneThreads;
{$endif}
end. end.
{ {
$Log$ $Log$
Revision 1.2 2003-11-10 16:54:28 marco Revision 1.3 2003-11-19 15:51:54 peter
* tthread disabled for 1.0.x
Revision 1.2 2003/11/10 16:54:28 marco
* new oldlinux unit. 1_0 defines killed in some former FCL parts. * new oldlinux unit. 1_0 defines killed in some former FCL parts.
Revision 1.1 2003/10/06 21:01:06 peter Revision 1.1 2003/10/06 21:01:06 peter

285
rtl/linux/tthread.inc
View File

@ -14,285 +14,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 := @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. What follows, is a short description on my implementation of TThread.
Most information can also be found by reading the source and accompanying Most information can also be found by reading the source and accompanying
@ -601,11 +322,13 @@ procedure TThread.SetPriority(Value: TThreadPriority);
begin begin
ThreadSetPriority(FHandle, Priorities[Value]); ThreadSetPriority(FHandle, Priorities[Value]);
end; end;
{$ENDIF}
{ {
$Log$ $Log$
Revision 1.4 2003-11-17 08:27:49 marco Revision 1.5 2003-11-19 15:51:54 peter
* tthread disabled for 1.0.x
Revision 1.4 2003/11/17 08:27:49 marco
* pthreads based ttread from Johannes Berg * pthreads based ttread from Johannes Berg
Revision 1.3 2003/11/10 16:54:28 marco Revision 1.3 2003/11/10 16:54:28 marco