Rev 619 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
616 | bw | 1 | {} |
2 | |||
3 | {XXX: Thread vars & TLS} |
||
4 | |||
5 | const |
||
6 | ThreadVarBlockSize: DWord = 0; |
||
7 | TLSGrowFor = 4096; |
||
8 | |||
9 | type |
||
10 | PTLSIndex = ^TTLSIndex; |
||
11 | TTLSIndex = record |
||
12 | CS: TRTLCriticalSection; |
||
13 | Slots: array[0..TLSGrowFor - 1] of record |
||
14 | TID: DWord; |
||
15 | Value: Pointer; |
||
16 | end; |
||
17 | end; |
||
18 | |||
19 | var |
||
20 | TLSKey: PTLSIndex; |
||
21 | |||
22 | |||
23 | function TLSAlloc(): PTLSIndex; |
||
24 | var |
||
25 | I: DWord; |
||
26 | begin |
||
27 | {New(Result);} |
||
28 | Result := kos_alloc(SizeOf(TTLSIndex)); |
||
29 | InitCriticalSection(Result^.CS); |
||
30 | {SetLength(Result^.Slots, TLSGrowFor);} |
||
31 | for I := 0 to TLSGrowFor - 1 do |
||
32 | Result^.Slots[I].TID := 0; |
||
33 | end; |
||
34 | |||
35 | |||
36 | function TLSFree(TLSIndex: PTLSIndex): Boolean; |
||
37 | begin |
||
38 | DoneCriticalSection(TLSIndex^.CS); |
||
39 | {SetLength(TLSIndex^.Slots, 0); |
||
40 | Dispose(TLSIndex);} |
||
41 | kos_free(TLSIndex); |
||
42 | Result := True; |
||
43 | end; |
||
44 | |||
45 | |||
46 | procedure TLSSetValue(TLSIndex: PTLSIndex; Value: Pointer); |
||
47 | var |
||
48 | TID, I, Count, Slot: DWord; |
||
49 | begin |
||
50 | TID := GetCurrentThreadID(); |
||
51 | EnterCriticalSection(TLSIndex^.CS); |
||
52 | |||
53 | Count := Length(TLSIndex^.Slots); |
||
54 | Slot := Count; |
||
55 | |||
56 | for I := 0 to Count - 1 do |
||
57 | if TLSIndex^.Slots[I].TID = TID then |
||
58 | begin |
||
59 | Slot := I; |
||
60 | Break; |
||
61 | end else |
||
62 | if TLSIndex^.Slots[I].TID = 0 then |
||
63 | Slot := I; |
||
64 | |||
65 | if Slot >= Count then |
||
66 | begin |
||
67 | Halt(123); |
||
68 | {SetLength(TLSIndex^.Slots, Count + TLSGrowFor); |
||
69 | FillChar(TLSIndex^.Slots[Count], TLSGrowFor * SizeOf(TLSIndex^.Slots[0]), #0); |
||
70 | Slot := Count;} |
||
71 | end; |
||
72 | |||
73 | TLSIndex^.Slots[Slot].TID := TID; |
||
74 | TLSIndex^.Slots[Slot].Value := Value; |
||
75 | |||
76 | LeaveCriticalSection(TLSIndex^.CS); |
||
77 | end; |
||
78 | |||
79 | |||
80 | function TLSGetValue(TLSIndex: PTLSIndex): Pointer; |
||
81 | var |
||
82 | TID, I, Count: DWord; |
||
83 | begin |
||
84 | Result := nil; |
||
85 | TID := GetCurrentThreadID(); |
||
86 | |||
87 | EnterCriticalSection(TLSIndex^.CS); |
||
88 | |||
89 | Count := Length(TLSIndex^.Slots); |
||
90 | |||
91 | for I := 0 to Count - 1 do |
||
92 | if TLSIndex^.Slots[I].TID = TID then |
||
93 | begin |
||
94 | Result := TLSIndex^.Slots[I].Value; |
||
95 | break; |
||
96 | end; |
||
97 | |||
98 | LeaveCriticalSection(TLSIndex^.CS); |
||
99 | end; |
||
100 | |||
101 | |||
102 | procedure SysInitThreadVar(var Offset: DWord; Size: DWord); |
||
103 | begin |
||
104 | Offset := ThreadVarBlockSize; |
||
105 | Inc(ThreadVarBlockSize, Size); |
||
106 | end; |
||
107 | |||
108 | procedure SysAllocateThreadVars; |
||
109 | var |
||
110 | DataIndex: Pointer; |
||
111 | begin |
||
112 | {DataIndex := GetMem(ThreadVarBlockSize);} |
||
113 | DataIndex := kos_alloc(ThreadVarBlockSize); |
||
114 | FillChar(DataIndex^, ThreadVarBlockSize, #0); |
||
115 | TLSSetValue(TLSKey, DataIndex); |
||
116 | end; |
||
117 | |||
118 | function SysRelocateThreadVar(Offset: DWord): Pointer; |
||
119 | var |
||
120 | DataIndex: Pointer; |
||
121 | begin |
||
122 | DataIndex := TLSGetValue(TLSKey); |
||
123 | if DataIndex = nil then |
||
124 | begin |
||
125 | SysAllocateThreadVars; |
||
126 | DataIndex := TLSGetValue(TLSKey); |
||
127 | end; |
||
128 | Result := DataIndex + Offset; |
||
129 | end; |
||
130 | |||
131 | procedure SysReleaseThreadVars; |
||
132 | begin |
||
133 | {FreeMem(TLSGetValue(TLSKey));} |
||
134 | kos_free(TLSGetValue(TLSKey)); |
||
135 | end; |
||
136 | |||
137 | |||
138 | |||
139 | {XXX: Thread} |
||
140 | type |
||
141 | PThreadInfo = ^TThreadInfo; |
||
142 | TThreadInfo = record |
||
143 | Func: TThreadFunc; |
||
144 | Arg: Pointer; |
||
145 | StackSize: PtrUInt; |
||
146 | Stack: Pointer; |
||
147 | end; |
||
148 | |||
149 | |||
150 | procedure ThreadMain(ThreadInfo: PThreadInfo); |
||
151 | var |
||
152 | Result: PtrInt; |
||
153 | begin |
||
154 | SysAllocateThreadVars; |
||
155 | with ThreadInfo^ do |
||
156 | begin |
||
157 | InitThread(StackSize); |
||
158 | try |
||
159 | Result := Func(Arg); |
||
160 | except |
||
161 | {TODO: Обработать ошибки} |
||
162 | WriteLn(StdErr, 'Exception in thread'); |
||
163 | end; |
||
164 | FreeMem(Stack); |
||
165 | end; |
||
166 | asm |
||
167 | movl $-1, %eax |
||
168 | int $0x40 |
||
169 | end; |
||
170 | end; |
||
171 | |||
172 | function SysBeginThread(sa: Pointer; StackSize: PtrUInt; ThreadFunction: TThreadFunc; Arg: Pointer; CreationFlags: DWord; var ThreadID: TThreadID): TThreadID; |
||
173 | {Stack, esp, ThreadInfo} |
||
174 | |||
175 | procedure EntryThreadMain; assembler; |
||
176 | asm |
||
177 | movl %esp, %eax |
||
178 | jmp ThreadMain |
||
179 | end; |
||
180 | |||
181 | var |
||
182 | Stack: Pointer; |
||
183 | ThreadInfo: PThreadInfo; |
||
184 | begin |
||
185 | if not IsMultiThread then |
||
186 | begin |
||
187 | TLSKey := TLSAlloc(); |
||
643 | bw | 188 | InitThreadVars(@SysRelocateThreadVar); |
616 | bw | 189 | IsMultiThread := True; |
190 | end; |
||
191 | |||
192 | StackSize := (StackSize + 3) div 4; |
||
193 | Stack := GetMem(StackSize + SizeOf(TThreadInfo)); |
||
194 | ThreadInfo := PThreadInfo(PByte(Stack) + StackSize); |
||
195 | ThreadInfo^.Func := ThreadFunction; |
||
196 | ThreadInfo^.Arg := Arg; |
||
197 | ThreadInfo^.StackSize := StackSize; |
||
198 | ThreadInfo^.Stack := Stack; |
||
199 | ThreadID := kos_newthread(@EntryThreadMain, ThreadInfo); |
||
200 | Result := ThreadID; |
||
201 | end; |
||
202 | |||
203 | |||
204 | procedure SysEndThread(ExitCode: DWord); |
||
205 | begin |
||
206 | WriteLn('..SysEndThread'); |
||
207 | {TODO: SysEndThread} |
||
208 | SysReleaseThreadVars; |
||
209 | end; |
||
210 | |||
211 | |||
212 | function SysSuspendThread(ThreadHandle: TThreadID): DWord; |
||
213 | begin |
||
214 | {TODO: SysSuspendThread} |
||
215 | Result := -1; |
||
216 | end; |
||
217 | |||
218 | |||
219 | function SysResumeThread(ThreadHandle: TThreadID): DWord; |
||
220 | begin |
||
221 | {TODO: SysResumeThread} |
||
222 | Result := -1; |
||
223 | end; |
||
224 | |||
225 | |||
226 | function SysKillThread(ThreadHandle: TThreadID): DWord; |
||
227 | begin |
||
228 | if kos_killthread(ThreadHandle) then |
||
229 | Result := 0 else |
||
230 | Result := -1; |
||
231 | end; |
||
232 | |||
233 | |||
234 | procedure SysThreadSwitch; |
||
235 | begin |
||
236 | {$ifdef EMULATOR} |
||
237 | kos_delay(0);{$else} |
||
238 | kos_switchthread();{$endif} |
||
239 | end; |
||
240 | |||
241 | |||
242 | function SysGetCurrentThreadID: TThreadID; |
||
243 | var |
||
244 | ThreadInfo: TKosThreadInfo; |
||
245 | begin |
||
246 | kos_threadinfo(@ThreadInfo); |
||
247 | Result := ThreadInfo.ThreadID; |
||
248 | end; |
||
249 | |||
250 | |||
251 | {XXX: CriticalSection} |
||
252 | procedure SysInitCriticalSection(var CS); |
||
253 | begin |
||
254 | PRTLCriticalSection(CS)^.OwningThread := -1; |
||
255 | end; |
||
256 | |||
257 | procedure SysDoneCriticalSection(var CS); |
||
258 | begin |
||
259 | PRTLCriticalSection(CS)^.OwningThread := -1; |
||
260 | end; |
||
261 | |||
262 | procedure SysEnterCriticalSection(var CS); |
||
263 | var |
||
264 | ThisThread: TThreadID; |
||
265 | begin |
||
266 | ThisThread := GetCurrentThreadId(); |
||
267 | if PRTLCriticalSection(CS)^.OwningThread <> ThisThread then |
||
268 | while PRTLCriticalSection(CS)^.OwningThread <> -1 do; |
||
269 | PRTLCriticalSection(CS)^.OwningThread := ThisThread; |
||
270 | end; |
||
271 | |||
272 | procedure SysLeaveCriticalSection(var CS); |
||
273 | begin |
||
274 | if PRTLCriticalSection(CS)^.OwningThread = GetCurrentThreadId() then |
||
275 | PRTLCriticalSection(CS)^.OwningThread := -1; |
||
276 | end; |
||
277 | |||
278 | |||
279 | {TODO: RTLEvent} |
||
280 | function SysRTLEventCreate: PRTLEvent; |
||
281 | begin |
||
282 | Result := nil; |
||
283 | end; |
||
284 | |||
285 | procedure SysRTLEventDestroy(State: PRTLEvent); |
||
286 | begin |
||
287 | end; |
||
288 | |||
289 | |||
643 | bw | 290 | {***************************************************************************** |
291 | Heap Mutex Protection |
||
292 | *****************************************************************************} |
||
293 | |||
294 | {$ifndef HAS_MT_MEMORYMANAGER} |
||
616 | bw | 295 | var |
643 | bw | 296 | HeapMutex: TRTLCriticalSection; |
297 | |||
298 | procedure KosHeapMutexInit; |
||
299 | begin |
||
300 | InitCriticalSection(HeapMutex); |
||
301 | end; |
||
302 | |||
303 | procedure KosHeapMutexDone; |
||
304 | begin |
||
305 | DoneCriticalSection(HeapMutex); |
||
306 | end; |
||
307 | |||
308 | procedure KosHeapMutexLock; |
||
309 | begin |
||
310 | EnterCriticalSection(HeapMutex); |
||
311 | end; |
||
312 | |||
313 | procedure KosHeapMutexUnlock; |
||
314 | begin |
||
315 | LeaveCriticalSection(HeapMutex); |
||
316 | end; |
||
317 | |||
318 | |||
319 | const |
||
320 | KosMemoryMutexManager: TMemoryMutexManager = ( |
||
321 | MutexInit : @KosHeapMutexInit; |
||
322 | MutexDone : @KosHeapMutexDone; |
||
323 | MutexLock : @KosHeapMutexLock; |
||
324 | MutexUnlock: @KosHeapMutexUnlock); |
||
325 | |||
326 | |||
327 | procedure InitHeapMutexes; |
||
328 | begin |
||
329 | SetMemoryMutexManager(KosMemoryMutexManager); |
||
330 | end; |
||
331 | |||
332 | {$endif HAS_MT_MEMORYMANAGER} |
||
333 | |||
334 | |||
335 | var |
||
616 | bw | 336 | KosThreadManager: TThreadManager; |
337 | |||
338 | procedure InitSystemThreads; |
||
339 | begin |
||
340 | ThreadID := TThreadID(1); |
||
341 | with KosThreadManager do |
||
342 | begin |
||
343 | InitManager := nil; |
||
344 | DoneManager := nil; |
||
345 | |||
346 | BeginThread := @SysBeginThread; |
||
347 | EndThread := @SysEndThread; |
||
348 | SuspendThread := @SysSuspendThread; |
||
349 | ResumeThread := @SysResumeThread; |
||
350 | KillThread := @SysKillThread; |
||
351 | ThreadSwitch := @SysThreadSwitch; |
||
352 | WaitForThreadTerminate := nil; //@NoWaitForThreadTerminate; |
||
353 | ThreadSetPriority := nil; //@NoThreadSetPriority; |
||
354 | ThreadGetPriority := nil; //@NoThreadGetPriority; |
||
355 | |||
356 | GetCurrentThreadID := @SysGetCurrentThreadID; |
||
357 | InitCriticalSection := @SysInitCriticalSection; |
||
358 | DoneCriticalSection := @SysDoneCriticalSection; |
||
359 | EnterCriticalSection := @SysEnterCriticalSection; |
||
360 | LeaveCriticalSection := @SysLeaveCriticalSection; |
||
361 | InitThreadVar := @SysInitThreadVar; |
||
362 | RelocateThreadVar := @SysRelocateThreadVar; |
||
363 | AllocateThreadVars := @SysAllocateThreadVars; |
||
364 | ReleaseThreadVars := @SysReleaseThreadVars; |
||
365 | |||
366 | BasicEventCreate := @NoBasicEventCreate; |
||
367 | BasicEventDestroy := @NoBasicEventDestroy; |
||
368 | BasicEventResetEvent := @NoBasicEventResetEvent; |
||
369 | BasicEventSetEvent := @NoBasicEventSetEvent; |
||
370 | BasicEventWaitFor := @NoBasicEventWaitFor; |
||
371 | RTLEventCreate := @SysRTLEventCreate; |
||
372 | RTLEventDestroy := @SysRTLEventDestroy; |
||
373 | RTLEventSetEvent := @NoRTLEventSetEvent; |
||
374 | RTLEventWaitFor := @NoRTLEventWaitFor; |
||
375 | RTLEventSync := @NoRTLEventSync; |
||
376 | RTLEventWaitForTimeout := @NoRTLEventWaitForTimeout; |
||
377 | |||
378 | SemaphoreInit := @NoSemaphoreInit; |
||
379 | SemaphoreDestroy := @NoSemaphoreDestroy; |
||
380 | SemaphoreWait := @NoSemaphoreWait; |
||
381 | SemaphorePost := @NoSemaphorePost; |
||
382 | end; |
||
383 | SetThreadManager(KosThreadManager); |
||
643 | bw | 384 | {$ifndef HAS_MT_MEMORYMANAGER} |
385 | InitHeapMutexes; |
||
386 | {$endif HAS_MT_MEMORYMANAGER} |
||
616 | bw | 387 | ThreadID := GetCurrentThreadID; |
388 | end;>> |