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