Changeset 144 for MicroThreading/UMicroThreading.pas
- Timestamp:
- Jan 25, 2011, 2:16:25 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
MicroThreading/UMicroThreading.pas
r143 r144 17 17 TMicroThread = class; 18 18 TMicroThreadScheduler = class; 19 TMicroThreadManager = class; 19 20 20 21 TMicroThreadState = (tsWaiting, tsRunning, tsBlocked, tsSuspended, 21 22 tsSleeping); 22 23 23 24 24 { TMicroThread } … … 27 27 private 28 28 FFreeOnTerminate: Boolean; 29 FStack: Pointer;30 FStackSize: Integer;31 29 FExecutionStartTime: TDateTime; 32 30 FExecutionEndTime: TDateTime; 33 31 FExecutionTime: TDateTime; 32 FStack: Pointer; 34 33 FStackPointer: Pointer; 34 FStackSize: Integer; 35 35 FBasePointer: Pointer; 36 36 FWakeupTime: TDateTime; … … 43 43 Priority: Integer; 44 44 State: TMicroThreadState; 45 Manager: TMicroThreadManager; 45 46 Scheduler: TMicroThreadScheduler; 46 47 procedure Execute; virtual; … … 79 80 TMicroThreadSchedulerPoolThread = class(TThread) 80 81 Scheduler: TMicroThreadScheduler; 82 Manager: TMicroThreadManager; 81 83 procedure Execute; override; 82 84 end; … … 84 86 TThreadPool = class(TObjectList) 85 87 88 end; 89 90 { TMicroThreadManager } 91 92 TMicroThreadManager = class 93 private 94 FStack: Pointer; 95 FStackSize: Pointer; 96 FStackPointer: Pointer; 97 FBasePointer: Pointer; 98 FSelected: TMicroThread; 99 FExecuteCount: Integer; 100 FExecutedCount: Integer; 101 FTerminated: Boolean; 102 FTempPointer: Pointer; 103 function Execute(Count: Integer): Integer; 104 public 105 Scheduler: TMicroThreadScheduler; 106 CurrentMicroThread: TMicroThread; 107 procedure Yield(MicroThread: TMicroThread); 108 constructor Create; 109 destructor Destroy; override; 86 110 end; 87 111 … … 93 117 RoundRobinIndex: Integer; 94 118 LastId: Integer; 95 FMainStackPointer: Pointer;96 FMainBasePointer: Pointer;97 FSelected: TMicroThread;98 FTempPointer: Pointer;99 119 FFrequency: Int64; 100 FExecuteCount: Integer; 101 FExecutedCount: Integer; 120 FThreadPoolSize: Integer; 102 121 FTerminated: Boolean; 103 FThreadPoolSize: Integer;104 122 function GetMicroThreadCount: Integer; 105 123 function GetThreadPoolSize: Integer; 106 124 procedure SetThreadPoolSize(const AValue: Integer); 107 procedure Yield(MicroThread: TMicroThread);125 function GetNextMicroThread: TMicroThread; 108 126 public 127 MainThreadManager: TMicroThreadManager; 109 128 MicroThreads: TObjectList; // TList<TMicroThread> 110 129 Lock: TCriticalSection; 111 CurrentMicroThread: TMicroThread;112 130 function GetNow: TDateTime; 113 131 function Add(MicroThread: TMicroThread): Integer; … … 115 133 constructor Create; 116 134 destructor Destroy; override; 117 function Execute(Count: Integer): Integer;118 135 procedure Start; 119 136 procedure Stop; … … 132 149 implementation 133 150 134 { TMicroThreadSchedulerPoolThread } 135 136 procedure TMicroThreadSchedulerPoolThread.Execute; 137 var 138 ExecutedCount: Integer; 139 begin 140 inherited Execute; 141 try 142 repeat 143 ExecutedCount := Scheduler.Execute(10); 144 if ExecutedCount = 0 then Sleep(1); 145 until Terminated; 146 except 147 on E: Exception do 148 //ExceptionHandler(E); 149 end; 150 end; 151 152 { TMicroThreadMethod } 153 154 procedure TMicroThreadMethod.Execute; 155 begin 156 inherited Execute; 157 Method(Self); 158 end; 159 160 161 { TMicroThread } 162 163 procedure TMicroThread.Execute; 164 begin 165 166 end; 167 168 procedure TMicroThread.Yield; 169 begin 170 Scheduler.Yield(Self); 171 end; 172 173 procedure TMicroThread.WaitFor; 174 begin 175 while not FFinished do begin 176 Sleep(1); 177 end; 178 end; 179 180 procedure TMicroThread.Sleep(Duration: TDateTime); 181 begin 182 FWakeUpTime := Scheduler.GetNow + Duration; 183 State := tsSleeping; 184 Yield; 185 end; 186 187 function TMicroThread.WaitForSignal(Signal: TEvent): TWaitResult; 188 begin 189 repeat 190 Result := Signal.WaitFor(1); 191 Sleep(1); 192 until Result <> wrTimeout; 193 end; 194 195 constructor TMicroThread.Create(CreateSuspended: Boolean; 196 const StackSize: SizeUInt = DefaultStackSize); 197 begin 198 FStackSize := StackSize; 199 FStack := GetMem(FStackSize); 200 FBasePointer := FStack + FStackSize; 201 FStackPointer := FBasePointer - 20; 202 FExecutionTime := 0; 203 FTerminated := False; 204 if CreateSuspended then 205 State := tsSuspended; 206 FFreeOnTerminate := True; 207 end; 208 209 procedure TMicroThread.Terminate; 210 begin 211 FTerminated := True; 212 end; 213 214 destructor TMicroThread.Destroy; 215 begin 216 Terminate; 217 WaitFor; 218 // Microthread is finished, remove it from queue 219 try 220 Scheduler.Lock.Acquire; 221 Scheduler.MicroThreads.Delete(Scheduler.MicroThreads.IndexOf(Self)); 222 finally 223 Scheduler.Lock.Release; 224 end; 225 FreeMem(FStack); 226 inherited Destroy; 227 end; 228 229 procedure TMicroThread.Start; 230 begin 231 State := tsWaiting; 232 end; 233 234 procedure TMicroThread.Stop; 235 begin 236 State := tsSuspended; 237 end; 238 239 240 { TMicroThreadScheduler } 241 242 function TMicroThreadScheduler.GetNow: TDateTime; 243 var 244 {$IFDEF Linux}T: TimeVal;{$ENDIF} 245 {$IFDEF Windows}TimerValue: Int64;{$ENDIF} 246 begin 247 {$IFDEF Windows} 248 QueryPerformanceCounter(TimerValue); 249 //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase 250 Result := TimerValue / FFrequency; 251 {$ENDIF} 252 {$IFDEF Linux} 253 fpgettimeofday(@t, nil); 254 // Build a 64 bit microsecond tick from the seconds and microsecond longints 255 Result := (Int64(t.tv_sec) * 1000000) + t.tv_usec; 256 {$ENDIF} 257 258 Result := (Trunc(Now / OneSecond) + Frac(Result)) * OneSecond; 259 end; 260 261 function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer; 262 begin 263 Inc(LastId); 264 MicroThread.Scheduler := Self; 265 MicroThread.Id := LastId; 266 Result := MicroThreads.Add(MicroThread); 267 end; 268 269 function TMicroThreadScheduler.AddMethod(Method: TMicroThreadEvent): Integer; 270 var 271 NewMicroThread: TMicroThreadMethod; 272 begin 273 NewMicroThread := TMicroThreadMethod.Create(False); 274 NewMicroThread.Method := Method; 275 NewMicroThread.Scheduler := Self; 276 Result := Add(NewMicroThread); 277 end; 278 279 constructor TMicroThreadScheduler.Create; 280 begin 281 Lock := TCriticalSection.Create; 282 MicroThreads := TObjectList.Create; 283 ThreadPool := TThreadPool.Create; 284 {$IFDEF Windows} 285 QueryPerformanceFrequency(FFrequency); 286 {$ENDIF} 287 RoundRobinIndex := -1; 288 end; 289 290 destructor TMicroThreadScheduler.Destroy; 291 begin 292 FTerminated := True; 293 ThreadPool.Free; 294 MicroThreads.Free; 295 Lock.Free; 296 inherited Destroy; 297 end; 298 299 function TMicroThreadScheduler.Execute(Count: Integer): Integer; 300 begin 151 var 152 StaticManagers: TObjectList; // TList<TMicroThreadManager>; 153 StaticManager: TMicroThreadManager; 154 StaticMicroThread: TMicroThread; 155 156 function GetMicroThreadId: Integer; 157 var 158 I: Integer; 159 CurrentStack: Pointer; 160 begin 161 asm 162 mov CurrentStack, sp 163 end; 164 with MainScheduler do begin 165 try 166 Lock.Acquire; 167 I := 0; 168 while (I < MicroThreads.Count) and 169 not ((CurrentStack >= TMicroThread(MicroThreads[I]).FStack) and 170 (CurrentStack <= (TMicroThread(MicroThreads[I]).FStack + 171 TMicroThread(MicroThreads[I]).FStackSize))) do Inc(I); 172 if I < MicroThreads.Count then begin 173 Result := TMicroThread(MicroThreads[I]).Id; 174 end else Result := -1; 175 finally 176 Lock.Release; 177 end; 178 end; 179 end; 180 181 { TMicroThreadManager } 182 183 function TMicroThreadManager.Execute(Count: Integer): Integer; 184 begin 185 FStack := StackBottom; 186 FStackSize := StackBottom + StackLength; 301 187 FExecuteCount := Count; 302 188 FExecutedCount := 0; … … 305 191 end; 306 192 307 procedure TMicroThreadScheduler.Start; 308 var 309 Executed: Integer; 310 begin 311 FTerminated := False; 312 repeat 313 Executed := Execute(10); 314 Application.ProcessMessages; 315 if Executed = 0 then Sleep(1); 316 until FTerminated; 317 end; 318 319 procedure TMicroThreadScheduler.Stop; 320 begin 321 FTerminated := True; 322 end; 323 324 var 325 StaticMicroThread: TMicroThread; 326 StaticScheduler: TMicroThreadScheduler; 327 328 procedure TMicroThreadScheduler.Yield(MicroThread: TMicroThread); 193 procedure TMicroThreadManager.Yield(MicroThread: TMicroThread); 329 194 var 330 195 I: Integer; 331 196 Time: TDateTime; 332 197 begin 333 Time := GetNow;198 Time := Scheduler.GetNow; 334 199 if Assigned(MicroThread) then begin 200 MicroThread.Manager := nil; 335 201 MicroThread.FExecutionEndTime := Time; 336 202 MicroThread.FExecutionTime := MicroThread.FExecutionTime + … … 346 212 mov [eax].TMicroThread.FBasePointer, edx 347 213 end; 348 Static Scheduler := MicroThread.Scheduler;214 StaticManager := MicroThread.Manager; 349 215 asm 350 216 // Restore scheduler stack 351 mov eax, Static Scheduler // Self is invalid before BP restore352 mov edx, [eax].TMicroThread Scheduler.FMainStackPointer217 mov eax, StaticManager // Self is invalid before BP restore 218 mov edx, [eax].TMicroThreadManager.FStackPointer 353 219 mov esp, edx 354 mov edx, [eax].TMicroThread Scheduler.FMainBasePointer220 mov edx, [eax].TMicroThreadManager.FBasePointer 355 221 mov ebp, edx 356 222 end; … … 358 224 end; 359 225 360 // Try to find new microthread for execution 361 FSelected := nil; 226 FSelected := Scheduler.GetNextMicroThread; 227 228 if Assigned(FSelected) and (FExecutedCount < FExecuteCount) then begin 229 FSelected.Manager := Self; 230 Inc(FExecutedCount); 231 CurrentMicroThread := FSelected; 232 asm 233 // Store scheduler stack 234 mov eax, Self 235 mov edx, esp 236 mov [eax].TMicroThreadManager.FStackPointer, edx 237 mov edx, ebp 238 mov [eax].TMicroThreadManager.FBasePointer, edx 239 end; 240 if not FSelected.FExecuted then begin 241 FSelected.FExecuted := True; 242 FSelected.State := tsRunning; 243 FSelected.FExecutionStartTime := Time; 244 FTempPointer := FSelected.FStackPointer; 245 asm 246 // Restore microthread stack 247 mov eax, Self 248 mov edx, [eax].TMicroThreadManager.FTempPointer 249 mov esp, edx 250 end; 251 StaticMicroThread := FSelected; // BP will be change and Self pointer will be invalid 252 FTempPointer := FSelected.FBasePointer; 253 asm 254 mov eax, Self 255 mov edx, [eax].TMicroThreadManager.FTempPointer 256 mov ebp, edx 257 end; 258 StaticMicroThread.Execute; 259 //FSelected.Method(FSelected); 260 StaticManager := StaticMicroThread.Manager; 261 asm 262 // Restore scheduler stack 263 mov eax, StaticManager // Self is invalid before BP restore 264 mov edx, [eax].TMicroThreadManager.FStackPointer 265 mov esp, edx 266 mov edx, [eax].TMicroThreadManager.FBasePointer 267 mov ebp, edx 268 end; 269 FSelected.Manager := nil; 270 FSelected.FExecutionEndTime := Time; 271 FSelected.FExecutionTime := FSelected.FExecutionTime + 272 (FSelected.FExecutionEndTime - FSelected.FExecutionStartTime); 273 FSelected.FFinished := True; 274 if FSelected.FFreeOnTerminate then begin 275 FSelected.Free; 276 end;; 277 end else 278 if FSelected.State = tsWaiting then begin 279 // Execute selected thread 280 FSelected.State := tsRunning; 281 FSelected.FExecutionStartTime := Time; 282 FTempPointer := FSelected.FStackPointer; 283 asm 284 // Restore microthread stack 285 mov eax, Self 286 mov edx, [eax].TMicroThreadManager.FTempPointer 287 mov esp, edx 288 end; 289 FTempPointer := FSelected.FBasePointer; 290 asm 291 mov eax, Self 292 mov edx, [eax].TMicroThreadManager.FTempPointer 293 mov ebp, edx 294 end; 295 end; 296 end; 297 end; 298 299 constructor TMicroThreadManager.Create; 300 begin 301 302 end; 303 304 destructor TMicroThreadManager.Destroy; 305 begin 306 inherited Destroy; 307 end; 308 309 { TMicroThreadSchedulerPoolThread } 310 311 procedure TMicroThreadSchedulerPoolThread.Execute; 312 var 313 ExecutedCount: Integer; 314 begin 315 inherited Execute; 316 try 317 repeat 318 ExecutedCount := Manager.Execute(10); 319 if ExecutedCount = 0 then Sleep(1); 320 until Terminated; 321 except 322 on E: Exception do 323 //ExceptionHandler(E); 324 end; 325 end; 326 327 { TMicroThreadMethod } 328 329 procedure TMicroThreadMethod.Execute; 330 begin 331 inherited Execute; 332 Method(Self); 333 end; 334 335 336 { TMicroThread } 337 338 procedure TMicroThread.Execute; 339 begin 340 341 end; 342 343 procedure TMicroThread.Yield; 344 begin 345 Manager.Yield(Self); 346 end; 347 348 procedure TMicroThread.WaitFor; 349 begin 350 if GetMicroThreadId <> -1 then 351 while not FFinished do begin 352 Sleep(1); 353 end; 354 end; 355 356 procedure TMicroThread.Sleep(Duration: TDateTime); 357 begin 358 FWakeUpTime := Scheduler.GetNow + Duration; 359 State := tsSleeping; 360 Yield; 361 end; 362 363 function TMicroThread.WaitForSignal(Signal: TEvent): TWaitResult; 364 begin 365 repeat 366 Result := Signal.WaitFor(1); 367 Sleep(1); 368 until Result <> wrTimeout; 369 end; 370 371 constructor TMicroThread.Create(CreateSuspended: Boolean; 372 const StackSize: SizeUInt = DefaultStackSize); 373 begin 374 FStackSize := StackSize; 375 FStack := GetMem(FStackSize); 376 FBasePointer := FStack + FStackSize; 377 FStackPointer := FBasePointer - 20; 378 FExecutionTime := 0; 379 FTerminated := False; 380 if CreateSuspended then 381 State := tsSuspended; 382 FFreeOnTerminate := True; 383 end; 384 385 procedure TMicroThread.Terminate; 386 begin 387 FTerminated := True; 388 end; 389 390 destructor TMicroThread.Destroy; 391 begin 392 Terminate; 393 WaitFor; 394 // Microthread is finished, remove it from queue 395 try 396 Manager.Scheduler.Lock.Acquire; 397 Manager.Scheduler.MicroThreads.Delete(Manager.Scheduler.MicroThreads.IndexOf(Self)); 398 finally 399 Manager.Scheduler.Lock.Release; 400 end; 401 FreeMem(FStack); 402 inherited Destroy; 403 end; 404 405 procedure TMicroThread.Start; 406 begin 407 State := tsWaiting; 408 end; 409 410 procedure TMicroThread.Stop; 411 begin 412 State := tsSuspended; 413 end; 414 415 416 { TMicroThreadScheduler } 417 418 function TMicroThreadScheduler.GetNow: TDateTime; 419 var 420 {$IFDEF Linux}T: TimeVal;{$ENDIF} 421 {$IFDEF Windows}TimerValue: Int64;{$ENDIF} 422 begin 423 {$IFDEF Windows} 424 QueryPerformanceCounter(TimerValue); 425 //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase 426 Result := TimerValue / FFrequency; 427 {$ENDIF} 428 429 {$IFDEF Linux} 430 fpgettimeofday(@t, nil); 431 // Build a 64 bit microsecond tick from the seconds and microsecond longints 432 Result := (Int64(t.tv_sec) * 1000000) + t.tv_usec; 433 {$ENDIF} 434 435 Result := (Trunc(Now / OneSecond) + Frac(Result)) * OneSecond; 436 end; 437 438 function TMicroThreadScheduler.Add(MicroThread: TMicroThread): Integer; 439 begin 440 Inc(LastId); 441 MicroThread.Scheduler := Self; 442 MicroThread.Id := LastId; 443 Result := MicroThreads.Add(MicroThread); 444 end; 445 446 function TMicroThreadScheduler.AddMethod(Method: TMicroThreadEvent): Integer; 447 var 448 NewMicroThread: TMicroThreadMethod; 449 begin 450 NewMicroThread := TMicroThreadMethod.Create(False); 451 NewMicroThread.Method := Method; 452 NewMicroThread.Scheduler := Self; 453 Result := Add(NewMicroThread); 454 end; 455 456 constructor TMicroThreadScheduler.Create; 457 begin 458 Lock := TCriticalSection.Create; 459 MicroThreads := TObjectList.Create; 460 ThreadPool := TThreadPool.Create; 461 {$IFDEF Windows} 462 QueryPerformanceFrequency(FFrequency); 463 {$ENDIF} 464 RoundRobinIndex := -1; 465 MainThreadManager := TMicroThreadManager.Create; 466 MainThreadManager.Scheduler := Self; 467 end; 468 469 destructor TMicroThreadScheduler.Destroy; 470 begin 471 MainThreadManager.Free; 472 FTerminated := True; 473 ThreadPool.Free; 474 MicroThreads.Free; 475 Lock.Free; 476 inherited Destroy; 477 end; 478 479 procedure TMicroThreadScheduler.Start; 480 var 481 Executed: Integer; 482 begin 483 FTerminated := False; 484 repeat 485 Executed := MainThreadManager.Execute(10); 486 Application.ProcessMessages; 487 if Executed = 0 then Sleep(1); 488 until FTerminated; 489 end; 490 491 procedure TMicroThreadScheduler.Stop; 492 begin 493 FTerminated := True; 494 end; 495 496 function TMicroThreadScheduler.GetNextMicroThread: TMicroThread; 497 var 498 I: Integer; 499 begin 500 Result := nil; 362 501 try 363 502 Lock.Acquire; … … 381 520 end; 382 521 if I < MicroThreads.Count then begin 383 FSelected:= TMicroThread(MicroThreads[RoundRobinIndex]);522 Result := TMicroThread(MicroThreads[RoundRobinIndex]); 384 523 end; 385 524 finally 386 525 Lock.Release; 387 end;388 389 if Assigned(FSelected) and (FExecutedCount < FExecuteCount) then begin390 Inc(FExecutedCount);391 CurrentMicroThread := FSelected;392 asm393 // Store scheduler stack394 mov eax, Self395 mov edx, esp396 mov [eax].TMicroThreadScheduler.FMainStackPointer, edx397 mov edx, ebp398 mov [eax].TMicroThreadScheduler.FMainBasePointer, edx399 end;400 if not FSelected.FExecuted then begin401 FSelected.FExecuted := True;402 FSelected.State := tsRunning;403 FSelected.FExecutionStartTime := Time;404 FTempPointer := FSelected.FStackPointer;405 asm406 // Restore microthread stack407 mov eax, Self408 mov edx, [eax].TMicroThreadScheduler.FTempPointer409 mov esp, edx410 end;411 StaticMicroThread := FSelected; // BP will be change and Self pointer will be invalid412 FTempPointer := FSelected.FBasePointer;413 asm414 mov eax, Self415 mov edx, [eax].TMicroThreadScheduler.FTempPointer416 mov ebp, edx417 end;418 StaticMicroThread.Execute;419 //FSelected.Method(FSelected);420 StaticScheduler := StaticMicroThread.Scheduler;421 asm422 // Restore scheduler stack423 mov eax, StaticScheduler // Self is invalid before BP restore424 mov edx, [eax].TMicroThreadScheduler.FMainStackPointer425 mov esp, edx426 mov edx, [eax].TMicroThreadScheduler.FMainBasePointer427 mov ebp, edx428 end;429 FSelected.FExecutionEndTime := Time;430 FSelected.FExecutionTime := FSelected.FExecutionTime +431 (FSelected.FExecutionEndTime - FSelected.FExecutionStartTime);432 FSelected.FFinished := True;433 if FSelected.FFreeOnTerminate then begin434 FSelected.Free;435 end;;436 end else437 if FSelected.State = tsWaiting then begin438 // Execute selected thread439 FSelected.State := tsRunning;440 FSelected.FExecutionStartTime := Time;441 FTempPointer := FSelected.FStackPointer;442 asm443 // Restore microthread stack444 mov eax, Self445 mov edx, [eax].TMicroThreadScheduler.FTempPointer446 mov esp, edx447 end;448 FTempPointer := FSelected.FBasePointer;449 asm450 mov eax, Self451 mov edx, [eax].TMicroThreadScheduler.FTempPointer452 mov ebp, edx453 end;454 end;455 526 end; 456 527 end; … … 478 549 initialization 479 550 551 StaticManagers := TObjectList.Create; 480 552 MainScheduler := TMicroThreadScheduler.Create; 481 553 … … 483 555 484 556 MainScheduler.Free; 557 StaticManagers.Free; 485 558 486 559 end.
Note:
See TracChangeset
for help on using the changeset viewer.