BlueGrey
calm
Elegant
Català-Valencià – Catalan
中文 – Chinese (Simplified)
中文 – Chinese (Traditional)
Česky – Czech
Dansk – Danish
Nederlands – Dutch
English – English
Suomi – Finnish
Français – French
Deutsch – German
עברית – Hebrew
हिंदी – Hindi
Magyar – Hungarian
Bahasa Indonesia – Indonesian
Italiano – Italian
日本語 – Japanese
한국어 – Korean
Македонски – Macedonian
मराठी – Marathi
Norsk – Norwegian
Polski – Polish
Português – Portuguese
Português – Portuguese (Brazil)
Русский – Russian
Slovenčina – Slovak
Slovenščina – Slovenian
Español – Spanish
Svenska – Swedish
Türkçe – Turkish
Українська – Ukrainian
Oëzbekcha – Uzbek
Subversion Repositories
Kolibri OS
(root)
/
programs
/
develop
/
fp
/
rtl
/
systhrd.inc
@ 780
– Rev 643
Rev
Rev 619
|
Blame
|
Compare with Previous
|
Last modification
|
View Log
|
Download
|
RSS feed
{
}
{
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
;