Changeset 6 for trunk/Platform/Base

Timestamp:

Nov 23, 2014, 11:17:11 PM (10 years ago)

Author:

chronos

Message:

• Added: Preparation for support for IPC messaging.

File:

• trunk/Platform/Base/UPlatformBase.pas (modified) (3 diffs)

trunk/Platform/Base/UPlatformBase.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory;
+  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory,
+  DateUtils;
 
 type
@@ -32 +33 @@
 
   TBaseScheduler = class(TScheduler)
+    procedure SwitchNext; override;
+    function GetCurrentTask: TTask; override;
     function AddTask(Name: string; EntryPoint: TTaskEvent): TTask; override;
     constructor Create; override;
@@ -106 +109 @@
 { TBaseScheduler }
 
+procedure TBaseScheduler.SwitchNext;
+var
+  Task: TTask;
+  Duration: TDateTime;
+begin
+  Task := GetCurrentTask;
+  if Task.State = tsWaiting then begin
+    if Task.WaitReason = wrSleep then begin
+      Duration := (Task.WakeUpTime - Now) / OneMillisecond;
+      if Duration > 0 then SysUtils.Sleep(Trunc(Duration));
+    end;
+  end;
+end;
+
+function TBaseScheduler.GetCurrentTask: TTask;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Tasks.Count) and (TBaseTask(Tasks[I]).Thread.ThreadID <> ThreadID) do
+    Inc(I);
+  if I < Tasks.Count then Result := TBaseTask(Tasks[I])
+    else Result := nil;
+end;
+
 function TBaseScheduler.AddTask(Name: string; EntryPoint: TTaskEvent): TTask;
 var