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

- removed legacy code

Browse Source
This commit is contained in:
Jonas Maebe 2004-03-04 12:42:44 +00:00
parent fad9a3ed01
commit 45863d051d
1 changed files with 4 additions and 316 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

320
rtl/darwin/tthread.inc
View File

@ -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. 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
@ -375,9 +96,6 @@ end;
var var
ThreadsInited: boolean = false; ThreadsInited: boolean = false;
{$IFDEF LINUX}
GMainPID: LongInt = 0;
{$ENDIF}
const const
// stupid, considering its not even implemented... // stupid, considering its not even implemented...
Priorities: array [TThreadPriority] of Integer = Priorities: array [TThreadPriority] of Integer =
@ -387,9 +105,6 @@ procedure InitThreads;
begin begin
if not ThreadsInited then begin if not ThreadsInited then begin
ThreadsInited := true; ThreadsInited := true;
{$IFDEF LINUX}
GMainPid := fpgetpid();
{$ENDIF}
end; end;
end; end;
@ -414,12 +129,6 @@ var
begin begin
WRITE_DEBUG('ThreadFunc is here...'); WRITE_DEBUG('ThreadFunc is here...');
LThread := TThread(parameter); 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)); WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
try try
if LThread.FInitialSuspended then begin if LThread.FInitialSuspended then begin
@ -512,22 +221,7 @@ begin
SemaphoreWait(FSem); SemaphoreWait(FSem);
end else begin end else begin
FSuspendedExternal := true; 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); SuspendThread(FHandle);
{$ENDIF}
end; end;
end; end;
end; end;
@ -542,15 +236,7 @@ begin
FSuspended := False; FSuspended := False;
end; end;
end else begin end else begin
{$IFDEF LINUX}
// see .Suspend
if FPid <> GMainPID then begin
fpkill(FPid, SIGCONT);
FSuspended := False;
end;
{$ELSE}
ResumeThread(FHandle); ResumeThread(FHandle);
{$ENDIF}
FSuspendedExternal := false; FSuspendedExternal := false;
end; end;
end; end;
@ -602,11 +288,13 @@ procedure TThread.SetPriority(Value: TThreadPriority);
begin begin
ThreadSetPriority(FHandle, Priorities[Value]); ThreadSetPriority(FHandle, Priorities[Value]);
end; end;
{$ENDIF}
{ {
$Log$ $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 * fixed compilation
Revision 1.1 2004/01/04 20:05:38 jonas Revision 1.1 2004/01/04 20:05:38 jonas