Changeset 6

Timestamp:

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

Author:

chronos

Message:

• Added: Preparation for support for IPC messaging.

Location:

trunk

Files:

• Apps/UClock.pas (modified) (1 diff)
• ChronOS.lpi (modified) (4 diffs)
• ChronOS.lpr (modified) (2 diffs)
• Forms (added)
• Forms/UFormMain.lfm (added)
• Forms/UFormMain.pas (added)
• Forms/UFormTerminal.lfm (added)
• Forms/UFormTerminal.pas (added)
• Platform/Base/UPlatformBase.pas (modified) (3 diffs)
• UAPI.pas (modified) (2 diffs)
• UClasses.pas (added)
• UFormMain.lfm (deleted)
• UFormMain.pas (deleted)
• UKernel.pas (modified) (7 diffs)

trunk/Apps/UClock.pas

@@ -22 +22 @@
 
 procedure TAppClock.Run(Task: TTask);
+var
+  Message: TIPCMessage;
 begin
+  Message := TIPCMessage.Create;
   while not Task.Terminated do begin
     API.WriteText('test');
     API.Sleep(OneSecond);
+    //API.ReadMessage(Message);
   end;
+  Message.Free;
 end;
 

trunk/ChronOS.lpi

@@ -71 +71 @@
       </Item1>
     </RequiredPackages>
-    <Units Count="12">
+    <Units Count="14">
       <Unit0>
         <Filename Value="ChronOS.lpr"/>
@@ -77 +77 @@
       </Unit0>
       <Unit1>
-        <Filename Value="UFormMain.pas"/>
-        <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
+        <Filename Value="Forms/UFormMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormMain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
@@ -134 +134 @@
         <UnitName Value="UMemory"/>
       </Unit11>
+      <Unit12>
+        <Filename Value="Forms/UFormTerminal.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormTerminal"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="UFormTerminal"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="UClasses.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UClasses"/>
+      </Unit13>
     </Units>
   </ProjectOptions>
@@ -143 +155 @@
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="Apps;Platform/Base"/>
+      <OtherUnitFiles Value="Apps;Platform/Base;Forms"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>

trunk/ChronOS.lpr

@@ -11 +11 @@
   Interfaces, // this includes the LCL widgetset
   Forms, SysUtils, UFormMain, UKernel, UFileSystem, UClock, UMemoryManager, UAPI,
-  UPlatformBase, UList, UApp, UThreadEx, UMemory;
+  UPlatformBase, UList, UApp, UThreadEx, UMemory, UFormTerminal, UClasses;
 
 {$R *.res}
@@ -29 +29 @@
   RequireDerivedFormResource := True;
   Application.Initialize;
-  Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TFormMain, FormMain);
+  Application.CreateForm(TFormTerminal, FormTerminal);
   Application.Run;
 end.

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

trunk/UAPI.pas

@@ -16 +16 @@
     procedure WriteText(Text: string);
     procedure Sleep(Time: TDateTime);
+    procedure ReadMessage(Message: TIPCMessage);
   end;
 
@@ -39 +40 @@
 
 procedure TAPI.Sleep(Time: TDateTime);
+var
+  Task: TTask;
 begin
-  SysUtils.Sleep(Trunc(Time / OneMillisecond));
+  Task := Kernel.Scheduler.GetCurrentTask;
+  Task.Sleep(Time);
+end;
+
+procedure TAPI.ReadMessage(Message: TIPCMessage);
+var
+  Task: TTask;
+begin
+  Task := Kernel.Scheduler.GetCurrentTask;
+  while Task.Messages.Count = 0 do Task.WaitForMessage;
 end;
 

trunk/UKernel.pas

@@ -10 +10 @@
 type
   TTask = class;
+  TScheduler = class;
 
   TTaskEvent = procedure(Task: TTask) of object;
 
-  TTaskState = (tsStopped, tsRunning, tsSuspended);
+  TTaskState = (tsStopped, tsRunning, tsSuspended, tsWaiting);
+
+  TIPCMessage = class
+    Name: string;
+    Action: string;
+
+  end;
+
+  TWaitReason = (wrSleep, wrMessage);
 
   { TTask }
 
   TTask = class(TNamedObject)
-    Name: string;
+    Scheduler: TScheduler;
     State: TTaskState;
+    WaitReason: TWaitReason;
+    WakeUpTime: TDateTime;
     Terminated: Boolean;
     EntryPoint: TTaskEvent;
+    Messages: TObjectQueue; // TQueue<TIPMessage>
+    procedure WaitForMessage;
+    procedure Sleep(Duration: TDateTime);
     constructor Create; virtual;
+    destructor Destroy; override;
   end;
 
@@ -33 +48 @@
     Tasks: TNamedObjectList; // TList<TTask>
     Running: Boolean;
+    function GetCurrentTask: TTask; virtual;
     procedure Start; virtual;
     procedure Stop; virtual;
     function AddTask(Name: string; EntryPoint: TTaskEvent): TTask; virtual;
+    procedure SwitchNext; virtual;
     constructor Create; virtual;
     destructor Destroy; override;
@@ -56 +73 @@
     constructor Create; virtual;
     procedure Service(Index: Integer; DataIn, DataOut: TMemory); virtual;
+  end;
+
+  TTimer = class
+    Period: TDateTime;
+  end;
+
+  TScreen = class
+    Size: TPoint;
+    DPI: Integer;
   end;
 
@@ -67 +93 @@
     FileSystemClass: TFileSystemClass;
     Devices: TNamedObjectList; // TList<TDevice>
+    Screens: TObjectList; // TList<TScreen>
     procedure AppExecute(AFile: TFile);
     procedure Init;
@@ -106 +133 @@
 { TTask }
 
+procedure TTask.WaitForMessage;
+begin
+  WaitReason := wrMessage;
+  State := tsWaiting;
+  Scheduler.SwitchNext;
+end;
+
+procedure TTask.Sleep(Duration: TDateTime);
+begin
+  WakeUpTime := Now + Duration;
+  State := tsWaiting;
+  WaitReason := wrSleep;
+  Scheduler.SwitchNext;
+end;
+
 constructor TTask.Create;
 begin
-
+  Messages := TObjectQueue.Create;
+end;
+
+destructor TTask.Destroy;
+begin
+  Messages.Free;
+  inherited Destroy;
 end;
 
 { TScheduler }
 
+function TScheduler.GetCurrentTask: TTask;
+begin
+  Result := nil;
+end;
+
 procedure TScheduler.Start;
 begin
@@ -128 +181 @@
 begin
   NewTask := TaskClass.Create;
+  NewTask.Scheduler := Self;
   NewTask.Name := Name;
   NewTask.EntryPoint := EntryPoint;
   Tasks.Add(NewTask);
   Result := NewTask;
+end;
+
+procedure TScheduler.SwitchNext;
+begin
+
 end;
 
@@ -201 +260 @@
   Apps := TNamedObjectList.Create;
   Scheduler := TScheduler.Create;
+  Screens := TObjectList.Create;
 end;
 
 destructor TKernel.Destroy;
 begin
+  Screens.Free;
   Scheduler.Free;
   Apps.Free;