Changeset 148 for MicroThreading/UMicroThreading.pas
- Timestamp:
- Jan 26, 2011, 2:16:19 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
MicroThreading/UMicroThreading.pas
r147 r148 105 105 FTerminated: Boolean; 106 106 FTempPointer: Pointer; 107 FCurrentMicroThread: TMicroThread; 108 FScheduler: TMicroThreadScheduler; 107 109 function Execute(Count: Integer): Integer; 108 110 public 109 Scheduler: TMicroThreadScheduler;110 CurrentMicroThread: TMicroThread;111 111 procedure Yield; 112 112 constructor Create; 113 113 destructor Destroy; override; 114 end; 114 property Scheduler: TMicroThreadScheduler read FScheduler; 115 property CurrentMicroThread: TMicroThread read FCurrentMicroThread; 116 end; 117 118 TMicroThreadSchedulerState = (ssStopped, ssRunning, ssTerminating); 115 119 116 120 { TMicroThreadScheduler } … … 118 122 TMicroThreadScheduler = class 119 123 private 120 ThreadPool: TThreadPool; 121 RoundRobinIndex: Integer; 124 FActive: Boolean; 125 FThreadPool: TThreadPool; 126 FThreadPoolLock: TCriticalSection; 127 FThreadPoolSize: Integer; 128 FRoundRobinIndex: Integer; 122 129 FLastId: Integer; 123 130 FFrequency: Int64; 131 FTerminate: Boolean; 124 132 FTerminated: Boolean; 133 FMicroThreads: TObjectList; // TList<TMicroThread> 134 FMainThreadManager: TMicroThreadManager; 135 FMicroThreadsLock: TCriticalSection; 136 FState: TMicroThreadSchedulerState; 125 137 function GetMicroThreadCount: Integer; 126 138 function GetThreadPoolSize: Integer; 139 procedure SetActive(const AValue: Boolean); 127 140 procedure SetThreadPoolSize(const AValue: Integer); 128 141 function GetNextMicroThread: TMicroThread; 142 procedure WaitFor; 143 procedure Start; 144 procedure Stop; 145 function ThreadPoolTerminated: Boolean; 129 146 public 130 MainThreadManager: TMicroThreadManager;131 MicroThreads: TObjectList; // TList<TMicroThread>132 Lock: TCriticalSection;133 147 function GetNow: TDateTime; 134 148 function Add(MicroThread: TMicroThread): Integer; 135 149 function AddMethod(Method: TMicroThreadEvent): Integer; 150 function GetCPUCoreCount: Integer; 136 151 constructor Create; 137 152 destructor Destroy; override; 138 procedure Start;139 procedure Stop;140 153 property MicroThreadCount: Integer read GetMicroThreadCount; 141 154 property ThreadPoolSize: Integer read GetThreadPoolSize 142 155 write SetThreadPoolSize; 156 property MicroThreads: TObjectList read FMicroThreads; 157 property MicroThreadsLock: TCriticalSection read FMicroThreadsLock; 158 property MainThreadManager: TMicroThreadManager read FMainThreadManager; 159 property Active: Boolean read FActive write SetActive; 143 160 end; 144 161 … … 167 184 with MainScheduler do begin 168 185 try 169 Lock.Acquire;186 FMicroThreadsLock.Acquire; 170 187 I := 0; 171 while (I < MicroThreads.Count) and172 not ((CurrentStack >= TMicroThread( MicroThreads[I]).FStack) and173 (CurrentStack <= (TMicroThread( MicroThreads[I]).FStack +174 TMicroThread( MicroThreads[I]).FStackSize))) do Inc(I);175 if I < MicroThreads.Count then begin176 Result := TMicroThread( MicroThreads[I]).FId;188 while (I < FMicroThreads.Count) and 189 not ((CurrentStack >= TMicroThread(FMicroThreads[I]).FStack) and 190 (CurrentStack <= (TMicroThread(FMicroThreads[I]).FStack + 191 TMicroThread(FMicroThreads[I]).FStackSize))) do Inc(I); 192 if I < FMicroThreads.Count then begin 193 Result := TMicroThread(FMicroThreads[I]).FId; 177 194 end else Result := -1; 178 195 finally 179 Lock.Release;196 FMicroThreadsLock.Release; 180 197 end; 181 198 end; … … 199 216 CurrentTime: TDateTime; 200 217 begin 201 CurrentTime := Scheduler.GetNow;202 if Assigned( CurrentMicroThread) then begin203 CurrentMicroThread.FExecutionEndTime := CurrentTime;204 CurrentMicroThread.FExecutionTime :=CurrentMicroThread.FExecutionTime +205 ( CurrentMicroThread.FExecutionEndTime -CurrentMicroThread.FExecutionStartTime);206 if CurrentMicroThread.FState = tsRunning then207 CurrentMicroThread.FState := tsWaiting;208 StaticMicroThread := CurrentMicroThread;218 CurrentTime := FScheduler.GetNow; 219 if Assigned(FCurrentMicroThread) then begin 220 FCurrentMicroThread.FExecutionEndTime := CurrentTime; 221 FCurrentMicroThread.FExecutionTime := FCurrentMicroThread.FExecutionTime + 222 (FCurrentMicroThread.FExecutionEndTime - FCurrentMicroThread.FExecutionStartTime); 223 if FCurrentMicroThread.FState = tsRunning then 224 FCurrentMicroThread.FState := tsWaiting; 225 StaticMicroThread := FCurrentMicroThread; 209 226 asm 210 227 // Store microthread stack … … 215 232 mov [eax].TMicroThread.FBasePointer, edx 216 233 end; 217 StaticManager := CurrentMicroThread.FManager;234 StaticManager := FCurrentMicroThread.FManager; 218 235 asm 219 // Restore scheduler stack236 // Restore FScheduler stack 220 237 mov eax, StaticManager // Self is invalid before BP restore 221 238 mov edx, [eax].TMicroThreadManager.FStackPointer … … 224 241 mov ebp, edx 225 242 end; 226 CurrentMicroThread.FManager := nil;227 CurrentMicroThread := nil;228 end; 229 230 CurrentMicroThread :=Scheduler.GetNextMicroThread;231 232 if Assigned( CurrentMicroThread) and (FExecutedCount < FExecuteCount) then begin233 CurrentMicroThread.FManager := Self;243 FCurrentMicroThread.FManager := nil; 244 FCurrentMicroThread := nil; 245 end; 246 247 FCurrentMicroThread := FScheduler.GetNextMicroThread; 248 249 if Assigned(FCurrentMicroThread) and (FExecutedCount < FExecuteCount) then begin 250 FCurrentMicroThread.FManager := Self; 234 251 Inc(FExecutedCount); 235 252 asm 236 // Store scheduler stack253 // Store FScheduler stack 237 254 mov eax, Self 238 255 mov edx, esp … … 241 258 mov [eax].TMicroThreadManager.FBasePointer, edx 242 259 end; 243 if not CurrentMicroThread.FExecuted then begin244 CurrentMicroThread.FExecuted := True;245 CurrentMicroThread.FState := tsRunning;246 CurrentMicroThread.FExecutionStartTime := CurrentTime;247 StaticMicroThread := CurrentMicroThread;260 if not FCurrentMicroThread.FExecuted then begin 261 FCurrentMicroThread.FExecuted := True; 262 FCurrentMicroThread.FState := tsRunning; 263 FCurrentMicroThread.FExecutionStartTime := CurrentTime; 264 StaticMicroThread := FCurrentMicroThread; 248 265 asm 249 266 // Restore microthread stack … … 260 277 end; 261 278 //FSelected.Method(FSelected); 262 StaticManager := CurrentMicroThread.FManager;279 StaticManager := FCurrentMicroThread.FManager; 263 280 asm 264 // Restore scheduler stack281 // Restore FScheduler stack 265 282 mov eax, StaticManager // Self is invalid before BP restore 266 283 mov edx, [eax].TMicroThreadManager.FStackPointer … … 269 286 mov ebp, edx 270 287 end; 271 CurrentMicroThread.FManager := nil;272 CurrentMicroThread.FExecutionEndTime := CurrentTime;273 CurrentMicroThread.FExecutionTime :=CurrentMicroThread.FExecutionTime +274 ( CurrentMicroThread.FExecutionEndTime -CurrentMicroThread.FExecutionStartTime);275 CurrentMicroThread.FFinished := True;276 if CurrentMicroThread.FFreeOnTerminate then begin288 FCurrentMicroThread.FManager := nil; 289 FCurrentMicroThread.FExecutionEndTime := CurrentTime; 290 FCurrentMicroThread.FExecutionTime := FCurrentMicroThread.FExecutionTime + 291 (FCurrentMicroThread.FExecutionEndTime - FCurrentMicroThread.FExecutionStartTime); 292 FCurrentMicroThread.FFinished := True; 293 if FCurrentMicroThread.FFreeOnTerminate then begin 277 294 // Microthread is finished, remove it from queue 278 with Scheduler do295 with FScheduler do 279 296 try 280 Lock.Acquire;281 MicroThreads.Delete(MicroThreads.IndexOf(CurrentMicroThread));297 FMicroThreadsLock.Acquire; 298 FMicroThreads.Delete(FMicroThreads.IndexOf(FCurrentMicroThread)); 282 299 finally 283 Lock.Release;300 FMicroThreadsLock.Release; 284 301 end; 285 302 end; 286 CurrentMicroThread := nil;303 FCurrentMicroThread := nil; 287 304 end else 288 if CurrentMicroThread.State = tsWaiting then begin305 if FCurrentMicroThread.State = tsWaiting then begin 289 306 // Execute selected thread 290 CurrentMicroThread.FState := tsRunning;291 CurrentMicroThread.FExecutionStartTime := CurrentTime;292 FTempPointer := CurrentMicroThread.FStackPointer;307 FCurrentMicroThread.FState := tsRunning; 308 FCurrentMicroThread.FExecutionStartTime := CurrentTime; 309 FTempPointer := FCurrentMicroThread.FStackPointer; 293 310 asm 294 311 // Restore microthread stack … … 297 314 mov esp, edx 298 315 end; 299 FTempPointer := CurrentMicroThread.FBasePointer;316 FTempPointer := FCurrentMicroThread.FBasePointer; 300 317 asm 301 318 mov eax, Self … … 305 322 end; 306 323 end else begin 307 CurrentMicroThread := nil;324 FCurrentMicroThread := nil; 308 325 end; 309 326 end; … … 311 328 constructor TMicroThreadManager.Create; 312 329 begin 313 CurrentMicroThread := nil;330 FCurrentMicroThread := nil; 314 331 end; 315 332 … … 469 486 MicroThread.FScheduler := Self; 470 487 MicroThread.FId := FLastId; 471 Result := MicroThreads.Add(MicroThread);488 Result := FMicroThreads.Add(MicroThread); 472 489 end; 473 490 … … 482 499 end; 483 500 501 function TMicroThreadScheduler.GetCPUCoreCount: Integer; 502 var 503 SystemInfo: _SYSTEM_INFO; 504 begin 505 GetSystemInfo(SystemInfo); 506 Result := SystemInfo.dwNumberOfProcessors; 507 end; 508 484 509 constructor TMicroThreadScheduler.Create; 485 510 begin 486 Lock := TCriticalSection.Create; 487 MicroThreads := TObjectList.Create; 488 ThreadPool := TThreadPool.Create; 511 FTerminated := True; 512 FMicroThreadsLock := TCriticalSection.Create; 513 FMicroThreads := TObjectList.Create; 514 FThreadPool := TThreadPool.Create; 515 FThreadPoolLock := TCriticalSection.Create; 489 516 {$IFDEF Windows} 490 517 QueryPerformanceFrequency(FFrequency); 491 518 {$ENDIF} 492 RoundRobinIndex := -1;493 MainThreadManager := TMicroThreadManager.Create;494 MainThreadManager.Scheduler := Self;519 FRoundRobinIndex := -1; 520 FMainThreadManager := TMicroThreadManager.Create; 521 FMainThreadManager.FScheduler := Self; 495 522 end; 496 523 497 524 destructor TMicroThreadScheduler.Destroy; 498 525 begin 499 MainThreadManager.Free;500 F Terminated := True;501 ThreadPool.Free;502 MicroThreads.Free;503 Lock.Free;526 Active := False; 527 FMainThreadManager.Free; 528 FThreadPool.Free; 529 FMicroThreads.Free; 530 FMicroThreadsLock.Free; 504 531 inherited Destroy; 505 532 end; … … 511 538 begin 512 539 FTerminated := False; 513 for I := 0 to ThreadPool.Count - 1 do 514 TMicroThreadSchedulerPoolThread(ThreadPool[I]).Start; 540 FTerminate := False; 541 for I := 0 to FThreadPool.Count - 1 do 542 TMicroThreadSchedulerPoolThread(FThreadPool[I]).Start; 515 543 repeat 516 Executed := MainThreadManager.Execute(10);544 Executed := FMainThreadManager.Execute(10); 517 545 Application.ProcessMessages; 518 546 if Executed = 0 then Sleep(1); 519 until FTerminated; 547 until FTerminate; 548 FTerminated := True; 520 549 end; 521 550 … … 524 553 I: Integer; 525 554 begin 526 for I := 0 to ThreadPool.Count - 1 do 527 TMicroThreadSchedulerPoolThread(ThreadPool[I]).Terminate; 528 FTerminated := True; 555 try 556 FThreadPoolLock.Acquire; 557 for I := 0 to FThreadPool.Count - 1 do begin 558 TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminate; 559 end; 560 finally 561 FThreadPoolLock.Release; 562 end; 563 FTerminate := True; 564 565 // Wait for all thread managers to finish 566 repeat 567 Application.ProcessMessages; 568 Sleep(1); 569 until FTerminated and (ThreadPoolSize = 0); 570 end; 571 572 function TMicroThreadScheduler.ThreadPoolTerminated: Boolean; 573 var 574 I: Integer; 575 begin 576 try 577 FThreadPoolLock.Acquire; 578 I := 0; 579 while (I < FThreadPool.Count) and 580 (TMicroThreadSchedulerPoolThread(FThreadPool[I]).Terminated do 581 finally 582 FThreadPoolLock.Release; 583 end; 529 584 end; 530 585 … … 537 592 Result := nil; 538 593 try 539 Lock.Acquire;594 FMicroThreadsLock.Acquire; 540 595 I := 0; 541 Inc( RoundRobinIndex);542 if RoundRobinIndex >=MicroThreads.Count then543 RoundRobinIndex := 0;544 while (I < MicroThreads.Count) and545 (TMicroThread( MicroThreads[RoundRobinIndex]).State <> tsWaiting) do begin596 Inc(FRoundRobinIndex); 597 if FRoundRobinIndex >= FMicroThreads.Count then 598 FRoundRobinIndex := 0; 599 while (I < FMicroThreads.Count) and 600 (TMicroThread(FMicroThreads[FRoundRobinIndex]).State <> tsWaiting) do begin 546 601 // WakeUp sleeping threads 547 if (TMicroThread( MicroThreads[RoundRobinIndex]).FState = tsSleeping) and548 (TMicroThread( MicroThreads[RoundRobinIndex]).FWakeupTime < CurrentTime) then549 TMicroThread( MicroThreads[RoundRobinIndex]).FState := tsWaiting else602 if (TMicroThread(FMicroThreads[FRoundRobinIndex]).FState = tsSleeping) and 603 (TMicroThread(FMicroThreads[FRoundRobinIndex]).FWakeupTime < CurrentTime) then 604 TMicroThread(FMicroThreads[FRoundRobinIndex]).FState := tsWaiting else 550 605 begin 551 606 // Go to next thread 552 607 Inc(I); 553 Inc( RoundRobinIndex);554 if RoundRobinIndex >=MicroThreads.Count then555 RoundRobinIndex := 0;608 Inc(FRoundRobinIndex); 609 if FRoundRobinIndex >= FMicroThreads.Count then 610 FRoundRobinIndex := 0; 556 611 end; 557 612 end; 558 if I < MicroThreads.Count then begin559 Result := TMicroThread( MicroThreads[RoundRobinIndex]);613 if I < FMicroThreads.Count then begin 614 Result := TMicroThread(FMicroThreads[FRoundRobinIndex]); 560 615 end; 561 616 finally 562 Lock.Release;617 FMicroThreadsLock.Release; 563 618 end; 564 619 end; … … 567 622 begin 568 623 try 569 Lock.Acquire;570 Result := MicroThreads.Count;624 FMicroThreadsLock.Acquire; 625 Result := FMicroThreads.Count; 571 626 finally 572 Lock.Release;627 FMicroThreadsLock.Release; 573 628 end; 574 629 end; … … 576 631 function TMicroThreadScheduler.GetThreadPoolSize: Integer; 577 632 begin 578 Result := ThreadPool.Count; 633 Result := FThreadPoolSize; 634 end; 635 636 procedure TMicroThreadScheduler.SetActive(const AValue: Boolean); 637 begin 638 if FActive = AValue then Exit; 639 FActive := AValue; 640 if AValue then Start 641 else Stop; 579 642 end; 580 643 … … 584 647 NewThread: TMicroThreadSchedulerPoolThread; 585 648 begin 586 if AValue > ThreadPool.Count then begin 587 ThreadPool.Capacity := AValue; 588 while ThreadPool.Count < AValue do begin 589 NewThread := TMicroThreadSchedulerPoolThread.Create(True); 590 NewThread.Manager.Scheduler := Self; 591 ThreadPool.Add(NewThread); 592 end; 593 end else 594 ThreadPool.Count := AValue; 649 FThreadPoolSize := AValue; 650 if FState = ssRunning then 651 SetThreadPoolCount 595 652 end; 596 653
Note:
See TracChangeset
for help on using the changeset viewer.