WebSVN – Kolibri OS – /programs/develop/fp/rtl/systhrd.inc

{}
{XXX: Thread vars & TLS}
const
ThreadVarBlockSize: DWord = 0;
TLSGrowFor = 4096;
type
PTLSIndex = ^TTLSIndex;
TTLSIndex = record
CS: TRTLCriticalSection;
Slots: array[0..TLSGrowFor - 1] of record
TID: DWord;
Value: Pointer;
end;
end;
var
TLSKey: PTLSIndex;
function TLSAlloc(): PTLSIndex;
var
I: DWord;
begin
{New(Result);}
Result := kos_alloc(SizeOf(TTLSIndex));
InitCriticalSection(Result^.CS);
{SetLength(Result^.Slots, TLSGrowFor);}
for I := 0 to TLSGrowFor - 1 do
Result^.Slots[I].TID := 0;
end;
function TLSFree(TLSIndex: PTLSIndex): Boolean;
begin
DoneCriticalSection(TLSIndex^.CS);
{SetLength(TLSIndex^.Slots, 0);
Dispose(TLSIndex);}
kos_free(TLSIndex);
Result := True;
end;
procedure TLSSetValue(TLSIndex: PTLSIndex; Value: Pointer);
var
TID, I, Count, Slot: DWord;
begin
TID := GetCurrentThreadID();
EnterCriticalSection(TLSIndex^.CS);
Count := Length(TLSIndex^.Slots);
Slot := Count;
for I := 0 to Count - 1 do
if TLSIndex^.Slots[I].TID = TID then
begin
Slot := I;
Break;
end else
if TLSIndex^.Slots[I].TID = 0 then
Slot := I;
if Slot >= Count then
begin
Halt(123);
{SetLength(TLSIndex^.Slots, Count + TLSGrowFor);
FillChar(TLSIndex^.Slots[Count], TLSGrowFor * SizeOf(TLSIndex^.Slots[0]), #0);
Slot := Count;}
end;
TLSIndex^.Slots[Slot].TID := TID;
TLSIndex^.Slots[Slot].Value := Value;
LeaveCriticalSection(TLSIndex^.CS);
end;
function TLSGetValue(TLSIndex: PTLSIndex): Pointer;
var
TID, I, Count: DWord;
begin
Result := nil;
TID := GetCurrentThreadID();
EnterCriticalSection(TLSIndex^.CS);
Count := Length(TLSIndex^.Slots);
for I := 0 to Count - 1 do
if TLSIndex^.Slots[I].TID = TID then
begin
Result := TLSIndex^.Slots[I].Value;
break;
end;
LeaveCriticalSection(TLSIndex^.CS);
end;
procedure SysInitThreadVar(var Offset: DWord; Size: DWord);
begin
Offset := ThreadVarBlockSize;
Inc(ThreadVarBlockSize, Size);
end;
procedure SysAllocateThreadVars;
var
DataIndex: Pointer;
begin
{DataIndex := GetMem(ThreadVarBlockSize);}
DataIndex := kos_alloc(ThreadVarBlockSize);
FillChar(DataIndex^, ThreadVarBlockSize, #0);
TLSSetValue(TLSKey, DataIndex);
end;
function SysRelocateThreadVar(Offset: DWord): Pointer;
var
DataIndex: Pointer;
begin
DataIndex := TLSGetValue(TLSKey);
if DataIndex = nil then
begin
SysAllocateThreadVars;
DataIndex := TLSGetValue(TLSKey);
end;
Result := DataIndex + Offset;
end;
procedure SysReleaseThreadVars;
begin
{FreeMem(TLSGetValue(TLSKey));}
kos_free(TLSGetValue(TLSKey));
end;
{XXX: Thread}
type
PThreadInfo = ^TThreadInfo;
TThreadInfo = record
Func: TThreadFunc;
Arg: Pointer;
StackSize: PtrUInt;
Stack: Pointer;
end;
procedure ThreadMain(ThreadInfo: PThreadInfo);
var
Result: PtrInt;
begin
SysAllocateThreadVars;
with ThreadInfo^ do
begin
InitThread(StackSize);
try
Result := Func(Arg);
except
{TODO: ¡à ¡®â âì ®è¨¡ª¨}
WriteLn(StdErr, 'Exception in thread');
end;
FreeMem(Stack);
end;
asm
movl $-1, %eax
int $0x40
end;
end;
function SysBeginThread(sa: Pointer; StackSize: PtrUInt; ThreadFunction: TThreadFunc; Arg: Pointer; CreationFlags: DWord; var ThreadID: TThreadID): TThreadID;
{Stack, esp, ThreadInfo}
procedure EntryThreadMain; assembler;
asm
movl %esp, %eax
jmp ThreadMain
end;
var
Stack: Pointer;
ThreadInfo: PThreadInfo;
begin
if not IsMultiThread then
begin
TLSKey := TLSAlloc();
InitThreadVars(@SysRelocateThreadVar);
IsMultiThread := True;
end;
StackSize := (StackSize + 3) div 4;
Stack := GetMem(StackSize + SizeOf(TThreadInfo));
ThreadInfo := PThreadInfo(PByte(Stack) + StackSize);
ThreadInfo^.Func := ThreadFunction;
ThreadInfo^.Arg := Arg;
ThreadInfo^.StackSize := StackSize;
ThreadInfo^.Stack := Stack;
ThreadID := kos_newthread(@EntryThreadMain, ThreadInfo);
Result := ThreadID;
end;
procedure SysEndThread(ExitCode: DWord);
begin
WriteLn('..SysEndThread');
{TODO: SysEndThread}
SysReleaseThreadVars;
end;
function SysSuspendThread(ThreadHandle: TThreadID): DWord;
begin
{TODO: SysSuspendThread}
Result := -1;
end;
function SysResumeThread(ThreadHandle: TThreadID): DWord;
begin
{TODO: SysResumeThread}
Result := -1;
end;
function SysKillThread(ThreadHandle: TThreadID): DWord;
begin
if kos_killthread(ThreadHandle) then
Result := 0 else
Result := -1;
end;
procedure SysThreadSwitch;
begin
{$ifdef EMULATOR}
kos_delay(0);{$else}
kos_switchthread();{$endif}
end;
function SysGetCurrentThreadID: TThreadID;
var
ThreadInfo: TKosThreadInfo;
begin
kos_threadinfo(@ThreadInfo);
Result := ThreadInfo.ThreadID;
end;
{XXX: CriticalSection}
procedure SysInitCriticalSection(var CS);
begin
PRTLCriticalSection(CS)^.OwningThread := -1;
end;
procedure SysDoneCriticalSection(var CS);
begin
PRTLCriticalSection(CS)^.OwningThread := -1;
end;
procedure SysEnterCriticalSection(var CS);
var
ThisThread: TThreadID;
begin
ThisThread := GetCurrentThreadId();
if PRTLCriticalSection(CS)^.OwningThread <> ThisThread then
while PRTLCriticalSection(CS)^.OwningThread <> -1 do;
PRTLCriticalSection(CS)^.OwningThread := ThisThread;
end;
procedure SysLeaveCriticalSection(var CS);
begin
if PRTLCriticalSection(CS)^.OwningThread = GetCurrentThreadId() then
PRTLCriticalSection(CS)^.OwningThread := -1;
end;
{TODO: RTLEvent}
function SysRTLEventCreate: PRTLEvent;
begin
Result := nil;
end;
procedure SysRTLEventDestroy(State: PRTLEvent);
begin
end;
{*****************************************************************************
Heap Mutex Protection
*****************************************************************************}
{$ifndef HAS_MT_MEMORYMANAGER}
var
HeapMutex: TRTLCriticalSection;
procedure KosHeapMutexInit;
begin
InitCriticalSection(HeapMutex);
end;
procedure KosHeapMutexDone;
begin
DoneCriticalSection(HeapMutex);
end;
procedure KosHeapMutexLock;
begin
EnterCriticalSection(HeapMutex);
end;
procedure KosHeapMutexUnlock;
begin
LeaveCriticalSection(HeapMutex);
end;
const
KosMemoryMutexManager: TMemoryMutexManager = (
MutexInit : @KosHeapMutexInit;
MutexDone : @KosHeapMutexDone;
MutexLock : @KosHeapMutexLock;
MutexUnlock: @KosHeapMutexUnlock);
procedure InitHeapMutexes;
begin
SetMemoryMutexManager(KosMemoryMutexManager);
end;
{$endif HAS_MT_MEMORYMANAGER}
var
KosThreadManager: TThreadManager;
procedure InitSystemThreads;
begin
ThreadID := TThreadID(1);
with KosThreadManager do
begin
InitManager := nil;
DoneManager := nil;
BeginThread := @SysBeginThread;
EndThread := @SysEndThread;
SuspendThread := @SysSuspendThread;
ResumeThread := @SysResumeThread;
KillThread := @SysKillThread;
ThreadSwitch := @SysThreadSwitch;
WaitForThreadTerminate := nil; //@NoWaitForThreadTerminate;
ThreadSetPriority := nil; //@NoThreadSetPriority;
ThreadGetPriority := nil; //@NoThreadGetPriority;
GetCurrentThreadID := @SysGetCurrentThreadID;
InitCriticalSection := @SysInitCriticalSection;
DoneCriticalSection := @SysDoneCriticalSection;
EnterCriticalSection := @SysEnterCriticalSection;
LeaveCriticalSection := @SysLeaveCriticalSection;
InitThreadVar := @SysInitThreadVar;
RelocateThreadVar := @SysRelocateThreadVar;
AllocateThreadVars := @SysAllocateThreadVars;
ReleaseThreadVars := @SysReleaseThreadVars;
BasicEventCreate := @NoBasicEventCreate;
BasicEventDestroy := @NoBasicEventDestroy;
BasicEventResetEvent := @NoBasicEventResetEvent;
BasicEventSetEvent := @NoBasicEventSetEvent;
BasicEventWaitFor := @NoBasicEventWaitFor;
RTLEventCreate := @SysRTLEventCreate;
RTLEventDestroy := @SysRTLEventDestroy;
RTLEventSetEvent := @NoRTLEventSetEvent;
RTLEventWaitFor := @NoRTLEventWaitFor;
RTLEventSync := @NoRTLEventSync;
RTLEventWaitForTimeout := @NoRTLEventWaitForTimeout;
SemaphoreInit := @NoSemaphoreInit;
SemaphoreDestroy := @NoSemaphoreDestroy;
SemaphoreWait := @NoSemaphoreWait;
SemaphorePost := @NoSemaphorePost;
end;
SetThreadManager(KosThreadManager);
{$ifndef HAS_MT_MEMORYMANAGER}
InitHeapMutexes;
{$endif HAS_MT_MEMORYMANAGER}
ThreadID := GetCurrentThreadID;
end;

Subversion Repositories Kolibri OS

(root)/programs/develop/fp/rtl/systhrd.inc @ 7625 – Rev 643