Changeset 140
- Timestamp:
- Jan 24, 2011, 8:39:52 AM (14 years ago)
- Location:
- MicroThreading
- Files:
-
- 2 added
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
MicroThreading/Demo
- Property svn:ignore
-
old new 1 1 Demo 2 2 lib 3 Demo.exe
-
- Property svn:ignore
-
MicroThreading/Demo/Demo.lpi
r135 r140 42 42 </Item3> 43 43 </RequiredPackages> 44 <Units Count="2 2">44 <Units Count="28"> 45 45 <Unit0> 46 46 <Filename Value="Demo.lpr"/> … … 50 50 <TopLine Value="1"/> 51 51 <CursorPos X="1" Y="15"/> 52 <UsageCount Value="3 5"/>52 <UsageCount Value="39"/> 53 53 </Unit0> 54 54 <Unit1> 55 <Filename Value=" umainform.pas"/>55 <Filename Value="UMainForm.pas"/> 56 56 <IsPartOfProject Value="True"/> 57 57 <ComponentName Value="Form1"/> 58 58 <ResourceBaseClass Value="Form"/> 59 59 <UnitName Value="UMainForm"/> 60 <IsVisibleTab Value="True"/> 60 61 <EditorIndex Value="0"/> 61 62 <WindowIndex Value="0"/> 62 <TopLine Value=" 66"/>63 <CursorPos X=" 1" Y="83"/>64 <UsageCount Value="3 5"/>63 <TopLine Value="76"/> 64 <CursorPos X="27" Y="92"/> 65 <UsageCount Value="39"/> 65 66 <Loaded Value="True"/> 66 67 <LoadedDesigner Value="True"/> 67 68 </Unit1> 68 69 <Unit2> 69 <Filename Value="../ umicrothreading.pas"/>70 <Filename Value="../UMicroThreading.pas"/> 70 71 <UnitName Value="UMicroThreading"/> 71 <IsVisibleTab Value="True"/> 72 <EditorIndex Value="7"/> 73 <WindowIndex Value="0"/> 74 <TopLine Value="84"/> 75 <CursorPos X="14" Y="101"/> 76 <UsageCount Value="18"/> 72 <EditorIndex Value="10"/> 73 <WindowIndex Value="0"/> 74 <TopLine Value="175"/> 75 <CursorPos X="28" Y="180"/> 76 <UsageCount Value="20"/> 77 77 <Loaded Value="True"/> 78 78 </Unit2> … … 120 120 <Filename Value="../../ExceptionLogger/UStackTrace.pas"/> 121 121 <UnitName Value="UStackTrace"/> 122 <EditorIndex Value=" 4"/>122 <EditorIndex Value="8"/> 123 123 <WindowIndex Value="0"/> 124 124 <TopLine Value="56"/> 125 125 <CursorPos X="24" Y="77"/> 126 <UsageCount Value=" 18"/>126 <UsageCount Value="20"/> 127 127 <Loaded Value="True"/> 128 128 <DefaultSyntaxHighlighter Value="Delphi"/> … … 131 131 <Filename Value="../../ExceptionLogger/CustomLineInfo.pas"/> 132 132 <UnitName Value="CustomLineInfo"/> 133 <EditorIndex Value=" 6"/>133 <EditorIndex Value="9"/> 134 134 <WindowIndex Value="0"/> 135 135 <TopLine Value="264"/> 136 136 <CursorPos X="37" Y="141"/> 137 <UsageCount Value=" 18"/>137 <UsageCount Value="20"/> 138 138 <Loaded Value="True"/> 139 139 <DefaultSyntaxHighlighter Value="Delphi"/> … … 156 156 <Unit12> 157 157 <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/i386/i386.inc"/> 158 <EditorIndex Value="5"/>159 158 <WindowIndex Value="0"/> 160 159 <TopLine Value="1046"/> 161 160 <CursorPos X="34" Y="1053"/> 162 161 <UsageCount Value="18"/> 163 <Loaded Value="True"/>164 162 </Unit12> 165 163 <Unit13> … … 179 177 <Unit15> 180 178 <Filename Value="../../../../lazarus/lcl/include/control.inc"/> 181 <EditorIndex Value="2"/>182 179 <WindowIndex Value="0"/> 183 180 <TopLine Value="2271"/> 184 181 <CursorPos X="4" Y="2274"/> 185 182 <UsageCount Value="12"/> 186 <Loaded Value="True"/>187 183 </Unit15> 188 184 <Unit16> 189 <Filename Value="../ Coroutine.pas"/>185 <Filename Value="../Other/Coroutine.pas"/> 190 186 <UnitName Value="Coroutine"/> 191 <EditorIndex Value=" 3"/>187 <EditorIndex Value="6"/> 192 188 <WindowIndex Value="0"/> 193 189 <TopLine Value="290"/> 194 <CursorPos X=" 51" Y="287"/>195 <UsageCount Value=" 18"/>190 <CursorPos X="36" Y="306"/> 191 <UsageCount Value="20"/> 196 192 <Loaded Value="True"/> 197 193 </Unit16> … … 226 222 <Unit21> 227 223 <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/sysutils/osutilsh.inc"/> 228 <EditorIndex Value="1"/>229 224 <WindowIndex Value="0"/> 230 225 <TopLine Value="8"/> 231 226 <CursorPos X="11" Y="25"/> 232 227 <UsageCount Value="12"/> 233 <Loaded Value="True"/>234 228 </Unit21> 229 <Unit22> 230 <Filename Value="../MicroThreading.pas"/> 231 <UnitName Value="MicroThreading"/> 232 <EditorIndex Value="7"/> 233 <WindowIndex Value="0"/> 234 <TopLine Value="1"/> 235 <CursorPos X="25" Y="9"/> 236 <UsageCount Value="12"/> 237 <Loaded Value="True"/> 238 </Unit22> 239 <Unit23> 240 <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/dateutil.inc"/> 241 <EditorIndex Value="1"/> 242 <WindowIndex Value="0"/> 243 <TopLine Value="38"/> 244 <CursorPos X="29" Y="50"/> 245 <UsageCount Value="12"/> 246 <Loaded Value="True"/> 247 </Unit23> 248 <Unit24> 249 <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/datih.inc"/> 250 <EditorIndex Value="2"/> 251 <WindowIndex Value="0"/> 252 <TopLine Value="161"/> 253 <CursorPos X="11" Y="184"/> 254 <UsageCount Value="12"/> 255 <Loaded Value="True"/> 256 </Unit24> 257 <Unit25> 258 <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/objpas/sysutils/dati.inc"/> 259 <EditorIndex Value="5"/> 260 <WindowIndex Value="0"/> 261 <TopLine Value="254"/> 262 <CursorPos X="12" Y="258"/> 263 <UsageCount Value="11"/> 264 <Loaded Value="True"/> 265 </Unit25> 266 <Unit26> 267 <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/sysutils.pp"/> 268 <UnitName Value="sysutils"/> 269 <EditorIndex Value="3"/> 270 <WindowIndex Value="0"/> 271 <TopLine Value="581"/> 272 <CursorPos X="11" Y="585"/> 273 <UsageCount Value="11"/> 274 <Loaded Value="True"/> 275 </Unit26> 276 <Unit27> 277 <Filename Value="../../../../Programy/Lazarus/0.9.31_2.4.3/fpc/2.4.3/source/rtl/win/wininc/redef.inc"/> 278 <EditorIndex Value="4"/> 279 <WindowIndex Value="0"/> 280 <TopLine Value="525"/> 281 <CursorPos X="11" Y="538"/> 282 <UsageCount Value="11"/> 283 <Loaded Value="True"/> 284 </Unit27> 235 285 </Units> 236 286 <JumpHistory Count="30" HistoryIndex="29"> 237 287 <Position1> 238 <Filename Value="../ umicrothreading.pas"/>239 <Caret Line=" 49" Column="59" TopLine="17"/>288 <Filename Value="../UMicroThreading.pas"/> 289 <Caret Line="257" Column="44" TopLine="173"/> 240 290 </Position1> 241 291 <Position2> 242 <Filename Value=" umainform.pas"/>243 <Caret Line="1 66" Column="53" TopLine="75"/>292 <Filename Value="../UMicroThreading.pas"/> 293 <Caret Line="141" Column="25" TopLine="125"/> 244 294 </Position2> 245 295 <Position3> 246 <Filename Value=" umainform.pas"/>247 <Caret Line=" 79" Column="1" TopLine="73"/>296 <Filename Value="../UMicroThreading.pas"/> 297 <Caret Line="127" Column="20" TopLine="125"/> 248 298 </Position3> 249 299 <Position4> 250 <Filename Value=" ../umicrothreading.pas"/>251 <Caret Line="1 46" Column="1" TopLine="129"/>300 <Filename Value="UMainForm.pas"/> 301 <Caret Line="191" Column="33" TopLine="171"/> 252 302 </Position4> 253 303 <Position5> 254 <Filename Value=" ../umicrothreading.pas"/>255 <Caret Line="1 47" Column="1" TopLine="129"/>304 <Filename Value="UMainForm.pas"/> 305 <Caret Line="182" Column="38" TopLine="159"/> 256 306 </Position5> 257 307 <Position6> 258 <Filename Value=" ../umicrothreading.pas"/>259 <Caret Line=" 158" Column="1" TopLine="140"/>308 <Filename Value="UMainForm.pas"/> 309 <Caret Line="41" Column="24" TopLine="28"/> 260 310 </Position6> 261 311 <Position7> 262 <Filename Value="../ umicrothreading.pas"/>263 <Caret Line="1 84" Column="1" TopLine="177"/>312 <Filename Value="../UMicroThreading.pas"/> 313 <Caret Line="120" Column="38" TopLine="118"/> 264 314 </Position7> 265 315 <Position8> 266 <Filename Value="../ umicrothreading.pas"/>267 <Caret Line=" 185" Column="1" TopLine="177"/>316 <Filename Value="../UMicroThreading.pas"/> 317 <Caret Line="67" Column="20" TopLine="66"/> 268 318 </Position8> 269 319 <Position9> 270 <Filename Value=" ../umicrothreading.pas"/>271 <Caret Line=" 186" Column="1" TopLine="177"/>320 <Filename Value="UMainForm.pas"/> 321 <Caret Line="41" Column="24" TopLine="28"/> 272 322 </Position9> 273 323 <Position10> 274 <Filename Value=" ../umicrothreading.pas"/>275 <Caret Line="18 7" Column="1" TopLine="177"/>324 <Filename Value="UMainForm.pas"/> 325 <Caret Line="182" Column="45" TopLine="169"/> 276 326 </Position10> 277 327 <Position11> 278 <Filename Value="../ umicrothreading.pas"/>279 <Caret Line=" 188" Column="1" TopLine="177"/>328 <Filename Value="../UMicroThreading.pas"/> 329 <Caret Line="8" Column="57" TopLine="1"/> 280 330 </Position11> 281 331 <Position12> 282 <Filename Value="../ umicrothreading.pas"/>283 <Caret Line=" 189" Column="1" TopLine="177"/>332 <Filename Value="../UMicroThreading.pas"/> 333 <Caret Line="71" Column="20" TopLine="49"/> 284 334 </Position12> 285 335 <Position13> 286 <Filename Value="../ umicrothreading.pas"/>287 <Caret Line=" 192" Column="1" TopLine="177"/>336 <Filename Value="../UMicroThreading.pas"/> 337 <Caret Line="97" Column="24" TopLine="75"/> 288 338 </Position13> 289 339 <Position14> 290 <Filename Value="../ umicrothreading.pas"/>291 <Caret Line=" 205" Column="1" TopLine="177"/>340 <Filename Value="../UMicroThreading.pas"/> 341 <Caret Line="119" Column="38" TopLine="97"/> 292 342 </Position14> 293 343 <Position15> 294 <Filename Value="../ umicrothreading.pas"/>295 <Caret Line=" 206" Column="1" TopLine="178"/>344 <Filename Value="../UMicroThreading.pas"/> 345 <Caret Line="126" Column="61" TopLine="104"/> 296 346 </Position15> 297 347 <Position16> 298 <Filename Value="../ umicrothreading.pas"/>299 <Caret Line=" 209" Column="1" TopLine="181"/>348 <Filename Value="../UMicroThreading.pas"/> 349 <Caret Line="182" Column="34" TopLine="147"/> 300 350 </Position16> 301 351 <Position17> 302 <Filename Value="../ umicrothreading.pas"/>303 <Caret Line="2 12" Column="1" TopLine="184"/>352 <Filename Value="../UMicroThreading.pas"/> 353 <Caret Line="277" Column="45" TopLine="258"/> 304 354 </Position17> 305 355 <Position18> 306 <Filename Value="../ umicrothreading.pas"/>307 <Caret Line=" 215" Column="1" TopLine="197"/>356 <Filename Value="../UMicroThreading.pas"/> 357 <Caret Line="136" Column="14" TopLine="120"/> 308 358 </Position18> 309 359 <Position19> 310 <Filename Value=" ../umicrothreading.pas"/>311 <Caret Line=" 216" Column="1" TopLine="197"/>360 <Filename Value="UMainForm.pas"/> 361 <Caret Line="191" Column="91" TopLine="173"/> 312 362 </Position19> 313 363 <Position20> 314 <Filename Value=" ../umicrothreading.pas"/>315 <Caret Line=" 217" Column="1" TopLine="197"/>364 <Filename Value="UMainForm.pas"/> 365 <Caret Line="179" Column="40" TopLine="165"/> 316 366 </Position20> 317 367 <Position21> 318 <Filename Value="../ umicrothreading.pas"/>319 <Caret Line=" 218" Column="1" TopLine="197"/>368 <Filename Value="../UMicroThreading.pas"/> 369 <Caret Line="193" Column="1" TopLine="181"/> 320 370 </Position21> 321 371 <Position22> 322 <Filename Value="../ umicrothreading.pas"/>323 <Caret Line=" 219" Column="1" TopLine="197"/>372 <Filename Value="../UMicroThreading.pas"/> 373 <Caret Line="11" Column="56" TopLine="1"/> 324 374 </Position22> 325 375 <Position23> 326 <Filename Value="../ umicrothreading.pas"/>327 <Caret Line=" 221" Column="1" TopLine="197"/>376 <Filename Value="../UMicroThreading.pas"/> 377 <Caret Line="15" Column="33" TopLine="1"/> 328 378 </Position23> 329 379 <Position24> 330 <Filename Value=" ../umicrothreading.pas"/>331 <Caret Line="2 57" Column="35" TopLine="236"/>380 <Filename Value="UMainForm.pas"/> 381 <Caret Line="202" Column="91" TopLine="183"/> 332 382 </Position24> 333 383 <Position25> 334 <Filename Value="../ umicrothreading.pas"/>335 <Caret Line=" 80" Column="38" TopLine="55"/>384 <Filename Value="../UMicroThreading.pas"/> 385 <Caret Line="42" Column="22" TopLine="22"/> 336 386 </Position25> 337 387 <Position26> 338 <Filename Value=" umainform.pas"/>339 <Caret Line=" 83" Column="31" TopLine="66"/>388 <Filename Value="../UMicroThreading.pas"/> 389 <Caret Line="92" Column="1" TopLine="92"/> 340 390 </Position26> 341 391 <Position27> 342 <Filename Value=" ../umicrothreading.pas"/>343 <Caret Line=" 104" Column="1" TopLine="74"/>392 <Filename Value="UMainForm.pas"/> 393 <Caret Line="89" Column="19" TopLine="72"/> 344 394 </Position27> 345 395 <Position28> 346 <Filename Value="../ umicrothreading.pas"/>347 <Caret Line=" 90" Column="28" TopLine="73"/>396 <Filename Value="../UMicroThreading.pas"/> 397 <Caret Line="75" Column="22" TopLine="62"/> 348 398 </Position28> 349 399 <Position29> 350 <Filename Value=" ../umicrothreading.pas"/>351 <Caret Line=" 9" Column="70" TopLine="1"/>400 <Filename Value="UMainForm.pas"/> 401 <Caret Line="89" Column="22" TopLine="76"/> 352 402 </Position29> 353 403 <Position30> 354 <Filename Value="../ umicrothreading.pas"/>355 <Caret Line="1 0" Column="27" TopLine="1"/>404 <Filename Value="../UMicroThreading.pas"/> 405 <Caret Line="175" Column="9" TopLine="175"/> 356 406 </Position30> 357 407 </JumpHistory> … … 389 439 <Item3> 390 440 <Source Value="umainform.pas"/> 391 <Line Value="5 2"/>441 <Line Value="56"/> 392 442 </Item3> 393 443 <Item4> -
MicroThreading/Demo/UMainForm.lfm
r137 r140 1 1 object Form1: TForm1 2 Left = 4452 Left = 298 3 3 Height = 510 4 Top = 1 074 Top = 144 5 5 Width = 703 6 6 Caption = 'MicroThreading demo' 7 7 ClientHeight = 510 8 8 ClientWidth = 703 9 OnClose = FormClose 9 10 OnCreate = FormCreate 10 11 OnDestroy = FormDestroy … … 14 15 Height = 25 15 16 Top = 13 16 Width = 1 5117 Caption = ' Add new microthread'17 Width = 119 18 Caption = 'Start scheduler' 18 19 OnClick = Button1Click 19 20 TabOrder = 0 … … 46 47 Width = 105 47 48 end> 49 OwnerData = True 48 50 ReadOnly = True 49 51 RowSelect = True 50 52 TabOrder = 1 51 53 ViewStyle = vsReport 54 OnData = ListView1Data 52 55 end 53 56 object Label1: TLabel … … 55 58 Height = 14 56 59 Top = 8 57 Width = 8560 Width = 74 58 61 Caption = 'Microthread list' 59 62 ParentColor = False … … 65 68 Width = 294 66 69 Anchors = [akTop, akLeft, akBottom] 70 ScrollBars = ssAutoBoth 67 71 TabOrder = 2 68 72 end … … 85 89 TabOrder = 4 86 90 end 91 object Label2: TLabel 92 Left = 10 93 Height = 14 94 Top = 40 95 Width = 32 96 Caption = 'Label2' 97 ParentColor = False 98 end 87 99 object Timer1: TTimer 88 100 Interval = 100 -
MicroThreading/Demo/UMainForm.pas
r137 r140 24 24 Button3: TButton; 25 25 Label1: TLabel; 26 Label2: TLabel; 26 27 ListView1: TListView; 27 28 Memo1: TMemo; … … 30 31 procedure Button2Click(Sender: TObject); 31 32 procedure Button3Click(Sender: TObject); 33 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 32 34 procedure FormCreate(Sender: TObject); 33 35 procedure FormDestroy(Sender: TObject); 36 procedure ListView1Data(Sender: TObject; Item: TListItem); 34 37 procedure Timer1Timer(Sender: TObject); 35 38 private … … 38 41 Scheduler: TMicroThreadScheduler; 39 42 Test: TTest; 43 Terminate: Boolean; 40 44 end; 41 45 … … 74 78 var 75 79 I: Integer; 76 begin 77 for I := 0 to 1 do 78 Scheduler.Add('Worker', Worker); 79 repeat 80 Scheduler.Start; 81 Application.ProcessMessages; 82 Sleep(1); 83 until Scheduler.MicroThreadCount = 0; 80 Executed: Integer; 81 begin 82 if Button1.Caption = 'Start scheduler' then begin 83 Button1.Caption := 'Stop scheduler'; 84 Terminate := False; 85 Scheduler.MicroThreads.Clear; 86 Memo1.Clear; 87 for I := 0 to 20 do 88 Scheduler.Add('Worker', Worker); 89 repeat 90 Executed := Scheduler.Execute(10); 91 Application.ProcessMessages; 92 if Executed = 0 then Sleep(1); 93 until (Scheduler.MicroThreadCount = 0) or Terminate; 94 end else begin 95 Button1.Caption := 'Start scheduler'; 96 Terminate := True; 97 end; 84 98 end; 85 99 … … 142 156 end; 143 157 158 procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); 159 begin 160 Terminate := True; 161 end; 162 144 163 procedure TForm1.FormDestroy(Sender: TObject); 145 164 begin … … 148 167 end; 149 168 150 procedure TForm1.Timer1Timer(Sender: TObject); 151 var 152 I: Integer; 153 NewItem: TListItem; 169 procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem); 154 170 begin 155 171 try 156 ListView1.BeginUpdate;157 ListView1.Clear;158 172 Scheduler.Lock.Acquire; 159 for I := 0 to Scheduler.MicroThreads.Count - 1 do 160 with TMicroThread(Scheduler.MicroThreads[I]) do begin 161 NewItem := ListView1.Items.Add; 162 NewItem.Caption := IntToStr(Id); 163 NewItem.SubItems.Add(Name); 164 NewItem.SubItems.Add(''); 165 NewItem.SubItems.Add(IntToStr(Priority)); 166 NewItem.SubItems.Add(MicroThreadStateText[State]); 167 NewItem.SubItems.Add(FloatToStr(ExecutionTime)); 173 if Item.Index < Scheduler.MicroThreads.Count then 174 with TMicroThread(Scheduler.MicroThreads[Item.Index]) do begin 175 Item.Caption := IntToStr(Id); 176 Item.SubItems.Add(Name); 177 Item.SubItems.Add(''); 178 Item.SubItems.Add(IntToStr(Priority)); 179 Item.SubItems.Add(MicroThreadStateText[State]); 180 Item.SubItems.Add(FloatToStr(ExecutionTime)); 168 181 end; 169 182 finally 170 183 Scheduler.Lock.Release; 171 ListView1.EndUpdate; 172 end; 184 end; 185 end; 186 187 procedure TForm1.Timer1Timer(Sender: TObject); 188 begin 189 ListView1.Items.Count := Scheduler.MicroThreadCount; 190 ListView1.Items[-1]; 191 ListView1.Refresh; 192 Label2.Caption := DateTimeToStr(Scheduler.GetNow) + ' ' + 193 FloatToStr(Frac(Scheduler.GetNow / OneSecond)); 173 194 end; 174 195 … … 179 200 with MicroThread do begin 180 201 Memo1.Lines.Add('Worker ' + IntToStr(Id)); 181 for I := 0 to 10 do begin 182 Memo1.Lines.Add(InttoStr(Id) + ': ' + IntToStr(I)); 183 Sleep(100 * Id * OneMillisecond); 202 for I := 0 to 1000 do begin 203 Memo1.Lines.Add(IntToStr(Id) + ': ' + IntToStr(I) + ' ' + 204 FloatToStr(ExecutionTime)); 205 //Sleep(1 * Id * OneMillisecond); 206 Yield; 184 207 end; 185 208 end; -
MicroThreading/MicroThreading.lpk
r137 r140 2 2 <CONFIG> 3 3 <Package Version="3"> 4 <Name Value="Micro threading"/>4 <Name Value="MicroThreading"/> 5 5 <CompilerOptions> 6 6 <Version Value="9"/> 7 7 <SearchPaths> 8 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/> 8 <OtherUnitFiles Value="Other"/> 9 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 9 10 </SearchPaths> 10 11 <Other> … … 14 15 <Files Count="2"> 15 16 <Item1> 16 <Filename Value=" umicrothreading.pas"/>17 <Filename Value="UMicroThreading.pas"/> 17 18 <UnitName Value="UMicroThreading"/> 18 19 </Item1> 19 20 <Item2> 20 <Filename Value=" Coroutine.pas"/>21 <Filename Value="Other/Coroutine.pas"/> 21 22 <UnitName Value="Coroutine"/> 22 23 </Item2> 23 24 </Files> 24 25 <Type Value="RunAndDesignTime"/> 25 <RequiredPkgs Count=" 1">26 <RequiredPkgs Count="2"> 26 27 <Item1> 28 <PackageName Value="LCL"/> 29 </Item1> 30 <Item2> 27 31 <PackageName Value="FCL"/> 28 32 <MinVersion Major="1" Valid="True"/> 29 </Item 1>33 </Item2> 30 34 </RequiredPkgs> 31 35 <UsageOptions> -
MicroThreading/MicroThreading.pas
r137 r140 3 3 } 4 4 5 unit Micro threading;5 unit MicroThreading; 6 6 7 7 interface … … 17 17 18 18 initialization 19 RegisterPackage('Micro threading', @Register);19 RegisterPackage('MicroThreading', @Register); 20 20 end. -
MicroThreading/UMicroThreading.pas
r137 r140 1 1 unit UMicroThreading; 2 2 3 {$mode objfpc}{$H+}3 {$mode Delphi}{$H+} 4 4 {$asmmode intel} 5 5 … … 7 7 8 8 uses 9 Classes, SysUtils, Contnrs, SyncObjs, DateUtils, 10 BaseUnix, UnixUtil, Unix; 9 {$IFDEF Windows}Windows,{$ENDIF} 10 {$IFDEF Linux}BaseUnix, UnixUtil, Unix,{$ENDIF} 11 Classes, SysUtils, Contnrs, SyncObjs, DateUtils, Dialogs; 11 12 12 13 type … … 15 16 16 17 TStartEvent = procedure(MicroThread: TMicroThread) of object; 17 18 TCallerAddr = packed record19 case Boolean of20 True: (A: TStartEvent;);21 False: (B, C: Pointer;);22 end;23 18 24 19 TMicroThreadState = (tsReady, tsRunning, tsWaiting, tsBlocked, tsSuspended, … … 68 63 FSelected: TMicroThread; 69 64 FTempPointer: Pointer; 65 FFrequency: Int64; 66 FExecuteCount: Integer; 67 FExecutedCount: Integer; 70 68 function GetMicroThreadCount: Integer; 71 69 procedure Yield(MicroThread: TMicroThread); … … 73 71 MicroThreads: TObjectList; // TList<TMicroThread> 74 72 Lock: TCriticalSection; 73 function GetNow: TDateTime; 75 74 function Add(Name: string; Method: TStartEvent): TMicroThread; 76 75 constructor Create; 77 76 destructor Destroy; override; 78 procedure Start;77 function Execute(Count: Integer): Integer; 79 78 property MicroThreadCount: Integer read GetMicroThreadCount; 80 79 property FreeMicroThreadOnFinish: Boolean read FFreeMicroThreadOnFinish … … 89 88 90 89 91 function SystemTicks: Int64;92 {$IFDEF Windows}93 begin94 QueryPerformanceCounter(Result);95 //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase96 {$ELSE}97 var t : timeval;98 begin99 fpgettimeofday(@t,nil);100 // Build a 64 bit microsecond tick from the seconds and microsecond longints101 Result := (Int64(t.tv_sec) * 1000000) + t.tv_usec;102 {$ENDIF}103 end;104 105 106 90 { TMicroThread } 107 91 … … 113 97 procedure TMicroThread.Sleep(Duration: TDateTime); 114 98 begin 115 FWakeUpTime := Now + Duration;99 FWakeUpTime := Scheduler.GetNow + Duration; 116 100 State := tsSleeping; 117 101 Yield; … … 124 108 FBasePointer := FStack + FStackSize; 125 109 FStackPointer := FBasePointer - 20; 110 FExecutionTime := 0; 126 111 end; 127 112 … … 132 117 end; 133 118 119 134 120 { TMicroThreadScheduler } 121 122 function TMicroThreadScheduler.GetNow: TDateTime; 123 var 124 {$IFDEF Linux}T: TimeVal;{$ENDIF} 125 {$IFDEF Windows}TimerValue: Int64;{$ENDIF} 126 begin 127 {$IFDEF Windows} 128 QueryPerformanceCounter(TimerValue); 129 //Result := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) * 1000) // an alternative Win32 timebase 130 Result := TimerValue / FFrequency; 131 {$ENDIF} 132 {$IFDEF Linux} 133 fpgettimeofday(@t, nil); 134 // Build a 64 bit microsecond tick from the seconds and microsecond longints 135 Result := (Int64(t.tv_sec) * 1000000) + t.tv_usec; 136 {$ENDIF} 137 138 Result := (Trunc(Now / OneSecond) + Frac(Result)) * OneSecond; 139 end; 135 140 136 141 function TMicroThreadScheduler.Add(Name: string; Method: TStartEvent … … 154 159 ThreadPool := TThreadPool.Create; 155 160 FFreeMicroThreadOnFinish := True; 161 {$IFDEF Windows} 162 QueryPerformanceFrequency(FFrequency); 163 {$ENDIF} 164 RoundRobinIndex := -1; 156 165 end; 157 166 … … 164 173 end; 165 174 166 procedure TMicroThreadScheduler.Start; 167 begin 168 RoundRobinIndex := -1; 175 function TMicroThreadScheduler.Execute(Count: Integer): Integer; 176 begin 177 FExecuteCount := Count; 178 FExecutedCount := 0; 169 179 Yield(nil); 180 Result := FExecutedCount; 170 181 end; 171 182 … … 177 188 var 178 189 I: Integer; 179 begin 190 Time: TDateTime; 191 begin 192 Time := GetNow; 180 193 if Assigned(MicroThread) then begin 181 MicroThread.FExecutionEndTime := Now;194 MicroThread.FExecutionEndTime := Time; 182 195 MicroThread.FExecutionTime := MicroThread.FExecutionTime + 183 196 (MicroThread.FExecutionEndTime - MicroThread.FExecutionStartTime); … … 215 228 // WakeUp sleeping threads 216 229 if (TMicroThread(MicroThreads[RoundRobinIndex]).State = tsSleeping) and 217 (TMicroThread(MicroThreads[RoundRobinIndex]).FWakeupTime < Now) then230 (TMicroThread(MicroThreads[RoundRobinIndex]).FWakeupTime < Time) then 218 231 TMicroThread(MicroThreads[RoundRobinIndex]).State := tsWaiting else 219 232 begin … … 232 245 end; 233 246 234 if Assigned(FSelected) then begin 247 if Assigned(FSelected) and (FExecutedCount < FExecuteCount) then begin 248 Inc(FExecutedCount); 235 249 asm 236 250 // Store scheduler stack … … 243 257 if FSelected.State = tsReady then begin 244 258 FSelected.State := tsRunning; 245 FSelected.FExecutionStartTime := Now;259 FSelected.FExecutionStartTime := Time; 246 260 FTempPointer := FSelected.FStackPointer; 247 261 asm … … 269 283 mov ebp, edx 270 284 end; 285 FSelected.FExecutionEndTime := Time; 286 FSelected.FExecutionTime := FSelected.FExecutionTime + 287 (FSelected.FExecutionEndTime - FSelected.FExecutionStartTime); 271 288 if FFreeMicroThreadOnFinish then begin 272 289 // Microthread is finished, remove it from queue … … 282 299 // Execute selected thread 283 300 FSelected.State := tsRunning; 284 FSelected.FExecutionStartTime := Now;301 FSelected.FExecutionStartTime := Time; 285 302 FTempPointer := FSelected.FStackPointer; 286 303 asm
Note:
See TracChangeset
for help on using the changeset viewer.