Rev 616 | Go to most recent revision | 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(); |
||
188 | InitThreadVars(@SysRelocateThreadVar); {XXX: must be @SysRelocateThreadvar} |
||
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 | |||
290 | var |
||
291 | KosThreadManager: TThreadManager; |
||
292 | |||
293 | procedure InitSystemThreads; |
||
294 | begin |
||
295 | ThreadID := TThreadID(1); |
||
296 | with KosThreadManager do |
||
297 | begin |
||
298 | InitManager := nil; |
||
299 | DoneManager := nil; |
||
300 | |||
301 | BeginThread := @SysBeginThread; |
||
302 | EndThread := @SysEndThread; |
||
303 | SuspendThread := @SysSuspendThread; |
||
304 | ResumeThread := @SysResumeThread; |
||
305 | KillThread := @SysKillThread; |
||
306 | ThreadSwitch := @SysThreadSwitch; |
||
307 | WaitForThreadTerminate := nil; //@NoWaitForThreadTerminate; |
||
308 | ThreadSetPriority := nil; //@NoThreadSetPriority; |
||
309 | ThreadGetPriority := nil; //@NoThreadGetPriority; |
||
310 | |||
311 | GetCurrentThreadID := @SysGetCurrentThreadID; |
||
312 | InitCriticalSection := @SysInitCriticalSection; |
||
313 | DoneCriticalSection := @SysDoneCriticalSection; |
||
314 | EnterCriticalSection := @SysEnterCriticalSection; |
||
315 | LeaveCriticalSection := @SysLeaveCriticalSection; |
||
316 | InitThreadVar := @SysInitThreadVar; |
||
317 | RelocateThreadVar := @SysRelocateThreadVar; |
||
318 | AllocateThreadVars := @SysAllocateThreadVars; |
||
319 | ReleaseThreadVars := @SysReleaseThreadVars; |
||
320 | |||
321 | BasicEventCreate := @NoBasicEventCreate; |
||
322 | BasicEventDestroy := @NoBasicEventDestroy; |
||
323 | BasicEventResetEvent := @NoBasicEventResetEvent; |
||
324 | BasicEventSetEvent := @NoBasicEventSetEvent; |
||
325 | BasicEventWaitFor := @NoBasicEventWaitFor; |
||
326 | RTLEventCreate := @SysRTLEventCreate; |
||
327 | RTLEventDestroy := @SysRTLEventDestroy; |
||
328 | RTLEventSetEvent := @NoRTLEventSetEvent; |
||
329 | RTLEventWaitFor := @NoRTLEventWaitFor; |
||
330 | RTLEventSync := @NoRTLEventSync; |
||
331 | RTLEventWaitForTimeout := @NoRTLEventWaitForTimeout; |
||
332 | |||
333 | SemaphoreInit := @NoSemaphoreInit; |
||
334 | SemaphoreDestroy := @NoSemaphoreDestroy; |
||
335 | SemaphoreWait := @NoSemaphoreWait; |
||
336 | SemaphorePost := @NoSemaphorePost; |
||
337 | end; |
||
338 | SetThreadManager(KosThreadManager); |
||
339 | ThreadID := GetCurrentThreadID; |
||
340 | end;>> |