1{
2    This file is part of the Free Pascal Run time library.
3    Copyright (c) 2000 by the Free Pascal development team
4
5    This file contains the OS indenpendend declartions for multi
6    threading support in FPC
7
8    See the File COPYING.FPC, included in this distribution,
9    for details about the copyright.
10
11    This program is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 **********************************************************************}
16
17const
18{$ifndef FPC_USE_SMALL_DEFAULTSTACKSIZE}
19  { includes 16384 bytes margin for stackchecking }
20  DefaultStackSize = 4*1024*1024;
21{$else i.e. FPC_USE_SMALL_DEFAULTSTACKSIZE}
22  { Special value of Default stack size }
23  DefaultStackSize = 16 * 1024;
24{$endif not FPC_USE_SMALL_DEFAULTSTACKSIZE}
25
26{ every platform can have it's own implementation of GetCPUCount; use the define
27  HAS_GETCPUCOUNT to disable the default implementation which simply returns 1 }
28function GetCPUCount: LongWord;
29
30property CPUCount: LongWord read GetCPUCount;
31
32type
33  PEventState = pointer;
34  PRTLEvent   = type pointer;   // Windows=thandle, other=pointer to record.
35  TThreadFunc = function(parameter : pointer) : ptrint;
36  trtlmethod  = procedure of object;
37
38  // Function prototypes for TThreadManager Record.
39  TBeginThreadHandler = Function (sa : Pointer;stacksize : PtrUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
40  TEndThreadHandler = Procedure (ExitCode : DWord);
41  // Used for Suspend/Resume/Kill
42  TThreadHandler = Function (threadHandle : TThreadID) : dword;
43  TThreadSwitchHandler = Procedure;
44  TWaitForThreadTerminateHandler = Function (threadHandle : TThreadID; TimeoutMs : longint) : dword;  {0=no timeout}
45  TThreadSetPriorityHandler = Function (threadHandle : TThreadID; Prio: longint): boolean;            {-15..+15, 0=normal}
46  TThreadGetPriorityHandler = Function (threadHandle : TThreadID): longint;
47  TGetCurrentThreadIdHandler = Function : TThreadID;
48  TThreadSetThreadDebugNameHandlerA = procedure(threadHandle: TThreadID; const ThreadName: AnsiString);
49{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
50  TThreadSetThreadDebugNameHandlerU = procedure(threadHandle: TThreadID; const ThreadName: UnicodeString);
51{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
52  TCriticalSectionHandler = Procedure (var cs);
53  TCriticalSectionHandlerTryEnter = function (var cs):longint;
54  TInitThreadVarHandler = Procedure(var offset : {$ifdef cpu16}word{$else}dword{$endif};size : dword);
55  TRelocateThreadVarHandler = Function(offset : {$ifdef cpu16}word{$else}dword{$endif}) : pointer;
56  TAllocateThreadVarsHandler = Procedure;
57  TReleaseThreadVarsHandler = Procedure;
58  TBasicEventHandler        = procedure(state:peventstate);
59  TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
60  TBasicEventCreateHandler  = function (EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
61  TRTLEventHandler          = procedure(AEvent:PRTLEvent);
62  TRTLEventHandlerTimeout   = procedure(AEvent:PRTLEvent;timeout : longint);
63  TRTLCreateEventHandler    = function:PRTLEvent;
64  // semaphores stuff
65  TSempahoreInitHandler     = function: Pointer;
66  TSemaphoreDestroyHandler  = procedure (const sem: Pointer);
67  TSemaphorePostHandler     = procedure (const sem: Pointer);
68  TSemaphoreWaitHandler     = procedure (const sem: Pointer);
69
70  // TThreadManager interface.
71  TThreadManager = Record
72    InitManager            : Function : Boolean;
73    DoneManager            : Function : Boolean;
74    BeginThread            : TBeginThreadHandler;
75    EndThread              : TEndThreadHandler;
76    SuspendThread          : TThreadHandler;
77    ResumeThread           : TThreadHandler;
78    KillThread             : TThreadHandler;
79    CloseThread            : TThreadHandler;
80    ThreadSwitch           : TThreadSwitchHandler;
81    WaitForThreadTerminate : TWaitForThreadTerminateHandler;
82    ThreadSetPriority      : TThreadSetPriorityHandler;
83    ThreadGetPriority      : TThreadGetPriorityHandler;
84    GetCurrentThreadId     : TGetCurrentThreadIdHandler;
85    SetThreadDebugNameA    : TThreadSetThreadDebugNameHandlerA;
86{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
87    SetThreadDebugNameU    : TThreadSetThreadDebugNameHandlerU;
88{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
89    InitCriticalSection    : TCriticalSectionHandler;
90    DoneCriticalSection    : TCriticalSectionHandler;
91    EnterCriticalSection   : TCriticalSectionHandler;
92    TryEnterCriticalSection: TCriticalSectionHandlerTryEnter;
93    LeaveCriticalSection   : TCriticalSectionHandler;
94    InitThreadVar          : TInitThreadVarHandler;
95    RelocateThreadVar      : TRelocateThreadVarHandler;
96    AllocateThreadVars     : TAllocateThreadVarsHandler;
97    ReleaseThreadVars      : TReleaseThreadVarsHandler;
98    BasicEventCreate       : TBasicEventCreateHandler;      // left in for a while.
99    BasicEventDestroy      : TBasicEventHandler;            // we might need BasicEvent
100    BasicEventResetEvent   : TBasicEventHandler;            // for a real TEvent
101    BasicEventSetEvent     : TBasicEventHandler;
102    BasiceventWaitFOr      : TBasicEventWaitForHandler;
103    RTLEventCreate         : TRTLCreateEventHandler;
104    RTLEventDestroy        : TRTLEventHandler;
105    RTLEventSetEvent       : TRTLEventHandler;
106    RTLEventResetEvent     : TRTLEventHandler;
107    RTLEventWaitFor        : TRTLEventHandler;
108    RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
109  end;
110
111{*****************************************************************************
112                         Thread Handler routines
113*****************************************************************************}
114
115
116Function GetThreadManager(Var TM : TThreadManager) : Boolean;
117Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean;
118Function SetThreadManager(Const NewTM : TThreadManager) : Boolean;
119{$ifndef DISABLE_NO_THREAD_MANAGER}
120{$endif DISABLE_NO_THREAD_MANAGER}
121// Needs to be exported, so the manager can call it.
122{$ifndef FPC_SECTION_THREADVARS}
123procedure InitThreadVars(RelocProc : TRelocateThreadVarHandler);
124{$endif FPC_SECTION_THREADVARS}
125procedure InitThread(stklen:SizeUInt);
126procedure DoneThread;
127
128{*****************************************************************************
129                         Multithread Handling
130*****************************************************************************}
131
132function BeginThread(sa : Pointer;stacksize : SizeUInt;
133  ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
134  var ThreadId : TThreadID) : TThreadID;
135
136{ add some simplfied forms which make lifer easier and porting }
137{ to other OSes too ...                                        }
138function BeginThread(ThreadFunction : tthreadfunc) : TThreadID;
139function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : TThreadID;
140function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : TThreadID) : TThreadID;
141function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
142                     var ThreadId : TThreadID; const stacksize: SizeUInt) : TThreadID;
143
144procedure EndThread(ExitCode : DWord);
145procedure EndThread;
146
147{some thread support functions}
148procedure FlushThread;
149function  SuspendThread (threadHandle : TThreadID) : dword;
150function  ResumeThread  (threadHandle : TThreadID) : dword;
151function  CloseThread   (threadHandle : TThreadID) : dword;
152procedure ThreadSwitch;                                                                {give time to other threads}
153function  KillThread (threadHandle : TThreadID) : dword;
154function  WaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword;  {0=no timeout}
155function  ThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean;            {-15..+15, 0=normal}
156function  ThreadGetPriority (threadHandle : TThreadID): longint;
157function  GetCurrentThreadId : TThreadID;
158procedure SetThreadDebugName(threadHandle: TThreadID; const ThreadName: AnsiString);
159{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
160procedure SetThreadDebugName(threadHandle: TThreadID; const ThreadName: UnicodeString);
161{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
162
163
164{ this allows to do a lot of things in MT safe way }
165{ it is also used to make the heap management      }
166{ thread safe                                      }
167procedure InitCriticalSection(var cs : TRTLCriticalSection);
168procedure DoneCriticalSection(var cs : TRTLCriticalSection);
169procedure EnterCriticalSection(var cs : TRTLCriticalSection);
170procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
171function  TryEnterCriticalSection(var cs : TRTLCriticalSection):longint;
172function  BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
173procedure BasicEventDestroy(state:peventstate);
174procedure BasicEventResetEvent(state:peventstate);
175procedure BasicEventSetEvent(state:peventstate);
176function  BasicEventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
177
178function  RTLEventCreate :PRTLEvent;
179procedure RTLEventDestroy(state:pRTLEvent);
180procedure RTLEventSetEvent(state:pRTLEvent);
181procedure RTLEventResetEvent(state:pRTLEvent);
182procedure RTLEventWaitFor(state:pRTLEvent);
183procedure RTLEventWaitFor(state:pRTLEvent;timeout : longint);
184
185