nothreads.pp 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304
  1. {$IFNDEF FPC_DOTTEDUNITS}
  2. unit nothreads;
  3. {$ENDIF}
  4. {$mode objfpc}
  5. interface
  6. Procedure SetFakeThreadManager;
  7. implementation
  8. Const
  9. wrSignaled = 0;
  10. wrTimeout = 1;
  11. wrAbandoned= 2;
  12. wrError = 3;
  13. var
  14. threadvarblocksize : dword = 0;
  15. threadvarblock : array[1..64*10240] of byte;
  16. threadcount : Integer;
  17. procedure FakeInitThreadvar(var offset : dword;size : dword);
  18. begin
  19. offset:=threadvarblocksize;
  20. inc(threadvarblocksize,size);
  21. end;
  22. procedure FakeAllocateThreadVars;
  23. begin
  24. end;
  25. procedure FakethreadCleanup(p: pointer); cdecl;
  26. begin
  27. end;
  28. procedure HookThread;
  29. begin
  30. { Allocate local thread vars, this must be the first thing,
  31. because the exception management and io depends on threadvars }
  32. FakeAllocateThreadVars;
  33. InitThread(1000000000);
  34. end;
  35. function FakeRelocateThreadvar(offset : dword) : pointer;
  36. begin
  37. FakeRelocateThreadvar:=@ThreadVarBlock;
  38. end;
  39. procedure FakeReleaseThreadVars;
  40. begin
  41. end;
  42. Procedure InitCTLS;
  43. begin
  44. end;
  45. function FakeBeginThread(sa : Pointer;stacksize : PtrUInt;
  46. ThreadFunction : tthreadfunc;p : pointer;
  47. creationFlags : dword; var ThreadId : TThreadId) : TThreadID;
  48. begin
  49. Inc(ThreadCount);
  50. Result:=TThreadID(ThreadCount);
  51. ThreadFunction(P);
  52. end;
  53. procedure FakeEndThread(ExitCode : DWord);
  54. begin
  55. end;
  56. function FakeSuspendThread (threadHandle : TThreadID) : dword;
  57. begin
  58. result:=dword(-1);
  59. end;
  60. function FakeResumeThread (threadHandle : TThreadID) : dword;
  61. begin
  62. result:=dword(-1);
  63. end;
  64. procedure FakeThreadSwitch; {give time to other threads}
  65. begin
  66. end;
  67. function FakeKillThread (threadHandle : TThreadID) : dword;
  68. begin
  69. Result:= dword(-1);
  70. end;
  71. function FakeCloseThread (threadHandle : TThreadID) : dword;
  72. begin
  73. result:=0;
  74. end;
  75. function FakeWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
  76. begin
  77. Result:=0
  78. end;
  79. function FakeThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
  80. begin
  81. result:=false;
  82. end;
  83. function FakeThreadGetPriority (threadHandle : TThreadID): Integer;
  84. begin
  85. result:=0;
  86. end;
  87. function FakeGetCurrentThreadId : TThreadID;
  88. begin
  89. Result:=TThreadID(0);
  90. end;
  91. procedure FakeSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
  92. begin
  93. end;
  94. procedure FakeSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
  95. begin
  96. end;
  97. {*****************************************************************************
  98. Delphi/Win32 compatibility
  99. *****************************************************************************}
  100. procedure FakeInitCriticalSection(var CS);
  101. begin
  102. PLongint(@cs)^:=0;
  103. end;
  104. procedure FakeEnterCriticalSection(var CS);
  105. begin
  106. end;
  107. function FakeTryEnterCriticalSection(var CS):longint;
  108. begin
  109. Result:=0;
  110. end;
  111. procedure FakeLeaveCriticalSection(var CS);
  112. begin
  113. end;
  114. procedure FakeDoneCriticalSection(var CS);
  115. begin
  116. end;
  117. {*****************************************************************************
  118. Semaphore routines
  119. *****************************************************************************}
  120. var
  121. Dummy : Integer;
  122. function FakeBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
  123. begin
  124. Result:=pEventState(@Dummy);
  125. end;
  126. procedure FakeBasiceventdestroy(state:peventstate);
  127. begin
  128. end;
  129. procedure FakeBasiceventResetEvent(state:peventstate);
  130. begin
  131. end;
  132. procedure FakeBasiceventSetEvent(state:peventstate);
  133. begin
  134. end;
  135. function FakeBasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
  136. begin
  137. Result:=wrSignaled;
  138. end;
  139. function FakeRTLEventCreate: PRTLEvent;
  140. begin
  141. result:=PRTLEVENT(@Dummy);
  142. end;
  143. procedure FakeRTLEventDestroy(AEvent: PRTLEvent);
  144. begin
  145. end;
  146. procedure FakeRTLEventSetEvent(AEvent: PRTLEvent);
  147. begin
  148. end;
  149. procedure FakeRTLEventResetEvent(AEvent: PRTLEvent);
  150. begin
  151. end;
  152. procedure FakeRTLEventWaitFor(AEvent: PRTLEvent);
  153. begin
  154. end;
  155. procedure FakeRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
  156. begin
  157. end;
  158. Function FakeInitThreads : Boolean;
  159. begin
  160. Result:=True;
  161. end;
  162. Function FakeDoneThreads : Boolean;
  163. begin
  164. Result:=True;
  165. end;
  166. Var
  167. FakeThreadManager : TThreadManager;
  168. Procedure SetFakeThreadManager;
  169. begin
  170. With FakeThreadManager do begin
  171. InitManager :=@FakeInitThreads;
  172. DoneManager :=@FakeDoneThreads;
  173. BeginThread :=@FakeBeginThread;
  174. EndThread :=@FakeEndThread;
  175. SuspendThread :=@FakeSuspendThread;
  176. ResumeThread :=@FakeResumeThread;
  177. KillThread :=@FakeKillThread;
  178. ThreadSwitch :=@FakeThreadSwitch;
  179. CloseThread :=@FakeCloseThread;
  180. WaitForThreadTerminate :=@FakeWaitForThreadTerminate;
  181. ThreadSetPriority :=@FakeThreadSetPriority;
  182. ThreadGetPriority :=@FakeThreadGetPriority;
  183. GetCurrentThreadId :=@FakeGetCurrentThreadId;
  184. SetThreadDebugNameA :=@FakeSetThreadDebugNameA;
  185. SetThreadDebugNameU :=@FakeSetThreadDebugNameU;
  186. InitCriticalSection :=@FakeInitCriticalSection;
  187. DoneCriticalSection :=@FakeDoneCriticalSection;
  188. EnterCriticalSection :=@FakeEnterCriticalSection;
  189. TryEnterCriticalSection:=@FakeTryEnterCriticalSection;
  190. LeaveCriticalSection :=@FakeLeaveCriticalSection;
  191. InitThreadVar :=@FakeInitThreadVar;
  192. RelocateThreadVar :=@FakeRelocateThreadVar;
  193. AllocateThreadVars :=@FakeAllocateThreadVars;
  194. ReleaseThreadVars :=@FakeReleaseThreadVars;
  195. BasicEventCreate :=@FakeBasicEventCreate;
  196. BasicEventDestroy :=@FakeBasicEventDestroy;
  197. BasicEventResetEvent :=@FakeBasicEventResetEvent;
  198. BasicEventSetEvent :=@FakeBasicEventSetEvent;
  199. BasiceventWaitFor :=@FakeBasiceventWaitFor;
  200. rtlEventCreate :=@FakertlEventCreate;
  201. rtlEventDestroy :=@FakertlEventDestroy;
  202. rtlEventSetEvent :=@FakertlEventSetEvent;
  203. rtlEventResetEvent :=@FakertlEventResetEvent;
  204. rtleventWaitForTimeout :=@FakertleventWaitForTimeout;
  205. rtleventWaitFor :=@FakertleventWaitFor;
  206. end;
  207. SetThreadManager(FakeThreadManager);
  208. end;
  209. initialization
  210. SetFakeThreadManager;
  211. finalization
  212. end.