123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304 |
- {$IFNDEF FPC_DOTTEDUNITS}
- unit nothreads;
- {$ENDIF}
- {$mode objfpc}
- interface
- Procedure SetFakeThreadManager;
- implementation
- Const
- wrSignaled = 0;
- wrTimeout = 1;
- wrAbandoned= 2;
- wrError = 3;
- var
- threadvarblocksize : dword = 0;
- threadvarblock : array[1..64*10240] of byte;
- threadcount : Integer;
- procedure FakeInitThreadvar(var offset : dword;size : dword);
- begin
- offset:=threadvarblocksize;
- inc(threadvarblocksize,size);
- end;
- procedure FakeAllocateThreadVars;
- begin
- end;
- procedure FakethreadCleanup(p: pointer); cdecl;
- begin
- end;
- procedure HookThread;
- begin
- { Allocate local thread vars, this must be the first thing,
- because the exception management and io depends on threadvars }
- FakeAllocateThreadVars;
- InitThread(1000000000);
- end;
- function FakeRelocateThreadvar(offset : dword) : pointer;
- begin
- FakeRelocateThreadvar:=@ThreadVarBlock;
- end;
- procedure FakeReleaseThreadVars;
- begin
- end;
- Procedure InitCTLS;
- begin
- end;
- function FakeBeginThread(sa : Pointer;stacksize : PtrUInt;
- ThreadFunction : tthreadfunc;p : pointer;
- creationFlags : dword; var ThreadId : TThreadId) : TThreadID;
- begin
- Inc(ThreadCount);
- Result:=TThreadID(ThreadCount);
- ThreadFunction(P);
- end;
- procedure FakeEndThread(ExitCode : DWord);
- begin
- end;
- function FakeSuspendThread (threadHandle : TThreadID) : dword;
- begin
- result:=dword(-1);
- end;
- function FakeResumeThread (threadHandle : TThreadID) : dword;
- begin
- result:=dword(-1);
- end;
- procedure FakeThreadSwitch; {give time to other threads}
- begin
- end;
- function FakeKillThread (threadHandle : TThreadID) : dword;
- begin
- Result:= dword(-1);
- end;
- function FakeCloseThread (threadHandle : TThreadID) : dword;
- begin
- result:=0;
- end;
- function FakeWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
- begin
- Result:=0
- end;
- function FakeThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
- begin
- result:=false;
- end;
- function FakeThreadGetPriority (threadHandle : TThreadID): Integer;
- begin
- result:=0;
- end;
- function FakeGetCurrentThreadId : TThreadID;
- begin
- Result:=TThreadID(0);
- end;
- procedure FakeSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
- begin
- end;
- procedure FakeSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
- begin
- end;
- {*****************************************************************************
- Delphi/Win32 compatibility
- *****************************************************************************}
- procedure FakeInitCriticalSection(var CS);
- begin
- PLongint(@cs)^:=0;
- end;
-
- procedure FakeEnterCriticalSection(var CS);
- begin
- end;
- function FakeTryEnterCriticalSection(var CS):longint;
- begin
- Result:=0;
- end;
- procedure FakeLeaveCriticalSection(var CS);
- begin
- end;
- procedure FakeDoneCriticalSection(var CS);
- begin
- end;
- {*****************************************************************************
- Semaphore routines
- *****************************************************************************}
- var
- Dummy : Integer;
- function FakeBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
- begin
- Result:=pEventState(@Dummy);
- end;
- procedure FakeBasiceventdestroy(state:peventstate);
- begin
- end;
- procedure FakeBasiceventResetEvent(state:peventstate);
- begin
- end;
- procedure FakeBasiceventSetEvent(state:peventstate);
- begin
- end;
- function FakeBasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
- begin
- Result:=wrSignaled;
- end;
- function FakeRTLEventCreate: PRTLEvent;
- begin
- result:=PRTLEVENT(@Dummy);
- end;
- procedure FakeRTLEventDestroy(AEvent: PRTLEvent);
- begin
- end;
- procedure FakeRTLEventSetEvent(AEvent: PRTLEvent);
- begin
- end;
- procedure FakeRTLEventResetEvent(AEvent: PRTLEvent);
- begin
- end;
- procedure FakeRTLEventWaitFor(AEvent: PRTLEvent);
- begin
- end;
- procedure FakeRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
- begin
- end;
- Function FakeInitThreads : Boolean;
- begin
- Result:=True;
- end;
- Function FakeDoneThreads : Boolean;
- begin
- Result:=True;
- end;
- Var
- FakeThreadManager : TThreadManager;
- Procedure SetFakeThreadManager;
- begin
- With FakeThreadManager do begin
- InitManager :=@FakeInitThreads;
- DoneManager :=@FakeDoneThreads;
- BeginThread :=@FakeBeginThread;
- EndThread :=@FakeEndThread;
- SuspendThread :=@FakeSuspendThread;
- ResumeThread :=@FakeResumeThread;
- KillThread :=@FakeKillThread;
- ThreadSwitch :=@FakeThreadSwitch;
- CloseThread :=@FakeCloseThread;
- WaitForThreadTerminate :=@FakeWaitForThreadTerminate;
- ThreadSetPriority :=@FakeThreadSetPriority;
- ThreadGetPriority :=@FakeThreadGetPriority;
- GetCurrentThreadId :=@FakeGetCurrentThreadId;
- SetThreadDebugNameA :=@FakeSetThreadDebugNameA;
- SetThreadDebugNameU :=@FakeSetThreadDebugNameU;
- InitCriticalSection :=@FakeInitCriticalSection;
- DoneCriticalSection :=@FakeDoneCriticalSection;
- EnterCriticalSection :=@FakeEnterCriticalSection;
- TryEnterCriticalSection:=@FakeTryEnterCriticalSection;
- LeaveCriticalSection :=@FakeLeaveCriticalSection;
- InitThreadVar :=@FakeInitThreadVar;
- RelocateThreadVar :=@FakeRelocateThreadVar;
- AllocateThreadVars :=@FakeAllocateThreadVars;
- ReleaseThreadVars :=@FakeReleaseThreadVars;
- BasicEventCreate :=@FakeBasicEventCreate;
- BasicEventDestroy :=@FakeBasicEventDestroy;
- BasicEventResetEvent :=@FakeBasicEventResetEvent;
- BasicEventSetEvent :=@FakeBasicEventSetEvent;
- BasiceventWaitFor :=@FakeBasiceventWaitFor;
- rtlEventCreate :=@FakertlEventCreate;
- rtlEventDestroy :=@FakertlEventDestroy;
- rtlEventSetEvent :=@FakertlEventSetEvent;
- rtlEventResetEvent :=@FakertlEventResetEvent;
- rtleventWaitForTimeout :=@FakertleventWaitForTimeout;
- rtleventWaitFor :=@FakertleventWaitFor;
- end;
- SetThreadManager(FakeThreadManager);
- end;
- initialization
- SetFakeThreadManager;
-
- finalization
- end.
|